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;

GradientFill.png


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:

enter image description here

Tags:

Delphi