Delphi World - Нарисовать градиент на Canvas с произвольным количеством цветов
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Нарисовать градиент на Canvas с произвольным количеством цветов

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

{ 
  The following code allows you to draw a gradient on a canvas with 
  an arbitrary number of colors (minimum 2). 
  To draw a gradient on a form's canvas, 
  call the DrawGradient() in the OnPaint and OnResize-event handlers. 
}

 { 
  Mit dieser Prozedur kann man auf einen Canvas einen Farbverlauf mit 
  beliebig vielen Farben (min. 2) zeichnen. 
  Z.B. wenn auf eine Form ein Farbverlauf gezeichnet werden soll, 
  rufe die DrawGradient() Funktion im OnPaint-Ereignis und 
  im OnResize-Ereignis der Form auf. 
}

 procedure DrawGradient(ACanvas: TCanvas; Rect: TRect;
   Horicontal: Boolean; Colors: array of TColor);
 type
   RGBArray = array[0..2] of Byte;
 var
   x, y, z, stelle, mx, bis, faColorsh, mass: Integer;
   Faktor: double;
   A: RGBArray;
   B: array of RGBArray;
   merkw: integer;
   merks: TPenStyle;
   merkp: TColor;
 begin
   mx := High(Colors);
   if mx > 0 then
   begin
     if Horicontal then
       mass := Rect.Right - Rect.Left
     else
       mass := Rect.Bottom - Rect.Top;
     SetLength(b, mx + 1);
     for x := 0 to mx do
     begin
       Colors[x] := ColorToRGB(Colors[x]);
       b[x][0] := GetRValue(Colors[x]);
       b[x][1] := GetGValue(Colors[x]);
       b[x][2] := GetBValue(Colors[x]);
     end;
     merkw := ACanvas.Pen.Width;
     merks := ACanvas.Pen.Style;
     merkp := ACanvas.Pen.Color;
     ACanvas.Pen.Width := 1;
     ACanvas.Pen.Style := psSolid;
     faColorsh := Round(mass / mx);
     for y := 0 to mx - 1 do
     begin
       if y = mx - 1 then
         bis := mass - y * faColorsh - 1
       else
         bis := faColorsh;
       for x := 0 to bis do
       begin
         Stelle := x + y * faColorsh;
         faktor := x / bis;
         for z := 0 to 3 do
           a[z] := Trunc(b[y][z] + ((b[y + 1][z] - b[y][z]) * Faktor));
         ACanvas.Pen.Color := RGB(a[0], a[1], a[2]);
         if Horicontal then
         begin
           ACanvas.MoveTo(Rect.Left + Stelle, Rect.Top);
           ACanvas.LineTo(Rect.Left + Stelle, Rect.Bottom);
         end
         else
         begin
           ACanvas.MoveTo(Rect.Left, Rect.Top + Stelle);
           ACanvas.LineTo(Rect.Right, Rect.Top + Stelle);
         end;
       end;
     end;
     b := nil;
     ACanvas.Pen.Width := merkw;
     ACanvas.Pen.Style := merks;
     ACanvas.Pen.Color := merkp;
   end
   else
     // Please specify at least two colors 
    raise EMathError.Create('Es mussen mindestens zwei Farben angegeben werden.');
 end;

 // Example Calls: 
// Aufrufbeispiele: 

DrawGradient(Image1.Canvas, Rect(0, 0, 100, 200), False, [clRed, $00FFA9B4]);

 DrawGradient(Canvas, GetClientRect, True, [121351, clBtnFace, clBlack, clWhite]);
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования