Создание градиентной заливки

procedure
 FillGradientRect(Canvas: TCanvas; Recty: TRect; fbcolor, fecolor: TColor; fcolors: Integer);
 var

   i, j, h, w, fcolor: Integer;
   R, G, B: Longword;
   beginRGBvalue, RGBdifference: array
[0..2] of
 Longword;
 begin

   beginRGBvalue[0] := GetRvalue(colortoRGB(FBcolor));
   beginRGBvalue[1] := GetGvalue(colortoRGB(FBcolor));
   beginRGBvalue[2] := GetBvalue(colortoRGB(FBcolor));

   RGBdifference[0] := GetRvalue(colortoRGB(FEcolor)) - beginRGBvalue[0];
   RGBdifference[1] := GetGvalue(colortoRGB(FEcolor)) - beginRGBvalue[1];
   RGBdifference[2] := GetBvalue(colortoRGB(FEcolor)) - beginRGBvalue[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
 fcolors1 then

     begin

       R := beginRGBvalue[0] + muldiv(j, RGBDifference[0], fcolors);
       G := beginRGBvalue[1] + muldiv(j, RGBDifference[1], fcolors);
       B := beginRGBvalue[2] + muldiv(j, RGBDifference[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
;

 // Case 1 

procedure
 TForm1.FormPaint(Sender: TObject);
 begin

   FillGradientRect(Form1.Canvas, rect(0, 0, Width, Height), $FF0000, $00000, $00FF);
 end
;


 // Case 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, that the OnResize event should also call the FormPaint 
  method if this form is allowed to be resizable. 
  This is because if it is not called then when the 
  window is resized the gradient will not match the rest of the form. 
}

 {***********************************************************}

 {2. Another function}


 procedure
 TForm1.Gradient(Col1, Col2: TColor; Bmp: TBitmap);
 type

   PixArray = array
 [1..3] of
 Byte;
 var

   i, big, rdiv, gdiv, bdiv, h, w: Integer;
   ts: TStringList;
   p: ^PixArray;
 begin

   rdiv := GetRValue(Col1) - GetRValue(Col2);
   gdiv := GetgValue(Col1) - GetgValue(Col2);
   bdiv := GetbValue(Col1) - GetbValue(Col2);

   bmp.PixelFormat := pf24Bit;

   for
 h := 0 to
 bmp.Height - 1 do

   begin

     p := bmp.ScanLine[h];
     for
 w := 0 to
 bmp.Width - 1 do

     begin

       p^[1] := GetBvalue(Col1) - Round((w / bmp.Width) * bdiv);
       p^[2] := GetGvalue(Col1) - Round((w / bmp.Width) * gdiv);
       p^[3] := GetRvalue(Col1) - Round((w / bmp.Width) * rdiv);
       Inc(p);
     end
;
   end
;
 end
;

 procedure
 TForm1.Button1Click(Sender: TObject);
 var

   BitMap1: TBitMap;
 begin

   BitMap1 := TBitMap.Create;
   try

     Bitmap1.Width := 300;
     bitmap1.Height := 100;
     Gradient(clred, clBlack, bitmap1);
     // So konnte man das Bild dann zB in einem TImage anzeigen 
    // To show the image in a TImage: 
    Image1.Picture.Bitmap.Assign(bitmap1);
   finally

     Bitmap1.Free;
   end
;
 end
;

Другое по теме:

• TCanvas и освобождение дескрипторов
• Алгоритм градиентной заливки
• Вертикальный текст