unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 =
class(TForm)
procedure FormPaint(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function GradientFill(
DC: HDC; pTriVertex: Pointer; dwNumVertex: DWORD;
pMesh: Pointer; dwNumMesh, dwMode: DWORD): BOOL;
stdcall;
external '
msimg32.dll'
name '
GradientFill';
type
TFillMode = (fmHorizontal = GRADIENT_FILL_RECT_H, fmVertiktal = GRADIENT_FILL_RECT_V);
function wGradientFill(
DC: HDC; fillRect: TRect; Col:
array of COLORREF; FillMode: TFillMode): Bool;
type
_TTRIVERTEX =
packed record
X, Y: DWORD;
Red, Green, Blue, Alpha: Word;
end;
var
tv:
array [0..3]
of _TTRIVERTEX;
gr:
array [0..1]
of GRADIENT_RECT;
begin
if length(col) = 3
then
begin
// fillmode direction
gr[0].UpperLeft := 0;
gr[0].LowerRight := 1;
gr[1].UpperLeft := 2;
gr[1].LowerRight := 3;
// eckpunkte festlegen
tv[0].x := fillRect.Left;
tv[0].y := fillRect.Top;
tv[1].x := fillRect.Right;
tv[1].y := fillRect.Bottom
div 2;
tv[2].x := fillRect.Left;
tv[2].y := fillRect.Bottom
div 2;
tv[3].x := fillRect.Right;
tv[3].y := fillRect.Bottom;
// -------------------------------------------------------------------------
// -> $0000 or BYTE(startColor shr 8) shl 8;
// ein wenig trckiki, GradientFill erwartet als farbwert ein word
// wobei das farbbyte an erster stelle stehen muss.
// ich verzichte hierbei gleich mal auf GetRValue() usw. von Windows. ;-)
tv[0].Red := BYTE(col[0])
shl 8;
tv[0].Green := BYTE(col[0]
shr 8)
shl 8;
tv[0].Blue := BYTE(col[0]
shr 16)
shl 8;
tv[0].Alpha := BYTE(col[0]
shr 24)
shl 8;
tv[1].Red := BYTE(col[1])
shl 8;
tv[1].Green := BYTE(col[1]
shr 8)
shl 8;
tv[1].Blue := BYTE(col[1]
shr 16)
shl 8;
tv[1].Alpha := BYTE(col[1]
shr 24)
shl 8;
tv[2].Red := BYTE(col[1])
shl 8;
tv[2].Green := BYTE(col[1]
shr 8)
shl 8;
tv[2].Blue := BYTE(col[1]
shr 16)
shl 8;
tv[2].Alpha := BYTE(col[1]
shr 24)
shl 8;
tv[3].Red := BYTE(col[2])
shl 8;
tv[3].Green := BYTE(col[2]
shr 8)
shl 8;
tv[3].Blue := BYTE(col[2]
shr 16)
shl 8;
tv[3].Alpha := BYTE(col[2]
shr 24)
shl 8;
Result := GradientFill(
DC, @tv, length(tv), @gr, length(gr), DWORD(FillMode));
end else
begin
Application.MessageBox('
Anzahl der Farben stimmt nicht.', '
wGradientFill:', MB_OK);
Result := False;
end;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
wGradientFill(Canvas.Handle, ClientRect, [clNavy, clLime, clYellow], fmVertiktal);
end;
end.