在盒子论坛上看见一Delpher提出要求说：在鼠标进入TEdit控件时弹出消息框，我扩展了TEdit功能，把它封装成了一个组件，代码如下
1 unit MyEdit;
2
3 interface
4
5 uses
6 SysUtils, Classes, Controls, StdCtrls,Messages,Dialogs,Forms,Windows;
7
8 type
9 TMsgDlgMode=(Yes_No,YES_NO_CANCEL,OK,OK_CANCEL,RETRY_CANCEL,ABORT_RETRY_IGNORE);
10 TShowDialogEvent = procedure(Sender: TObject;Result:integer) of object;
11
12 TMyEdit = class(TEdit)
13 private
14 { Private declarations }
15 FAutoShowMsgOnMouseEnter:Boolean ;
16 FAutoShowMsgOnMouseLeave:Boolean ;
17 FMsgMsEnter:String;
18 FMsgMsLeave:String;
19 FMsgDlgModeEnter:TMsgDlgMode;
20 FMsgDlgModeLeave:TMsgDlgMode;
21 FMsgResultEnter:Integer;
22 FMsgResultLeave:Integer;
23 FOnMouseEnter: TNotifyEvent;
24 FOnMouseLeave: TNotifyEvent;
25 FAfterMsgDlgEnter:TShowDialogEvent;
26 FAfterMsgDlgLeave:TShowDialogEvent;
27 procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
28 procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
29 protected
30 { Protected declarations }
31 public
32 { Public declarations }
33 property MsgResultEnter:Integer read FMsgResultEnter write FMsgResultEnter;
34 property MsgResultLeave:Integer read FMsgResultLeave write FMsgResultLeave;
35 published
36 { Published declarations }
37 property AutoShowMsgOnMouseEnter:Boolean read FAutoShowMsgOnMouseEnter write FAutoShowMsgOnMouseEnter;
38 property AutoShowMsgOnMouseLeave:Boolean read FAutoShowMsgOnMouseLeave write FAutoShowMsgOnMouseLeave;
39 property MsgMsEnter:String read FMsgMsEnter write FMsgMsEnter;
40 property MsgMsLeave:String read FMsgMsLeave write FMsgMsLeave;
41 property MsgDlgModeEnter:TMsgDlgMode read FMsgDlgModeEnter write FMsgDlgModeEnter;
42 property MsgDlgModeLeave:TMsgDlgMode read FMsgDlgModeLeave write FMsgDlgModeLeave;
43 property OnMouseEnter:TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
44 property OnMouseLeave:TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
45 property AfterMsgDlgEnter:TShowDialogEvent read FAfterMsgDlgEnter write FAfterMsgDlgEnter;
46 property AfterMsgDlgLeave:TShowDialogEvent read FAfterMsgDlgLeave write FAfterMsgDlgLeave;
47 end;
48
49 procedure Register;
50
51 implementation
52
53 procedure Register;
54 begin
55 RegisterComponents('Samples', [TMyEdit]);
56 end;
57
58 procedure TMyEdit.CMMouseEnter(var Message: TMessage);
59 var
60 DlgMode:Integer ;
61 begin
62 if csDesigning in ComponentState then Exit;
63 if Assigned(FOnMouseEnter) then
64 FOnMouseEnter(Self);
65 if FAutoShowMsgOnMouseEnter then
66 begin
67 case FMsgDlgModeEnter of
68 Yes_No:DlgMode:=MB_YESNO;
69 YES_NO_CANCEL:DlgMode:=MB_YESNOCANCEL;
70 OK:DlgMode:=MB_OK;
71 OK_CANCEL:DlgMode:=MB_OKCANCEL;
72 RETRY_CANCEL:DlgMode:=MB_RETRYCANCEL;
73 ABORT_RETRY_IGNORE:DlgMode:=MB_ABORTRETRYIGNORE;
74 end;
75 if FMsgMsEnter='' then
76 FMsgMsEnter:='Mouse Enter';
77 FMsgResultEnter:=Application.MessageBox(PChar(FMsgMsEnter),
78 PChar(Application.Title),
79 DlgMode);
80 if Assigned(FAfterMsgDlgEnter) then
81 FAfterMsgDlgEnter(Self,FMsgResultEnter);
82 end;
83 end;
84
85 procedure TMyEdit.CMMouseLeave(var Message: TMessage);
86 var
87 DlgMode:Integer ;
88 begin
89 if csDesigning in ComponentState then Exit;
90 if Assigned(FOnMouseLeave) then
91 FOnMouseLeave(Self);
92 if FAutoShowMsgOnMouseLeave then
93 begin
94 case FMsgDlgModeLeave of
95 Yes_No:DlgMode:=MB_YESNO;
96 YES_NO_CANCEL:DlgMode:=MB_YESNOCANCEL;
97 OK:DlgMode:=MB_OK;
98 OK_CANCEL:DlgMode:=MB_OKCANCEL;
99 RETRY_CANCEL:DlgMode:=MB_RETRYCANCEL;
100 ABORT_RETRY_IGNORE:DlgMode:=MB_ABORTRETRYIGNORE;
101 end;
102 if FMsgMsLeave='' then
103 FMsgMsLeave:='Mouse Leave';
104 FMsgResultLeave:=Application.MessageBox(PChar(FMsgMsLeave),
105 PChar(Application.Title),
106 DlgMode);
107 if Assigned(FAfterMsgDlgLeave) then
108 FAfterMsgDlgLeave(Self,FMsgResultLeave);
109 end;
110 end;
111
112 end.
113
