Delphi制作带渐变颜色Panel

//这个是一个组件,不能直接运行,需要安装:-)

Code

  1 //全部完整代码，欢迎使用
  2 
  3 unit GradientPanel;
  4 
  5 interface
  6     
  7 uses
  8   Windows, Messages, SysUtils, Classes, Controls, Graphics, ExtCtrls;
  9 
 10 type
 11   TGradientPosition = (gpLeftToRight, gpTopToBottom, gpRightToLeft,
 12     gpBottomToTop); //颜色渐变方向
 13   TGradientPanel = class(TCustomPanel)
 14   private
 15     //FAlignment: TAlignment;
 16     FGradient: Boolean; //是否渐变
 17     FGradientStartColor: TColor; //渐变开始颜色
 18     FGradientEndColor: TColor; //渐变结束颜色
 19     FBorderColor: TColor; //边框颜色
 20     FGradientPosition: TGradientPosition; //渐变方向
 21     FHasBorder: Boolean;
 22     FOnMouseLeave: TNotifyEvent; //鼠标离开事件通知
 23     FOnMouseEnter: TNotifyEvent; //鼠标进入事件通知
 24     IsMouseOver: Boolean; //鼠标悬停,按下,抬起
 25     procedure SetGradient(const Value: Boolean); //设置是否渐变
 26     procedure SetGradientStartColor(const Value: TColor); //设置开始颜色
 27     procedure SetGradientEndColor(const Value: TColor); //设置结束颜色
 28     procedure SetGradientPosition(const Value: TGradientPosition);
 29     procedure SetBorder(const Value: Boolean);
 30     procedure SetBorderColor(const Value: TColor);
 31     procedure DrawPanel();
 32     procedure DrawBorder();
 33     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
 34     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
 35   protected
 36     procedure Paint; override;
 37 
 38   public
 39     constructor Create(AOwner: TComponent); override;
 40     destructor Destroy; override;
 41 
 42   published
 43     property Gradient: Boolean read FGradient write SetGradient default True;
 44     property GradientStartColor: Tcolor read FGradientStartColor write
 45       SetGradientStartColor default clwhite;
 46     property GradientEndColor: Tcolor read FGradientEndColor write
 47       SetGradientEndColor default clSkyBlue;
 48     property GradientPosition: TGradientPosition read FGradientPosition write
 49       SetGradientPosition default gpTopToBottom;
 50     property HasBorder: Boolean read FHasBorder write SetBorder default True;
 51     property BorderColor: TColor read FBorderColor write SetBorderColor default
 52       clBlack;
 53     property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
 54     property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
 55 
 56     property Alignment;
 57     property Action;
 58     property Caption;
 59     property Align;
 60     property ShowHint;
 61     property Visible;
 62     property Font;
 63     property OnCanResize;
 64     property OnClick;
 65     property OnContextPopup;
 66     property OnDblClick;
 67     property OnDockDrop;
 68     property OnDockOver;
 69     property OnDragDrop;
 70     property OnDragOver;
 71     property OnEndDock;
 72     property OnEndDrag;
 73     property OnEnter;
 74     property OnExit;
 75     property OnGetSiteInfo;
 76     property OnKeyDown;
 77     property OnKeyPress;
 78     property OnKeyUp;
 79     property OnMouseDown;
 80     property OnMouseMove;
 81     property OnMouseUp;
 82     property OnMouseWheel;
 83     property OnMouseWheelDown;
 84     property OnMouseWheelUp;
 85     property OnResize;
 86     property OnStartDock;
 87     property OnStartDrag;
 88     property OnUnDock;
 89   end;
 90 
 91 procedure Register;
 92 
 93 implementation
 94 
 95 procedure Register;
 96 begin
 97   RegisterComponents('Samples', [TGradientPanel]);
 98 end;
 99 
