Créer un dégradé sur une TForm

méthode n°1
implementation

{$R *.DFM}

procedure fillGradientRect(canvas: tcanvas; Recty: trect; fbcolor, fecolor: tcolor;
fcolors: integer);
var
i, j, h, w, fcolor: Integer;
R, G, B: Longword;
begin RGBvalue, RGBd if ference: array[0..2] of Longword;
begin
begin RGBvalue[0] := GetRvalue(colortoRGB(FBcolor));
begin RGBvalue[1] := GetGvalue(colortoRGB(FBcolor));
begin RGBvalue[2] := GetBvalue(colortoRGB(FBcolor));

RGBd if ference[0] := GetRvalue(colortoRGB(FEcolor)) - begin RGBvalue[0];
RGBd if ference[1] := GetGvalue(colortoRGB(FEcolor)) - begin RGBvalue[1];
RGBd if ference[2] := GetBvalue(colortoRGB(FEcolor)) - begin RGBvalue[2];

canvas.pen.style := pssolid;
canvas.pen.mode := pmcopy;
j := 0;
h := recty.bottom - recty.top;
w := recty.right - recty.left;

for i := fcolors downto 0 do
begin
recty.left := muldiv(i - 1, w, fcolors);
recty.right := muldiv(i, w, fcolors);
if fcolors > 1 then
begin
R := begin RGBvalue[0] + muldiv(j, RGBD if ference[0], fcolors);
G := begin RGBvalue[1] + muldiv(j, RGBD if ference[1], fcolors);
B := begin RGBvalue[2] + muldiv(j, RGBD if ference[2], fcolors);
end;
canvas.brush.color := RGB(R, G, B);
patBlt(canvas.handle, recty.left, recty.top, Recty.right - recty.left, h, patcopy);
inc(j);
end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
fillGradientRect(form1.canvas, rect(0, 0, Width, Height), $FF0000, $00000, $00FF);
end;


méthode n°2:
procedure TForm1.FormPaint(Sender: TObject);
var
Row, Ht: Word;
IX: Integer;
begin
iX := 200;
Ht := (ClientHeight + 512) div 256;
for Row := 0 to 512 do
begin
with Canvas do begin
Brush.Color := RGB(Ix, 0, row);
FillRect(Rect(0, Row * Ht, ClientWidth, (Row + 1) * Ht));
IX := (IX - 1);
end;
end;
end;

{Note, rafraichir la form lorsque l'évenement OnResize en appelé}
Ajouter un commentaire
Pseudo
Adresse email
Site internet (optionnel)
Votre commentaire
Fiche de l'article
Mise a jour16/11/2001
VisualisationVu 2057 fois
PublicInternaute zz
CategorieDelphi - Trucs et astuces - Surface
Auteur de l'article
SwissDelphiCenter SwissDelphiCenter
connecté le 02/11/2011
329 articles dans la section
Contacter l'auteur