{ .... }
interface
{ .... }
type
TTriVertex = packed record
x: Longint;
y: Longint;
Red: Word;
Green: Word;
Blue: Word;
Alpha: Word;
end;
TGradientFillProc = function(DC: HDC; Verteces: Pointer; NumVerteces: DWORD;
Meshes: Pointer; NumMeshes: DWORD; Mode: DWORD): DWORD; stdcall;
{ .... }
var
MSImg32Lib: THandle;
GradientFillProc: TGradientFillProc;
{ .... }
// Example:
// Beispiel:
procedure TForm1.Button1Click(Sender: TObject);
var
cr: Cardinal;
Verteces: array[0..1] of TTriVertex;
GradientRect: TGradientRect;
begin
Verteces[0].x := 0;
Verteces[0].y := 0;
cr := GetSysColor(COLOR_ACTIVECAPTION);
Verteces[0].Red := ((cr and $0F0F) or 8);
Verteces[0].Green := (cr and $0ff00);
Verteces[0].Blue := ((cr and $0ff0000) or 8);
Verteces[0].Alpha := 0;
Verteces[1].x := Width;
Verteces[1].y := Height;
cr := GetSysColor(COLOR_GRADIENTACTIVECAPTION);
Verteces[1].Red := ((cr and $0FF) or 8);
Verteces[1].Green := (cr and $0ff00);
Verteces[1].Blue := ((cr and $0ff0000) or 8);
Verteces[1].Alpha := 0;
GradientRect.UpperLeft := 0;
GradientRect.LowerRight := 1;
GradientFillProc(Canvas.Handle, @Verteces[0], 2, @GradientRect, 1, GRADIENT_FILL_RECT_H);
end;
{ .... }
initialization
GradientFillProc := nil;
MSImg32Lib := LoadLibrary('msimg32.dll');
if MSImg32Lib <> 0 then
begin
GradientFillProc := GetProcAddress(MSImg32Lib, 'GradientFill');
if @GradientFillProc = nil then
begin
FreeLibrary(MSImg32Lib);
MSImg32Lib := 0;
end;
end
else
ShowMessage('Could not load DLL');
finalization
if @GradientFillProc <> nil then
GradientFillProc := nil;
if MSImg32Lib <> 0 then
begin
FreeLibrary(MSImg32Lib);
MSImg32Lib := 0;
end;
end.
No comments:
Post a Comment