Mega Code Archive
Use API to gradient fill areas
<![CDATA[
Title: Use API to gradient fill areas
Question: I am trying to use GradientFill API, but I get some weird results. Why?
Answer:
Because the declaration of the _TRIVERTEX structure is wrong!
This is how the structure is declared:
...
COLOR16 = Shortint;
...
_TRIVERTEX = packed record
x: Longint;
y: Longint;
Red: COLOR16;
Green: COLOR16;
Blue: COLOR16;
Alpha: COLOR16;
end;
Although the structure declaration itself is correct, the COLOR16 type should be of type Smallint. This makes the size of structure 4 bytes shorter than expected by the API and gives the weird behaviour.
You can follow two ways to solve the problem:
Hard way: correct the error in Windows.pas and recompile the VCL library.
Easy way: declare in your programs the correct _TRIVERTEX structure and redeclare the GradientFill API to match the new structure declaration.
Here follows a sample unit that show how to do it.
------------------------------------------------------------------------------
unit Unit7;
interface
uses
Windows, Forms;
type
_TRIVERTEX = packed record
x: Dword;
y: DWord;
Red: Word;
Green: Word;
Blue: Word;
Alpha: Word;
end;
TForm7 = class(TForm)
procedure FormPaint(Sender: TObject);
procedure FormResize(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form7: TForm7;
implementation
function GradientFill(Handle: HDC;
pVertex: Pointer; dwNumVertex: DWORD;
pMesh: Pointer; dwNumMesh: DWORD;
dwMode: DWORD): DWORD; stdcall; External 'msimg32.dll';
{$R *.DFM}
procedure TForm7.FormPaint(Sender: TObject);
var
udtVertex: array [0..1] of _TRIVERTEX;
rectGradient: TGradientRect;
begin
with udtVertex[0] do
begin
x := 0;
y := 0;
Red := 0;
Green := 0;
Blue := 0;
Alpha := 0;
end;
with udtVertex[1] do
begin
x := Width;
y := 24;
Red := $ff00;
Green := $ff00;
Blue := $ff00;
Alpha := $0000;
end;
rectGradient.UpperLeft := 0;
rectGradient.LowerRight := 1;
GradientFill(Canvas.Handle,
@udtVertex, 2,
@rectGradient, 1,
GRADIENT_FILL_RECT_H);
end;
procedure TForm7.FormResize(Sender: TObject);
begin
repaint;
end;
end.
]]>