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

Советы » 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

;

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com