Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  136

•  TDictionary Custom Sort  3 318

•  Fast Watermark Sources  3 065

•  3D Designer  4 825

•  Sik Screen Capture  3 321

•  Patch Maker  3 536

•  Айболит (remote control)  3 637

•  ListBox Drag & Drop  2 996

•  Доска для игры Реверси  81 570

•  Графические эффекты  3 927

•  Рисование по маске  3 232

•  Перетаскивание изображений  2 613

•  Canvas Drawing  2 735

•  Рисование Луны  2 561

•  Поворот изображения  2 166

•  Рисование стержней  2 161

•  Paint on Shape  1 564

•  Генератор кроссвордов  2 226

•  Головоломка Paletto  1 764

•  Теорема Монжа об окружностях  2 218

•  Пазл Numbrix  1 682

•  Заборы и коммивояжеры  2 052

•  Игра HIP  1 279

•  Игра Go (Го)  1 225

•  Симулятор лифта  1 471

•  Программа укладки плитки  1 214

•  Генератор лабиринта  1 542

•  Проверка числового ввода  1 352

•  HEX View  1 490

•  Физический маятник  1 355

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Нарисовать градиент на Canvas с произвольным количеством цветов



Оформил: DeeCo

{ 
  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]);




Похожие по теме исходники

Canvas

Canvas Drawing

Couleur (цветовая палитра)




Copyright © 2004-2024 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте