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



Оформил: 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;

Далее: Убрать зазубринки при рисовании линий »»