Создание градиентной заливкиDelphi , Графика и Игры , CanvasСоздание градиентной заливки
Оформил: 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; Создание градиентной заливки на форме Delphi с помощью функции FillGradientRect и создания изображения с помощью функции Gradient. Комментарии и вопросыМатериалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.
|
||||
©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007 |