Farbverlauf zeichnen

procedure DrawGradient(const Canvas: TCanvas; Color1, Color2: TColor;
                       ARect: TRect; GradientOrientation: TGradientOrientation);
var
  c1, c2, c: TPixelRec;  //for easy access to RGB values as well as TColor value
  x, y: Integer;         //current pixel position to be set
  OldPenWidth: Integer;  //Save old settings to restore them properly
  OldPenStyle: TPenStyle;//see above
begin
  c1.Color := ColorToRGB(Color1);  //convert system colors to RGB values
  c2.Color := ColorToRGB(Color2);  //if neccessary
  OldPenWidth := Canvas.Pen.Width; //get old settings
  OldPenStyle := Canvas.Pen.Style;
  Canvas.Pen.Width:=1;             //ensure correct pen settings
  Canvas.Pen.Style:=psInsideFrame;

  case GradientOrientation of
    goVertical:
    begin
      for y := 0 to ARect.Bottom - ARect.Top do
      begin
        c.r := Round(c1.r + (c2.r - c1.r) * y / (ARect.Bottom - ARect.Top));
        c.g := Round(c1.g + (c2.g - c1.g) * y / (ARect.Bottom - ARect.Top));
        c.b := Round(c1.b + (c2.b - c1.b) * y / (ARect.Bottom - ARect.Top));
        Canvas.Brush.Color := c.Color;
        Canvas.FillRect(Classes.Rect(ARect.Left, ARect.Top + y,
                                     ARect.Right, ARect.Top + y + 1));
      end;
    end;
    goHorizontal:
    begin
      for x := 0 to ARect.Right - ARect.Left do
      begin
        c.r := Round(c1.r + (c2.r - c1.r) * x / (ARect.Right - ARect.Left));
        c.g := Round(c1.g + (c2.g - c1.g) * x / (ARect.Right - ARect.Left));
        c.b := Round(c1.b + (c2.b - c1.b) * x / (ARect.Right - ARect.Left));
        Canvas.Brush.Color := c.Color;
        Canvas.FillRect(Rect(ARect.Left + x, ARect.Top,
                             ARect.Left + x + 1, ARect.Bottom));
      end;
    end;
  end;
  Canvas.Pen.Width := OldPenWidth; //restore old settings
  Canvas.Pen.Style := OldPenStyle;
end;

DrawGradient(Canvas, clRed, clBlue, ClientRect, goHorizontal);

TGradientOrientation = (goVertical, goHorizontal);

  TPixelRec = packed record
    case Boolean of
      true:  (Color: TColor);
      false: (r, g, b, Reserved: Byte);
  end;