TGPLinearGradientBrush.Create( const point1, point2: TGPPoint; {线性渐变起始点与终止点} color1, color2: TGPColor {线性渐变起始色与终止色} ); TGPLinearGradientBrush.Create( const point1, point2: TGPPointF; color1, color2: TGPColor );本例效果图:
代码文件:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, TeCanvas, ExtCtrls; type TForm1 = class(TForm) ButtonColor1: TButtonColor; ButtonColor2: TButtonColor; procedure FormCreate(Sender: TObject); procedure FormPaint(Sender: TObject); procedure ButtonColor1Click(Sender: TObject); procedure ButtonColor2Click(Sender: TObject); procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); end; var Form1: TForm1; implementation {$R *.dfm} uses GDIPOBJ, GDIPAPI, TypInfo; var pts: array[0..1] of TPoint; f: Boolean; p: 0..2; procedure TForm1.FormCreate(Sender: TObject); begin ButtonColor1.Caption := '色1 '; ButtonColor2.Caption := '色2 '; ButtonColor1.SymbolColor := clLime; ButtonColor2.SymbolColor := clBlack; pts[0].X := 8; pts[0].Y := 8; pts[1].X := ClientWidth - 10; pts[1].Y := ClientHeight - 10; end; procedure TForm1.FormPaint(Sender: TObject); var g: TGPGraphics; p: TGPPen; lb: TGPLinearGradientBrush; c1,c2: TGPColor; r: TGPRect; begin g := TGPGraphics.Create(Canvas.Handle); p := TGPPen.Create(aclRed); r := MakeRect(20, 40, ClientWidth - 40, ClientHeight - 50); c1 := ColorRefToARGB(ButtonColor1.SymbolColor); c2 := ColorRefToARGB(ButtonColor2.SymbolColor); lb := TGPLinearGradientBrush.Create(TGPPoint(pts[0]), TGPPoint(pts[1]), c1, c2); g.FillEllipse(lb, r); g.DrawRectangle(p, MakeRect(pts[0].X-2, pts[0].Y-2, 4, 4)); g.DrawRectangle(p, MakeRect(pts[1].X-2, pts[1].Y-2, 4, 4)); lb.Free; p.Free; g.Free; end; procedure TForm1.ButtonColor1Click(Sender: TObject); begin Repaint; end; procedure TForm1.ButtonColor2Click(Sender: TObject); begin Repaint; end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin f := True; end; procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var i: Integer; begin if f then begin if p = 0 then Exit; pts[p-1] := Point(X,Y); Repaint; end else begin p := 0; Cursor := crDefault; for i := 0 to 1 do if PtInRect(Bounds(pts[i].X-2, pts[i].Y-2, 4, 4), Point(X,Y)) then begin p := i+1; Cursor := crHandPoint; end; end; end; procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin f := False; end; end.窗体文件:
object Form1: TForm1 Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 197 ClientWidth = 253 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False Position = poScreenCenter OnCreate = FormCreate OnMouseDown = FormMouseDown OnMouseMove = FormMouseMove OnMouseUp = FormMouseUp OnPaint = FormPaint PixelsPerInch = 96 TextHeight = 13 object ButtonColor1: TButtonColor Left = 143 Top = 8 Width = 49 Caption = 'ButtonColor1' TabOrder = 0 OnClick = ButtonColor1Click end object ButtonColor2: TButtonColor Left = 198 Top = 8 Width = 49 Caption = 'ButtonColor2' TabOrder = 1 OnClick = ButtonColor2Click end end