100 { TGradientPanel }
101 
102 procedure TGradientPanel.CMMouseEnter(var Message: TMessage);
103 begin
104   inherited;
105   IsMouseOver := true;
106 
107   {触发OnMouseEnter 事件}
108   if Assigned(FOnMouseEnter) then
109     FOnMouseEnter(Self);
110   //Paint;
111 end;
112 
113 procedure TGradientPanel.CMMouseLeave(var Message: TMessage);
114 begin
115   inherited;
116   isMouseOver := false;
117 
118   {出发OnMouseLeave事件}
119   if Assigned(FOnMouseLeave) then
120     FOnMouseLeave(Self);
121   //Paint;
122 end;
123 
124 constructor TGradientPanel.Create(AOwner: TComponent);
125 begin
126   inherited Create(AOwner);
127   FGradient := True;
128   FGradientStartColor := clwhite;
129   FGradientEndColor := clSkyBlue;
130   FGradientPosition := gpTopToBottom;
131   FHasBorder := True;
132   FBorderColor := clBlack;
133 end;
134 
135 destructor TGradientPanel.Destroy;
136 begin
137 
138   inherited;
139 end;
140 
141 procedure TGradientPanel.DrawBorder;
142 begin
143   if not HasBorder then
144     Exit;
145   Self.Canvas.Pen.Color := FBorderColor;
146   Self.Canvas.MoveTo(0, 0);
147   Self.Canvas.LineTo(Self.Width - 1, 0);
148   Self.Canvas.LineTo(Self.Width - 1, Self.Height - 1);
149   Self.Canvas.LineTo(0, Self.Height - 1);
150   Self.Canvas.LineTo(0, 0);
151 end;
152 
153 procedure TGradientPanel.DrawPanel;
154 var
155   i: Integer;
156   F: Single;
157   Rect: TRect;
158   Flags: Longint;
159   FontHeight: Integer;
160 begin
161   Flags:=DT_EXPANDTABS or DT_NOPREFIX or DT_VCENTER or DT_CENTER;
162   if not FGradient then
163     Exit;
164   case FGradientPosition of
165     gpLeftToRight:
166       begin
167         for I := 0 to Self.Width do
168         begin
169           F := i / Self.Width;
170           Self.Canvas.Pen.Color := RGB(Round(GetRValue(FGradientStartColor) * F
171             + GetRValue(FGradientEndColor) * (1 - F)),
172             Round(GetGValue(FGradientStartColor) * f +
173             GetGValue(FGradientEndColor) * (1 - F)),
174             Round(GetBValue(FGradientStartColor) * f +
175             GetBValue(FGradientEndColor) * (1 - F)));
176           Self.Canvas.MoveTo(i, 0);
177           Self.Canvas.LineTo(i, Self.Height);
178         end;
179       end;
180     gpTopToBottom:
181       begin
182         for I := 0 to Self.Height do
183         begin
184           F := i / Self.Height;
185           Self.Canvas.Pen.Color := RGB(Round(GetRValue(FGradientStartColor) * F
186             + GetRValue(FGradientEndColor) * (1 - F)),
187             Round(GetGValue(FGradientStartColor) * f +
188             GetGValue(FGradientEndColor) * (1 - F)),
189             Round(GetBValue(FGradientStartColor) * f +
190             GetBValue(FGradientEndColor) * (1 - F)));
191           Self.Canvas.MoveTo(0, i);
192           Self.Canvas.LineTo(Self.Width, i);
193         end;
194       end;
195     gpRightToLeft:
196       begin
197         for I := 0 to Self.Width do
198         begin
199           F := i / Self.Width;
200           Self.Canvas.Pen.Color := RGB(Round(GetRValue(FGradientEndColor) * F
201             + GetRValue(FGradientStartColor) * (1 - F)),
202             Round(GetGValue(FGradientEndColor) * f +
203             GetGValue(FGradientStartColor) * (1 - F)),
204             Round(GetBValue(FGradientEndColor) * f +
205             GetBValue(FGradientStartColor) * (1 - F)));
206           Self.Canvas.MoveTo(i, 0);
207           Self.Canvas.LineTo(i, Self.Height);
208         end;
209       end;
210     gpBottomToTop:
211       begin
212         for I := 0 to Self.Height do
213         begin
214           F := i / Self.Height;
215           Self.Canvas.Pen.Color := RGB(Round(GetRValue(FGradientEndColor) * F
216             + GetRValue(FGradientStartColor) * (1 - F)),
217             Round(GetGValue(FGradientEndColor) * f +
218             GetGValue(FGradientStartColor) * (1 - F)),
219             Round(GetBValue(FGradientEndColor) * f +
220             GetBValue(FGradientStartColor) * (1 - F)));
221           Self.Canvas.MoveTo(0, i);
222           Self.Canvas.LineTo(Self.Width, i);
223         end;
224       end;
225   end;
226   Rect := GetClientRect;
227   Canvas.Brush.Style := bsClear;
228   Canvas.Font:=Self.Font;
229   FontHeight := Canvas.TextHeight('W');
230  
231    with Rect do
232     begin
233       Top := ((Bottom + Top) - FontHeight) div 2;
234       Bottom := Top + FontHeight;
235     end;
236   case Self.Alignment of
237     taLeftJustify:
238       begin
239        Flags :=DT_EXPANDTABS or DT_NOPREFIX or DT_VCENTER or DT_LEFT
240       end;
241     taCenter:
242       begin
243        Flags :=DT_EXPANDTABS or DT_NOPREFIX or DT_VCENTER or DT_CENTER
244       end;
245     taRightJustify:
246       begin
247        Flags :=DT_EXPANDTABS or DT_NOPREFIX or DT_VCENTER or DT_RIGHT
248       end;
249   end;
250     Flags := DrawTextBiDiModeFlags(Flags);
251     DrawText(Canvas.Handle, PChar(Self.Caption), -1,
252           Rect, Flags);
253 end;
254 
255 procedure TGradientPanel.Paint;
256 
257 begin
258   inherited;
259 
260   DrawPanel;
261   DrawBorder;
262 
263 end;
264 
265 procedure TGradientPanel.SetBorder(const Value: Boolean);
266 begin
267   FHasBorder := Value;
268   Invalidate;
269 end;
270 
271 procedure TGradientPanel.SetBorderColor(const Value: TColor);
272 begin
273   FBorderColor := Value;
274   Invalidate;
275 end;
276 
277 procedure TGradientPanel.SetGradient(const Value: Boolean);
278 begin
279   FGradient := Value;
280   Invalidate;
281 end;
282 
283 procedure TGradientPanel.SetGradientEndColor(const Value: TColor);
284 begin
285   FGradientEndColor := Value;
286   Invalidate;
287 end;
288 
289 procedure TGradientPanel.SetGradientPosition(const Value: TGradientPosition);
290 begin
291   FGradientPosition := Value;
292   Invalidate;
293 end;
294 
295 procedure TGradientPanel.SetGradientStartColor(const Value: TColor);
296 begin
297   FGradientStartColor := Value;
298   Invalidate;
299 end;
300 
301 end.

转载于:https://www.cnblogs.com/sun_catboy/archive/2008/09/05/1285356.html