如何实现这样的功能：单击控件以外的区域，下拉框自动收起？

Question

诸位大虾：
  我做了一个类似Combobox的控件，使用了listbox代替原来的下拉框。现在我想单击控件以外的区域，使listbox隐藏(模仿下拉框自动收起)，不知如何实现，请指教!

Answer 1

procedure TForm1.Edit1Enter(Sender: TObject);
begin
ListBox1.Visible:=true;
end;procedure TForm1.Edit1Exit(Sender: TObject);
begin
ListBox1.Visible:=false;
end;

Answer 2

to hch_45(んこん): 我是要在控件里面实现这样的功能。

Answer 3

楼上的方法好象不可以
你这里使用的这两个事件只有在其他具有输入功能的控件中捕获焦点时才有效。
如果你现在把鼠标放到另外一个按钮上并点下，你会看到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！

Answer 4

to FrameSniper(框架狙击手):这仍然是在控件外实现的。

Answer 5

我两年前就做这个控件了，也碰到这个问题，后来解决的办法：用一个无边Form做下拉列表框，在Form的DeActive事件或消息中关闭这个Form就行。我这里有控件的代码，如果你需要，我发给你。

Answer 6

当单击下拉按扭是，弹出一过无边的Form,Form中放一个Tlist,或其它控件（我是用DBGrid）。

Answer 7

源码如下，有耐心就看看吧：unit ListEdit;interfaceuses
  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;

Answer 8

to shao528(红雪):
  这个方法实在太麻烦，有没有简单一点的？

Answer 9

这个问题是不是太难了？难道csdn没有高人了吗？

Answer 10

用鼠标Hook下拉的时候动态创建一个窗体（窗体里面有一个listbox），注册鼠标hook然后窗体ShowModal。
最后就是Hook的处理
给你一点源代码看看吧
unit MouseHook;
{
  当鼠标点击指定窗口(TheForm)外时，关闭窗口。
  注意：必须在指定窗口ShowModal前调用 SetMouseHook，
        在之后调用 FreeMouseHook !!!!
  例：
  ...
  SetMouseHook(Form1);
  with form1 do showmodal;
  FreeMouseHook;
  ...
}interfaceuses
  Windows, Messages, Controls, Forms;procedure SetMouseHook(Fm:TForm);
procedure FreeMouseHook;implementationVar
  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.

Answer 11

使用SetCapture(Wnd: THandle);和ReleaseCapture函数来实现：
(1)首先需要重载那个是下拉框出现的单击事件，在这个单击事件中，使用SetCapture来当前控件接收所有接下来的Mouse消息；
(2)当Mouse再次单击时，需要判断是否在下拉框控件所载的Rectangle内，如果在外部，则使用ReleaseCapture函数释放掉消息控制权，并把该鼠标消息重新发送给应当接收他的对象；

Answer 12

同意 TommyTong具体的你可以看看dbgrid源码中的TDBGridInplaceEdit,里面有你想要的东西

Answer 13

同意 TommyTong 的方法，而且我也使用过这样的方法，很有用。

Answer 14

我加了一句setCapture后，为什么鼠标没了？