unit ApiGradient;

interface

uses
  Windows, SysUtils, Graphics;

// The definition of the TTriVertex structure in Windows.pas is
// incorrect.
// В Windows.pas структура TTriVertex с ошибкой.
type
  TTriVertex = packed record
    x    : Longint;
    y    : Longint;
    Red  : SmallInt;
    Green: SmallInt;
    Blue : SmallInt;
    Alpha: SmallInt;
  end;
// Variables used for interfacing to the MSIMG32.DLL
function GradientFill(DC: HDC; var p2: TTriVertex; p3: ULONG; p4: Pointer; p5, p6: ULONG): BOOL; stdcall;

type
  TGradientDirection = (gdHorizontal, gdVertical);

function GradientRect(Canvas: TCanvas; const ARect: TRect;
  Color1, Color2: TColor; Direction: TGradientDirection): Boolean;

implementation

function GradientFill; external msimg32 name 'GradientFill';

type
  TRGB = record
    R, G, B: Byte;
  end;

function GetRGB(Color: TColor): TRGB;
var
  iColor: TColor;
begin
  iColor := ColorToRGB(Color);
  Result.R := GetRValue(iColor);
  Result.G := GetGValue(iColor);
  Result.B := GetBValue(iColor);
end;

function GradientRect(Canvas: TCanvas; const ARect: TRect; Color1,
  Color2: TColor; Direction: TGradientDirection): Boolean;

  // Function to initialise a TTriVertex
  function InitTriVertex(XPos, YPos: Integer; Color: TColor): TTriVertex;
  begin
    with Result do
    begin
      x := XPos;
      y := YPos;
      Alpha := 2;
      with GetRGB(Color) do
      begin
        Red := R shl 8;
        Green := G shl 8;
        Blue := B shl 8;
      end
    end
  end;

const
  Flag: array[TGradientDirection] of Longint = (
    GRADIENT_FILL_RECT_H, GRADIENT_FILL_RECT_V);
var
  GRect : TGradientRect;
  Vertex: array[0..1] of TTriVertex;
begin
  GRect.UpperLeft := 0;
  GRect.LowerRight := 1;
  Vertex[0] := InitTriVertex(ARect.Left, ARect.Top, Color1);
  Vertex[1] := InitTriVertex(ARect.Right, ARect.Bottom, Color2);
  Result := GradientFill(Canvas.Handle, Vertex[0], 2, @GRect, 1,
    Flag[Direction]);
end;

end.

GradientRect(Canvas, Rect(0, 0, 300, 300), clYellow, clRed, gdVertical);

 Алексей Румянцев