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

Delphi , Графика и Игры , Canvas

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

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;

Программный код на Delphi для создания градиентных заливок!

Вот разбивка функций каждого процедура:

FillGradientRect Эта процедура создает градиентную заливку в указанном прямоугольнике (Recty) с двумя цветами (fbcolor и fecolor). Количество шагов цвета определяется параметром fcolors. Она использует массивы beginRGBvalue и RGBdifference для расчета значений цвета для каждого шага. Полученная градиентная заливка заполняется в прямоугольник с помощью функции patBlt.

Case 1 Код вызывает FillGradientRect в событии формы FormPaint, создавая градиентную заливку от красного ($FF0000) до черного ($000000) по всей форме.

Case 2 Код создает аналогичный эффект градиента, заполняя отдельные прямоугольники разными цветами. Значения цвета рассчитываются на основе номера строки и начального значения IX. Это результат линейной градиентной заливки.

Gradient процедура (в другой функции) Эта процедура создает эффект градиента для заданного битмапа (Bmp). Она принимает два цвета (Col1 и Col2) в качестве входных параметров и генерирует 24-битный массив пикселей. Полученная картинка хранится в указанном битмапе. Эта функция может использоваться для создания градиентной заливки для объекта TBitmap.

Button1Click событие Код создает новый объект TBitmap, устанавливает его ширину и высоту, вызывает процедуру Gradient с красным (clRed) и черными (clBlack) цветами, а затем присваивает полученную картинку контроллу TImage с именем Image1.

Некоторые примечания:

• Событие OnResize не показано в этом примере, но важно вызывать метод формы paint при изменении размера формы для поддержки эффекта градиентной заливки.
• В Delphi можно использовать тип TColor для представления цветов. Однако использование прямых значений RGB (например, $FF0000) может быть более эффективным и удобным в некоторых случаях.

В целом, этот код демонстрирует два различных подхода к созданию градиентных заливок: один с помощью одиночного прямоугольника и другой с использованием отдельных прямоугольников, заполненных разными цветами. Второй подход более гибок и позволяет создавать более сложные эффекты градиента.

Создание градиентной заливки на форме Delphi с помощью функции FillGradientRect и создания изображения с помощью функции Gradient.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Canvas ::