скрыть

скрыть

  Форум  

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

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



Google  
 

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



Оформил: DeeCo

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;





Copyright © 2004-2016 "Delphi Sources". Delphi World FAQ




Группа ВКонтакте   Ссылка на Twitter   Группа на Facebook