How to paint 2 gradients together on a Canvas?
Delphi 2005 and up:
Use GradientFillCanvas from the GraphUtil unit:
procedure TForm1.FormPaint(Sender: TObject);
var
R: TRect;
begin
SetRect(R, 0, 0, ClientWidth, ClientHeight div 2);
GradientFillCanvas(Canvas, clWhite, $00056AFF, R, gdVertical);
SetRect(R, 0, ClientHeight div 2, ClientWidth, ClientHeight);
GradientFillCanvas(Canvas, $000055FF, clWhite, R, gdVertical);
end;
Earlier Delphi versions:
Use GradientFill
from Msimg32.dll. Add the following code to a global utilities unit:
type
PTriVertex = ^TTriVertex;
TTriVertex = record
X, Y: DWORD;
Red, Green, Blue, Alpha: WORD;
end;
function GradientFill(DC: HDC; Vertex: PTriVertex; NumVertex: ULONG;
Mesh: Pointer; NumMesh, Mode: ULONG): BOOL; stdcall; overload;
external msimg32 name 'GradientFill';
function GradientFill(DC: HDC; const ARect: TRect; StartColor,
EndColor: TColor; Vertical: Boolean): Boolean; overload;
const
Modes: array[Boolean] of ULONG = (GRADIENT_FILL_RECT_H, GRADIENT_FILL_RECT_V);
var
Vertices: array[0..1] of TTriVertex;
GRect: TGradientRect;
begin
Vertices[0].X := ARect.Left;
Vertices[0].Y := ARect.Top;
Vertices[0].Red := GetRValue(ColorToRGB(StartColor)) shl 8;
Vertices[0].Green := GetGValue(ColorToRGB(StartColor)) shl 8;
Vertices[0].Blue := GetBValue(ColorToRGB(StartColor)) shl 8;
Vertices[0].Alpha := 0;
Vertices[1].X := ARect.Right;
Vertices[1].Y := ARect.Bottom;
Vertices[1].Red := GetRValue(ColorToRGB(EndColor)) shl 8;
Vertices[1].Green := GetGValue(ColorToRGB(EndColor)) shl 8;
Vertices[1].Blue := GetBValue(ColorToRGB(EndColor)) shl 8;
Vertices[1].Alpha := 0;
GRect.UpperLeft := 0;
GRect.LowerRight := 1;
Result := GradientFill(DC, @Vertices, 2, @GRect, 1, Modes[Vertical]);
end;
Now, the painting code becomes:
procedure TForm1.FormPaint(Sender: TObject);
var
R: TRect;
begin
SetRect(R, 0, 0, ClientWidth, ClientHeight div 2);
GradientFill(Canvas.Handle, R, clWhite, $00056AFF, True);
SetRect(R, 0, ClientHeight div 2, ClientWidth, ClientHeight);
GradientFill(Canvas.Handle, R, $000055FF, clWhite, True);
end;
procedure TForm1.FormResize(Sender: TObject);
begin
Invalidate;
end;
I coded it using a normal TCanvas.
The code draws a gradient on that canvas by steadily increasing the colors. You can adjust that for example by adding weights to either the start or the end color (e.g. to increase the white part).
procedure drawGradient(drawCanvas: TCanvas; canvasHeight, canvasWidth, canvasStartPos: Integer; startColor, endColor: TColor);
type
RGBColor = (Blue, Green, Red);
var
diff, startColorArray, endColorArray: array[RGBColor] of Integer;
delta, currentColorFloat: array[RGBColor] of Double;
gradientSize: Integer;
currentColor: TColor;
rgbC: RGBColor;
i: Integer;
begin
gradientSize := canvasHeight div 2;
// Pre-calculate some required values for every RGB color
for rgbC := Low(RGBColor) to High(RGBColor) do
begin
// Split the start end end colors into the RGB values
// The right shift at the end shifts 16, 8 and 0 bits in the three loops
// (I know that's a little hard to read)
startColorArray[rgbC] := $FF and (startColor shr ((2 - Ord(rgbC)) * 8));
endColorArray[rgbC] := $FF and (endColor shr ((2 - Ord(rgbC)) * 8));
// Calculate the difference between the start and end color. This might be
// a negative value, hence the declaration as Integer instead of Byte
diff[rgbC] := startColorArray[rgbC] - endColorArray[rgbC];
// And calculate a float value for each color. This is the increment on
// every drawn line.
delta[rgbC] := diff[rgbC] / gradientSize;
end;
// Initialize the drawn color with the start value
currentColorFloat[Blue] := startColorArray[Blue];
currentColorFloat[Green] := startColorArray[Green];
currentColorFloat[Red] := startColorArray[Red];
// Now draw the gradient line by line
for i := 0 to gradientSize - 1 do
begin
// The target color as TColor
currentColor := 0;
for rgbC := Low(RGBColor) to High(RGBColor) do
begin
// Substract the decrement delta from the current color
currentColorFloat[rgbC] := currentColorFloat[rgbC] - delta[rgbC];
// Round the float value and left shift it to the correct position (16, 8 and 0 bits).
// Then bitwise or it with the current color.
currentColor := currentColor or (Round(currentColorFloat[rgbC]) shl ((2 - Ord(rgbC)) * 8));
end;
// Now draw a 1 pixel thin line from left to right
drawCanvas.Pen.Color := currentColor;
drawCanvas.MoveTo(0, i + canvasStartPos);
drawCanvas.LineTo(canvasWidth, i + canvasStartPos);
end;
end;
Call it like this:
procedure TForm18.Button1Click(Sender: TObject);
const
white1: TColor = clWhite;
white2: TColor = $00CFCFCF;
color1: TColor = $000080FF;
color2: TColor = $00007AF4;
begin
// pb is a TPaintbox, but this works with any canvas
drawGradient(pb.Canvas, pb.Height, pb.Width, 0, white1, color1);
drawGradient(pb.Canvas, pb.Height, pb.Width, pb.Height div 2, color2, white2);
end;
The result looks like this: