Delphi 自己的关闭控件 

  1 unit ummFormButton;
  2 //add by Mrml
  3 interface
  4 uses
  5   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Dialogs;
  6 
  7 type
  8 
  9   TmmFormButton = class(TGraphicControl)
 10   private
 11     FDown: Boolean; //按下
 12     FActiveColor: TColor;
 13     FMouseEnter: Boolean;
 14     FCaption: string;
 15     FOnClick : TNotifyEvent;
 16     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
 17     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
 18   protected
 19     procedure Paint; override;
 20     procedure Click; override;
 21     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
 22       X, Y: Integer); override;
 23     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
 24       X, Y: Integer); override;
 25   public
 26     constructor Create(AOwner: TComponent); override;
 27     destructor Destroy; override;
 28 
 29   published
 30     property ActiveColor: TColor read FActiveColor write FActiveColor;
 31     property Caption: string read FCaption write FCaption;
 32     property OnClick:TNotifyevent read FOnClick write FOnClick;{定义事件属性名}
 33     property Enabled;
 34     property Font;
 35 
 36   end;
 37 
 38 implementation
 39 
 40 { TmmFormButton }
 41 
 42 procedure TmmFormButton.Click;
 43 begin
 44   if assigned(FOnClick) then
 45     FOnClick(Self);
 46 end;
 47 
 48 procedure TmmFormButton.CMMouseEnter(var Message: TMessage);
 49 begin
 50   inherited;
 51   FMouseEnter := True;
 52   Invalidate;
 53 end;
 54 
 55 procedure TmmFormButton.CMMouseLeave(var Message: TMessage);
 56 begin
 57   inherited;
 58   FMouseEnter := False;
 59   Invalidate;
 60 end;
 61 
 62 constructor TmmFormButton.Create(AOwner: TComponent);
 63 begin
 64   inherited Create(AOwner);
 65   FMouseEnter := False;
 66   FDown:=False;
 67   Width := 30;
 68   Height := 30;
 69   FActiveColor :=clRed;
 70   Visible := True;
 71 
 72 end;
 73 
 74 destructor TmmFormButton.Destroy;
 75 begin
 76 
 77   inherited;
 78 end;
 79 
 80 procedure TmmFormButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
 81   Y: Integer);
 82 begin
 83   inherited MouseDown(Button, Shift, X, Y);
 84   if (Button = mbLeft) and Enabled then
 85   begin
 86     if not FDown then
 87     begin
 88       FDown:=True;
 89       Invalidate;
 90     end;
 91   end;
 92 end;
 93 
 94 procedure TmmFormButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
 95   Y: Integer);
 96 var
 97   DoClick: Boolean;
 98 begin
 99   inherited MouseUp(Button, Shift, X, Y);
100   if FDown then
101   begin
102     FDown:=False;
103     DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight);
104     Invalidate;
105   end;
106  if DoClick then Click;
107 end;
108 
109 procedure TmmFormButton.Paint;
110 var
111   R: TRect;
112   X, Y: Integer;
113   aText: string;
114 begin
115   aText := FCaption;
116   if FMouseEnter then
117   begin
118     Canvas.Brush.Style := bsSolid;//填充
119     if not FDown then
120        Canvas.Brush.Color := FActiveColor
121     else
122        Canvas.Brush.Color :=RGB(155,0,0);
123     Canvas.FillRect(ClientRect);
124     Canvas.Brush.Style := bsClear;
125     Canvas.Font.Color := clWebWhite;
126     if not FDown then
127     begin
128       Canvas.Font.Size := 12;
129       X := (Width - Canvas.TextWidth(aText)) div 2;
130       Y := (Height - Canvas.TextHeight(aText)) div 2;
131     end
132     else
133     begin
134       Canvas.Font.Size :=12;
135       X := (Width - Canvas.TextWidth(aText)) div 2+1;
136       Y := (Height - Canvas.TextHeight(aText)) div 2+1;
137     end;
138     Canvas.Font.Style:=[fsBold];
139     Canvas.TextOut(X, Y, aText);
140   end
141   else
142   begin
143 
144     Canvas.Brush.Style := bsClear;
145     Canvas.Font.Color := clWebWhite;//clBtnText
146     if not FDown then
147     begin
148       Canvas.Font.Size := 12;
149       X := (Width - Canvas.TextWidth(aText)) div 2;
150       Y := (Height - Canvas.TextHeight(aText)) div 2;
151     end
152     else
153     begin
154       Canvas.Font.Size :=12;
155       X := (Width - Canvas.TextWidth(aText)) div 2+1;
156       Y := (Height - Canvas.TextHeight(aText)) div 2+1;
157     end;
158     Canvas.Font.Style:=[fsBold];
159     Canvas.TextOut(X, Y, aText);
160   end;
161 
162 
163 end;
164 
165 end.

下面的是调用：

 1   CloseButton:=TmmFormButton.Create(self);
 2   with CloseButton do
 3   begin
 4     Parent:=pnl_top;//指定Parent，将pnl_top换成自己的
 5     Caption:='╳';//显示X
 6     Align:=alRight;//位置
 7     Width:=pnl_top.Height;//高度
 8     CloseButton.OnClick:=mmFormclose;//指向窗体关闭事件
 9   end;
10   //关闭按钮

剩下的大家可以完善补充。

文章地址：https://www.cnblogs.com/mrml/p/14631444.html

posted @ 2021-04-11 20:46  梦入梦里  阅读(110)  评论(0)    收藏  举报