5,388
社区成员
发帖
与我相关
我的任务
分享如何实现这样的功能：单击控件以外的区域，下拉框自动收起？
诸位大虾：
我做了一个类似Combobox的控件，使用了listbox代替原来的下拉框。现在我想单击控件以外的区域，使listbox隐藏(模仿下拉框自动收起)，不知如何实现，请指教!
我做了一个类似Combobox的控件，使用了listbox代替原来的下拉框。现在我想单击控件以外的区域，使listbox隐藏(模仿下拉框自动收起)，不知如何实现，请指教!
...全文
请发表友善的回复…
发表回复
changhua4929 2003-04-02
- 打赏
- 举报
我加了一句setCapture后，为什么鼠标没了？
changhua4929 2003-04-01
- 打赏
- 举报
这个问题是不是太难了？难道csdn没有高人了吗？
facedge 2003-04-01
- 打赏
- 举报
同意 TommyTong 的方法，而且我也使用过这样的方法，很有用。
liumengchuan 2003-04-01
- 打赏
- 举报
同意 TommyTong
具体的你可以看看dbgrid源码中的TDBGridInplaceEdit,里面有你想要的东西
具体的你可以看看dbgrid源码中的TDBGridInplaceEdit,里面有你想要的东西
墨梅无痕 2003-04-01
- 打赏
- 举报
使用SetCapture(Wnd: THandle);和ReleaseCapture函数来实现：
(1)首先需要重载那个是下拉框出现的单击事件，在这个单击事件中，使用SetCapture来当前控件接收所有接下来的Mouse消息；
(2)当Mouse再次单击时，需要判断是否在下拉框控件所载的Rectangle内，如果在外部，则使用ReleaseCapture函数释放掉消息控制权，并把该鼠标消息重新发送给应当接收他的对象；
(1)首先需要重载那个是下拉框出现的单击事件，在这个单击事件中，使用SetCapture来当前控件接收所有接下来的Mouse消息；
(2)当Mouse再次单击时，需要判断是否在下拉框控件所载的Rectangle内，如果在外部，则使用ReleaseCapture函数释放掉消息控制权，并把该鼠标消息重新发送给应当接收他的对象；
kuangning 2003-04-01
- 打赏
- 举报
用鼠标Hook
下拉的时候动态创建一个窗体（窗体里面有一个listbox），注册鼠标hook然后窗体ShowModal。
最后就是Hook的处理
给你一点源代码看看吧
unit MouseHook;
{
当鼠标点击指定窗口(TheForm)外时，关闭窗口。
注意：必须在指定窗口ShowModal前调用 SetMouseHook，
在之后调用 FreeMouseHook !!!!
例：
...
SetMouseHook(Form1);
with form1 do showmodal;
FreeMouseHook;
...
}
interface
uses
Windows, Messages, Controls, Forms;
procedure SetMouseHook(Fm:TForm);
procedure FreeMouseHook;
implementation
Var
HGetMouseHook:integer=0;
TheForm:TForm;
function GetMouseHook(Code, wParam, lParam: Integer): Integer; stdcall;
var
M: ^MOUSEHOOKSTRUCT;
Msg: Integer;
x,y:integer;
begin
Result:= 0;
if TheForm=nil then exit;
// check for appropriate code
if (Code >= 0)
// and for active application
and Assigned(Application)
and Application.Active
and (not IsIconic(GetActiveWindow))
then begin
msg:=wparam;
// check for mouse messages
if ((Msg >= wm_LButtonDblClk) and (Msg <= wm_MButtonDblClk))
or ((Msg >= wm_NCRButtonDblClk) and (Msg <= wm_NCMButtonDblClk))
or (Msg = wm_LButtonDown)
or (Msg = wm_NCLButtonDown)
or (Msg = wm_NCRButtonDown)
then begin
// here you should check for clicks outside of active form
// and take an appropriate action
// because actial message is packed into the TMsg structure, we should unpack it
M:= pointer(lParam);
x:=m.pt.x;
y:=m.pt.y;
with TheForm do begin
if (x<left) or (y<top) or (x>=left+width) or
(y>=top+height)
then ModalResult:=mrCancel;
end;
Exit;
end;
end;
// in Win32 api stated that this call is optional but I think this statement
// should be always included
Result:= CallNextHookEx(HGetMouseHook, Code, wParam, lParam);
end;
procedure SetMouseHook(Fm:TForm);
begin
if (HGetMouseHook = 0) and (Fm<>nil)
then begin
TheForm:=Fm;
HGetMouseHook:= SetWindowsHookEx(WH_MOUSE, @GetMouseHook,
0,GetCurrentThreadID);
end;
end;
procedure FreeMouseHook;
begin
if HGetMouseHook <> 0
then begin
UnhookWindowsHookEx(HGetMouseHook);
HGetMouseHook:= 0;
TheForm:=nil;
end;
end;
end.
下拉的时候动态创建一个窗体（窗体里面有一个listbox），注册鼠标hook然后窗体ShowModal。
最后就是Hook的处理
给你一点源代码看看吧
unit MouseHook;
{
当鼠标点击指定窗口(TheForm)外时，关闭窗口。
注意：必须在指定窗口ShowModal前调用 SetMouseHook，
在之后调用 FreeMouseHook !!!!
例：
...
SetMouseHook(Form1);
with form1 do showmodal;
FreeMouseHook;
...
}
interface
uses
Windows, Messages, Controls, Forms;
procedure SetMouseHook(Fm:TForm);
procedure FreeMouseHook;
implementation
Var
HGetMouseHook:integer=0;
TheForm:TForm;
function GetMouseHook(Code, wParam, lParam: Integer): Integer; stdcall;
var
M: ^MOUSEHOOKSTRUCT;
Msg: Integer;
x,y:integer;
begin
Result:= 0;
if TheForm=nil then exit;
// check for appropriate code
if (Code >= 0)
// and for active application
and Assigned(Application)
and Application.Active
and (not IsIconic(GetActiveWindow))
then begin
msg:=wparam;
// check for mouse messages
if ((Msg >= wm_LButtonDblClk) and (Msg <= wm_MButtonDblClk))
or ((Msg >= wm_NCRButtonDblClk) and (Msg <= wm_NCMButtonDblClk))
or (Msg = wm_LButtonDown)
or (Msg = wm_NCLButtonDown)
or (Msg = wm_NCRButtonDown)
then begin
// here you should check for clicks outside of active form
// and take an appropriate action
// because actial message is packed into the TMsg structure, we should unpack it
M:= pointer(lParam);
x:=m.pt.x;
y:=m.pt.y;
with TheForm do begin
if (x<left) or (y<top) or (x>=left+width) or
(y>=top+height)
then ModalResult:=mrCancel;
end;
Exit;
end;
end;
// in Win32 api stated that this call is optional but I think this statement
// should be always included
Result:= CallNextHookEx(HGetMouseHook, Code, wParam, lParam);
end;
procedure SetMouseHook(Fm:TForm);
begin
if (HGetMouseHook = 0) and (Fm<>nil)
then begin
TheForm:=Fm;
HGetMouseHook:= SetWindowsHookEx(WH_MOUSE, @GetMouseHook,
0,GetCurrentThreadID);
end;
end;
procedure FreeMouseHook;
begin
if HGetMouseHook <> 0
then begin
UnhookWindowsHookEx(HGetMouseHook);
HGetMouseHook:= 0;
TheForm:=nil;
end;
end;
end.
changhua4929 2003-03-31
- 打赏
- 举报
to shao528(红雪):
这个方法实在太麻烦，有没有简单一点的？
这个方法实在太麻烦，有没有简单一点的？
FrameSniper 2003-03-29
- 打赏
- 举报
你可以在控件里面发送一个消息，然后让消息处理器执行上面的代码啊！
changhua4929 2003-03-29
- 打赏
- 举报
to FrameSniper(框架狙击手):这仍然是在控件外实现的。
emeng 2003-03-29
- 打赏
- 举报
同意
FrameSniper 2003-03-29
- 打赏
- 举报
楼上的方法好象不可以
你这里使用的这两个事件只有在其他具有输入功能的控件中捕获焦点时才有效。
如果你现在把鼠标放到另外一个按钮上并点下，你会看到ListBox1并没有消失！
所以最好使用Form1的OnMouseMove事件来判断当前鼠标是不是在Edit1上，如下：
procedure TMainForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if WindowFromPoint(Mouse.CursorPos)<>Edit1.Handle then
if ListBox1.Visible then
ListBox1.Visible:=False;
end;
这样，每次当鼠标不在Edit1上时，ListBox1都会自动消失，而当鼠标放到Edit1上时，你可以自己编程实现是否是直接出现ListBox1还是点了鼠标以后才出现ListBox1！
你这里使用的这两个事件只有在其他具有输入功能的控件中捕获焦点时才有效。
如果你现在把鼠标放到另外一个按钮上并点下，你会看到ListBox1并没有消失！
所以最好使用Form1的OnMouseMove事件来判断当前鼠标是不是在Edit1上，如下：
procedure TMainForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if WindowFromPoint(Mouse.CursorPos)<>Edit1.Handle then
if ListBox1.Visible then
ListBox1.Visible:=False;
end;
这样，每次当鼠标不在Edit1上时，ListBox1都会自动消失，而当鼠标放到Edit1上时，你可以自己编程实现是否是直接出现ListBox1还是点了鼠标以后才出现ListBox1！
changhua4929 2003-03-29
- 打赏
- 举报
to hch_45(んこん): 我是要在控件里面实现这样的功能。
hch_45 2003-03-29
- 打赏
- 举报
procedure TForm1.Edit1Enter(Sender: TObject);
begin
ListBox1.Visible:=true;
end;
procedure TForm1.Edit1Exit(Sender: TObject);
begin
ListBox1.Visible:=false;
end;
begin
ListBox1.Visible:=true;
end;
procedure TForm1.Edit1Exit(Sender: TObject);
begin
ListBox1.Visible:=false;
end;
FrameSniper 2003-03-29
- 打赏
- 举报
不是吧，这么麻烦？我感觉应该有其他比较简便的方法啊？想......
shao528 2003-03-29
- 打赏
- 举报
源码如下，有耐心就看看吧：
unit ListEdit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Mask, buttons, dbtables,DBCtrls,DB,Edlist,Grids,DBGrids, DpkRes;
type
PTquery=^TQuery;
TBtnClickEvent = procedure(Sender:TObject) of object;
TAfterGetDataEvent = procedure(HelpData:TQuery) of object;
TGridSetColorEvent = procedure(const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState;
Var LineColor,bkColor,RecColor:integer) of object;
TopWay=(owDbClick,owSgClick); //选取方式:双击|单击
TListEdit = class(TMaskEdit)
private
FHelpQuery:TQuery;
FDefaultFont:Boolean;
FDlgFont :TFont;
FparamName:String;
FresultFieldName:string;
FGridWidth:integer;
FGridHeight:integer;
FGridResize :Boolean;
FGridSetColor: TGridSetColorEvent;
FGridOptions :TDBGridOptions;
FHighSel :boolean;
HelpDlg:TfrmEdList;
FclientTop:integer;
FclientLeft:integer;
Fowerform:TwinControl;
FGridcolor:Tcolor;
FgridFont:TFont;
FOpWay :TOpWay;
FSelColor :TColor;
FTitleFont:TFont;
FfixColor:Tcolor;
FParentFont :Boolean;
FQryMask:string;
ButMouseDowned:boolean;
FonBtnClick:TBtnClickEvent;
FonAfterGetData:TAfterGetDataEvent;
FonBeforeQueryOpen:TAfterGetDataEvent;
procedure OndlgDestroy(sender:TObject);
procedure SetEditRect;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
Function GetData(keyn,defa:string):boolean;
procedure setFHelpQuery(DataQry: Tquery);
Procedure setFResultFieldName(Value: string);
Procedure setFParamName(Value: string);
Procedure SetDlgFont(index: integer;Value :TFont);
Procedure SetFGlyph(Value :TBitmap);
function ReadFGlyph:TBitmap;
Procedure SetBtnWidth(Value :integer);
function ReadbtnWidth: integer;
procedure setOwerForm;
Procedure SetDlgPos;
function GetCanPulldown:boolean;
protected
FButton :TSpeedButton;
listShowed, bScanChange, SChanged, ExeByBtn:boolean;
procedure DoBtnClick(sender:Tobject); virtual;
procedure DoAfterGetData; virtual;
procedure DoBeforeOpen(DataSet:TQuery);virtual;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure Notification(AComponent: TComponent;Operation: TOperation); override;
procedure defadlg;
procedure BtnMouseDown (Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
procedure Change(); override;
procedure doExit(); override;
procedure doEnter(); override;
procedure Loaded(); override;
procedure KeyDown(var Key: Word;Shift: TShiftState);override;
procedure KeyPress(var Key: Char);override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure DblClick; override;
procedure ExeFun(Sender:TObject);
// procedure WndProc(var Message :Tmessage);override;
published
property CanPulldown :Boolean read GetCanPulldown;
property BtnGlyph :TBitmap read ReadFGlyph write SetFGlyph;
property BtnWidth :integer read ReadBtnWidth write SetBtnWidth;
property HelpQuery: TQuery read FHelpQuery write SetFHelpQuery;
property ResultFieldName: String read FResultFieldName write SetFResultFieldName;
property ParamName: String read FParamName write SetFParamName;
property GridWidth: integer read FGridWidth write FGridWidth default 0;
property GridHeight: integer read FGridHeight write FGridHeight default 0;
property GridColor: Tcolor read FGridColor write FGridColor default clwhite;
property FixColor: Tcolor read FFixColor write Ffixcolor default clTeal;
property DlgFont : TFont index 0 read FDlgFont write SetDlgFont ;
property GridFont: TFont index 1 read FGridFont write SetDlgFont;
property GridOptions: TDBGridOptions read FGridOptions write FGridOptions;
property GridResize : Boolean read FGridResize write FGridResize default False;
property OpWay :TOpWay read FOpWay write FOpWay default owDbClick;
property TitleFont: TFont index 2 read FTitleFont write SetDlgFont;
property DefaultFont: Boolean read FDefaultFont write FDefaultFont default True;
property PullDowned :Boolean read ListShowed;
property vHighSel:boolean Read FHighSel write FhighSel;
property vSelColor :Tcolor Read FSelColor Write FSelColor;
property QryMask: string read FQryMask write FQryMask;
property OnBtnClick:TBtnClickEvent read FOnBtnClick write FOnBtnClick;
property OnAfterGetData:TAfterGetDataEvent read FOnAfterGetData write FOnAfterGetData;
property OnBeforQueryOpen: TAfterGetDataEvent read FOnBeforeQueryOpen write FOnBeforeQueryOpen;
Property OnGridSetColor:TGridSetColorEvent read FGridSetColor write FGridSetColor;
end;
procedure Register;
implementation
uses SelfFunc;
procedure Register;
begin
RegisterComponents('MyCtrl', [TListEdit]);
end;
procedure TListEdit.DefaDlg;
begin
if(FHelpQuery=nil) or
(FResultFieldName='') or
(Not sChanged and Not ExeByBtn
and (FParamName<>'')
and (Trim(text)<>'') )
then
Exit
else
GetData(FResultFieldName, Text);
end;
procedure TListEdit.DoBtnClick(sender:Tobject);
begin
ExeByBtn := True;
Exefun(self);
end;
procedure TListEdit.Exefun(Sender:Tobject);
begin
if ReadOnly then
exit;
if Assigned(FonBtnClick) then
FonBtnClick(Self)
else
DefaDlg;
end;
procedure TListEdit.OnDlgDestroy(sender:TObject);
begin
if Not FhelpQuery.IsEmpty and (HelpQuery.Tag=1) then
begin
DoAfterGetData;
// Setfocus;
end;
ListShowed:=False;
if FGridResize then
begin
FGridWidth := Tform(Sender).Width;
FGridHeight := Tform(Sender).Height; //记录下栅格的大小
end;
end;
unit ListEdit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Mask, buttons, dbtables,DBCtrls,DB,Edlist,Grids,DBGrids, DpkRes;
type
PTquery=^TQuery;
TBtnClickEvent = procedure(Sender:TObject) of object;
TAfterGetDataEvent = procedure(HelpData:TQuery) of object;
TGridSetColorEvent = procedure(const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState;
Var LineColor,bkColor,RecColor:integer) of object;
TopWay=(owDbClick,owSgClick); //选取方式:双击|单击
TListEdit = class(TMaskEdit)
private
FHelpQuery:TQuery;
FDefaultFont:Boolean;
FDlgFont :TFont;
FparamName:String;
FresultFieldName:string;
FGridWidth:integer;
FGridHeight:integer;
FGridResize :Boolean;
FGridSetColor: TGridSetColorEvent;
FGridOptions :TDBGridOptions;
FHighSel :boolean;
HelpDlg:TfrmEdList;
FclientTop:integer;
FclientLeft:integer;
Fowerform:TwinControl;
FGridcolor:Tcolor;
FgridFont:TFont;
FOpWay :TOpWay;
FSelColor :TColor;
FTitleFont:TFont;
FfixColor:Tcolor;
FParentFont :Boolean;
FQryMask:string;
ButMouseDowned:boolean;
FonBtnClick:TBtnClickEvent;
FonAfterGetData:TAfterGetDataEvent;
FonBeforeQueryOpen:TAfterGetDataEvent;
procedure OndlgDestroy(sender:TObject);
procedure SetEditRect;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
Function GetData(keyn,defa:string):boolean;
procedure setFHelpQuery(DataQry: Tquery);
Procedure setFResultFieldName(Value: string);
Procedure setFParamName(Value: string);
Procedure SetDlgFont(index: integer;Value :TFont);
Procedure SetFGlyph(Value :TBitmap);
function ReadFGlyph:TBitmap;
Procedure SetBtnWidth(Value :integer);
function ReadbtnWidth: integer;
procedure setOwerForm;
Procedure SetDlgPos;
function GetCanPulldown:boolean;
protected
FButton :TSpeedButton;
listShowed, bScanChange, SChanged, ExeByBtn:boolean;
procedure DoBtnClick(sender:Tobject); virtual;
procedure DoAfterGetData; virtual;
procedure DoBeforeOpen(DataSet:TQuery);virtual;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure Notification(AComponent: TComponent;Operation: TOperation); override;
procedure defadlg;
procedure BtnMouseDown (Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
procedure Change(); override;
procedure doExit(); override;
procedure doEnter(); override;
procedure Loaded(); override;
procedure KeyDown(var Key: Word;Shift: TShiftState);override;
procedure KeyPress(var Key: Char);override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure DblClick; override;
procedure ExeFun(Sender:TObject);
// procedure WndProc(var Message :Tmessage);override;
published
property CanPulldown :Boolean read GetCanPulldown;
property BtnGlyph :TBitmap read ReadFGlyph write SetFGlyph;
property BtnWidth :integer read ReadBtnWidth write SetBtnWidth;
property HelpQuery: TQuery read FHelpQuery write SetFHelpQuery;
property ResultFieldName: String read FResultFieldName write SetFResultFieldName;
property ParamName: String read FParamName write SetFParamName;
property GridWidth: integer read FGridWidth write FGridWidth default 0;
property GridHeight: integer read FGridHeight write FGridHeight default 0;
property GridColor: Tcolor read FGridColor write FGridColor default clwhite;
property FixColor: Tcolor read FFixColor write Ffixcolor default clTeal;
property DlgFont : TFont index 0 read FDlgFont write SetDlgFont ;
property GridFont: TFont index 1 read FGridFont write SetDlgFont;
property GridOptions: TDBGridOptions read FGridOptions write FGridOptions;
property GridResize : Boolean read FGridResize write FGridResize default False;
property OpWay :TOpWay read FOpWay write FOpWay default owDbClick;
property TitleFont: TFont index 2 read FTitleFont write SetDlgFont;
property DefaultFont: Boolean read FDefaultFont write FDefaultFont default True;
property PullDowned :Boolean read ListShowed;
property vHighSel:boolean Read FHighSel write FhighSel;
property vSelColor :Tcolor Read FSelColor Write FSelColor;
property QryMask: string read FQryMask write FQryMask;
property OnBtnClick:TBtnClickEvent read FOnBtnClick write FOnBtnClick;
property OnAfterGetData:TAfterGetDataEvent read FOnAfterGetData write FOnAfterGetData;
property OnBeforQueryOpen: TAfterGetDataEvent read FOnBeforeQueryOpen write FOnBeforeQueryOpen;
Property OnGridSetColor:TGridSetColorEvent read FGridSetColor write FGridSetColor;
end;
procedure Register;
implementation
uses SelfFunc;
procedure Register;
begin
RegisterComponents('MyCtrl', [TListEdit]);
end;
procedure TListEdit.DefaDlg;
begin
if(FHelpQuery=nil) or
(FResultFieldName='') or
(Not sChanged and Not ExeByBtn
and (FParamName<>'')
and (Trim(text)<>'') )
then
Exit
else
GetData(FResultFieldName, Text);
end;
procedure TListEdit.DoBtnClick(sender:Tobject);
begin
ExeByBtn := True;
Exefun(self);
end;
procedure TListEdit.Exefun(Sender:Tobject);
begin
if ReadOnly then
exit;
if Assigned(FonBtnClick) then
FonBtnClick(Self)
else
DefaDlg;
end;
procedure TListEdit.OnDlgDestroy(sender:TObject);
begin
if Not FhelpQuery.IsEmpty and (HelpQuery.Tag=1) then
begin
DoAfterGetData;
// Setfocus;
end;
ListShowed:=False;
if FGridResize then
begin
FGridWidth := Tform(Sender).Width;
FGridHeight := Tform(Sender).Height; //记录下栅格的大小
end;
end;
shao528 2003-03-29
- 打赏
- 举报
当单击下拉按扭是，弹出一过无边的Form,Form中放一个Tlist,或其它控件（我是用DBGrid）。
shao528 2003-03-29
- 打赏
- 举报
我两年前就做这个控件了，也碰到这个问题，后来解决的办法：用一个无边Form做下拉列表框，在Form的DeActive事件或消息中关闭这个Form就行。我这里有控件的代码，如果你需要，我发给你。
changhua4929 2003-03-29
- 打赏
- 举报
高手们快来看看！
FrameSniper 2003-03-29
- 打赏
- 举报
不对，让我想想！
