Programowanie w języku Delphi » FAQ

Jak narysować Gradient

  • 2008-01-15 21:26
  • 2 komentarze
  • 759 odsłon
  • Oceń ten tekst jako pierwszy
function Gradient(Uklad: Boolean; Kolor1, Kolor2: TColor; Szerokosc, Wysokosc: Integer) : TBitmap;
var
 i, j, x, y, dr, dg, db, dlugosc : Integer;
 r, g, b, r2, g2, b2, DodR, DodG, DodB : Real;
 Bitmapa : TBitmap;
begin
 
 Bitmapa := TBitmap.Create;
 Bitmapa.Width := Szerokosc;
 Bitmapa.Height := Wysokosc;
 
 r := GetRValue(Kolor1);
 g := GetGValue(Kolor1);
 b := GetBValue(Kolor1);
 
 r2 := GetRValue(Kolor2);
 g2 := GetGValue(Kolor2);
 b2 := GetBValue(Kolor2);
 
 dr := Round(r2) - Round(r);
 dg := Round(g2) - Round(g);
 db := Round(b2) - Round(b);
 
 if Uklad
  then
   begin
    dlugosc := Szerokosc;
    x := Szerokosc - 1;
    y := Wysokosc - 1;
   end
  else
   begin
    dlugosc := Wysokosc;
    y := Szerokosc - 1;
    x := Wysokosc - 1;
   end;
 
 if dr = 0
  then DodR := 0
  else DodR := dr / dlugosc;
 
 if dg = 0
  then DodG := 0
  else DodG := dg / dlugosc;
 
 if db = 0
  then DodB := 0
  else DodB := db / dlugosc;
 
 for i := 0 to x do
  begin
   for j := 0 to y do
    begin
     if Uklad
      then Bitmapa.Canvas.Pixels[i , j] := RGB(Round(r) , Round(g) , Round(b))
      else Bitmapa.Canvas.Pixels[j , i] := RGB(Round(r) , Round(g) , Round(b));
    end ;
   if ((DodR > 0) and (r < r2)) or ((DodR < 0) and (r > r2)) then r := r + DodR;
   if ((DodG > 0) and (g < g2)) or ((DodG < 0) and (g > g2)) then g := g + DodG;
   if ((DodB > 0) and (b < b2)) or ((DodB < 0) and (b > b2)) then b := b + DodB;
  end ;
 
 Result := Bitmapa;
 
end;

Wywołanie:

Metoda 1
Powoduje wczytane gradientu do komponentu Image
Image1.Picture.Bitmap := Gradient(True, $00DBFBFF, $005FC8FB, Image1.Width, Image1.Height);

Metoda 2
Powoduje wczytanie gradientu do zmiennej typu Bitmap
BMP := TBitmap.Create;
 BMP := Gradient(False, $00DBFBFF, $005FC8FB, 200, 30);
 Canvas.Draw(10, 10, BMP);
BMP.Free;

2 komentarze

woolfik 2015-06-30 12:50

Lub z JediVCL użyć komponentu JVGradient

AdamPL 2008-01-20 03:29

Mam propozycję. Może lepiej by było to zrobić na ScanLine?