Delphirus - прграммирование на delphi
   Все о delphi Delphirus - прграммирование на delphi
blocks.gif
Навигация
 

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

 
 
 

Советы по delphi \ Графика и Игры \ Canvas \ Создание градиентной заливки

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

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;

Название: Создание градиентной заливки
Дата публикации: 2004-08-30 (2945 Прочтено)

 
 

 

Page generation 0.039 seconds