在盒子论坛上看见一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
组件下载:https://files.cnblogs.com/uws2056/TMyEdit.rar
|
请发表评论