How to paint 2 gradients together on a Canvas?

Question

Please look at this sample gradient image I did with a Paint program:

It c

Answer 1

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;

Answer 2

iWidth: Integer;
iWidth := Width div 2;
GradientFillCanvas(Canvas, Col1, Col2, Rect(0, 0, iWidth, Height), gdHorizontal);
GradientFillCanvas(Canvas, Col2, Col1, Rect(iWidth, 0, Width, Height),gdHorizontal);

Answer 3

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:

Answer 4

I like to use class helpers on TCanvas so I revised the code in the other answer.

type
  TTriVertex = record
  public
    type
      P = ^TTriVertex;
  public
    X, Y: DWORD;
    Red, Green, Blue, Alpha: WORD;
    constructor Create(APoint: TPoint; AColor: TColor; AAlpha: Word = 0);
  end;

  TTriVertexRect = record
  public
    TopLeft: TTriVertex;
    LowerRight: TTriVertex;
    constructor Create(ARect: TRect; Color1,Color2; AAlpha1: Word = 0; AAlpha2: Word = 0);
  end;
 {Enumerate the constants so they will show up on alt space in the IDE}
 TGradientFillType = (
     gftRectH = GRADIENT_FILL_RECT_H
    ,gftRectV = GRADIENT_FILL_RECT_V
    ,gftTriangle = GRADIENT_FILL_TRIANGLE);

 TCavas_Helper = class helper for TCanvas
  public
    function GradientFill(const Vertexes: array of TTriVertexRect; FillType: TGradientFillType): Boolean; overload;
  end;

{ TTriVertex }

constructor TTriVertex.Create(APoint: TPoint; AColor: TColor; AAlpha: Word = 0);
begin
  X := APoint.X;
  Y := APoint.Y;
  Red := GetRValue(ColorToRGB(AColor)) SHL 8;
  Green := GetGValue(ColorToRGB(AColor)) SHL 8;
  Blue := GetBValue(ColorToRGB(AColor)) SHL 8;
  Alpha := 0;
end;

{ TTriVertexRect }

constructor TTriVertexRect.Create(ARect: TRect; Color1, Color2: TColor; AAlpha1,
  AAlpha2: Word);
begin
  TopLeft.Create(ARect.TopLeft,Color1,AAlpha1);
  LowerRight.Create(ARect.BottomRight,Color2,AAlpha2);
end;

{ TCavas_Helper }

function TCavas_Helper.GradientFill(const Vertexes: array of TTriVertexRect; FillType: TGradientFillType): Boolean;
var
  GRect: array of TGradientRect;
  Index: Integer;
begin
  SetLength(GRect,Length(Vertexes));
  for Index := 0 to Length(GRect) do begin
    GRect[Index].UpperLeft := Index*2;
    GRect[Index].LowerRight := Index*2 + 1;
  end;
  Result := WIndows.GradientFill(Handle,@Vertexes[0],Length(Vertexes)*2,@GRect[0],Length(GRect),Ord(FillType))
end;

So the actual call looks like this

procedure TForm56.FormPaint(Sender: TObject);
begin
  Canvas.GradientFill([
      TTriVertexRect.Create(Rect(0,0,ClientWidth,ClientHeight DIV 2),clWhite,$00056AFF)
     ,TTriVertexRect.Create(Rect(0,ClientHeight DIV 2,ClientWidth,ClientHeight),$00056AFF,clWhite)
    ],gftRectV);
end;

Sample: