实现CheckCommobox时发现鼠标捕获无效

Question

目的：实现一个TComboBox可以对选项进行多选
简单组了一个控件，发现点击下拉框后在点窗体下拉框不会自动收缩。
不知道为什么鼠标事件捕获无效了。代码如下：unit uCheckComboBox;interface
uses
   Windows, Classes, StdCtrls, DB, Controls, Messages, SysUtils,checklst,RzPanel,RzCommon,
   Forms, Graphics, Menus, Buttons,Dialogs,RzLstBox, RzChkLst,RzCmboBx, Mask, RzEdit, RzBtnEdt;type  
   TCheckComboBox = class(TWinControl)
   private
     FMarkchar :Char;
     FItems :TStrings;
     FComBoSel :TRzButtonEdit;
     FDropList :TCheckListBox;
     FCapturedMouse :Boolean;
     function GetFitems: Tstrings;
     procedure SetFitems(const Value: Tstrings);
     function GetChecked(idx: Integer): Boolean;
     procedure SetChecked(idx: Integer; const Value: Boolean);
   protected
     procedure SetDropListVisual(AVisual :Boolean);
     procedure OnDropDownEvent(Sender:TObject);
     procedure OnItemChange(Sender: TObject);
     function GetRealValue(Value :String):String;
     procedure OnDoDropListExit(Sender:Tobject);
     procedure OnDropListMouseUp(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy;override;     property Checked[idx: Integer]:Boolean read GetChecked write SetChecked;
   published
     property Items:Tstrings read GetFitems write SetFitems;
     property Markchar :Char read FMarkchar write FMarkchar;
   end;implementation
constructor TCheckComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCapturedMouse := false;
  FItems:=TStringList.Create;
  FComBoSel := TRzButtonEdit.Create(self);
  FComBoSel.Parent := self;
  FComBoSel.Align := alTop;
  FComBoSel.ButtonKind :=bkDropDown;
  FComBoSel.AllowKeyEdit := false;
  FDropList :=TCheckListBox.Create(self);
  FDropList.Parent :=self;
  FDropList.Align := alClient;
  FDropList.Visible := true;
  FMarkchar :='|';
  self.Top :=20;
  self.Left :=50;
  self.Visible := true;
  self.Height :=100;
  self.Width :=100;
  SetDropListVisual(false);
  FComBoSel.OnButtonClick := OnDropDownEvent;
  FDropList.OnClickCheck :=OnItemChange;
  FDropList.OnExit := OnDoDropListExit;
  FDropList.OnMouseUp := OnDropListMouseUp;
end;destructor TCheckComboBox.Destroy;
begin
  FComBoSel.Free;
  FDropList.Free;
  FItems.Free;
  inherited;
end;function TCheckComboBox.GetChecked(idx: Integer): Boolean;
begin
  result :=FDropList.Checked[idx];
end;function TCheckComboBox.GetFitems: Tstrings;
begin
  result := FDropList.Items;
end;function TCheckComboBox.GetRealValue(Value: String): String;
var
  idx :integer;
begin
  result :='';
  idx := Pos(FMarkchar,Value);
  if idx > 0 then
    result :=Copy(Value,1,idx-1);
end;procedure TCheckComboBox.OnDropDownEvent(Sender: TObject);
begin
  SetDropListVisual(not FDropList.Visible);
end;procedure TCheckComboBox.OnDoDropListExit(Sender: Tobject);
begin
  SetDropListVisual(false);
end;procedure TCheckComboBox.OnItemChange(Sender: TObject);
var
  s :string;
begin  if FDropList.Checked[FDropList.ItemIndex] then
  begin
    if Trim(FComBoSel.Text)='' then
      FComBoSel.Text :=GetRealValue(FDropList.Items.Strings[FDropList.ItemIndex])
    else
      FComBoSel.Text :=FComBoSel.Text+','+ GetRealValue(FDropList.Items.Strings[FDropList.ItemIndex]);
  end
  else
  begin
    s :=FComBoSel.Text ;
    s :=','+s+',';
    s:=StringReplace(s,','+GetRealValue(FDropList.Items[FDropList.ItemIndex])+',',',',[rfReplaceAll, rfIgnoreCase]);
    FComBoSel.Text := Copy(s,2,Length(s)-2);
  end;
end;procedure TCheckComboBox.SetChecked(idx: Integer;
  const Value: Boolean);
begin
  FDropList.Checked[idx] := Value;
end;procedure TCheckComboBox.SetDropListVisual(AVisual: Boolean);
begin
  if AVisual then
  begin
    if not FCapturedMouse then
      SetCapture(FDropList.Handle);
    FCapturedMouse := true;
    height := FDropList.Count*FComBoSel.Height+ FComBoSel.Height+2 ;
    FDropList.Visible := true;
    FDropList.SetFocus;
  end
  else
  begin
    if FCapturedMouse then
    begin
      ReleaseCapture;
      FCapturedMouse := false;
    end;
    FDropList.Visible := false;
    height :=FComBoSel.Height+2 ;
  end;
end;procedure TCheckComboBox.SetFitems(const Value: Tstrings);
begin
  FDropList.Items.Assign(Value);
end;procedure TCheckComboBox.OnDropListMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  p : TPoint;
begin  p.X :=x;
  P.Y :=y;
  if not PtInRect(FDropList.ClientRect,p) then
    SetDropListVisual(false);
  inherited;
end;end.调用示范 
  Box :TCheckComboBox;  Box :=TCheckComboBox.Create(self);
  Box.Parent := self;
  Box.Visible := true;
  Box.Items.Add('A|北京');
  Box.Items.Add('B|上京');
  Box.Items.Add('C|南京');

Answer 1

我测试了下，加了注册Procedure Register;ImplementationProcedure Register;
Begin
  RegisterComponents('MyControl', [TCheckComboBox]);
End;
然后放到窗体里，运行，没有问题

Answer 2

以你目前的做法，可以通過攔截窗體所在線程的消息隊列中的 wm_setfocus消息，若當前的焦點在checklistbox，則判斷message所帶的handle是否為checklistbox的handle，然后再做“縮放”的動作，這樣就可以達到自動縮放的目的

Answer 3

谢谢2位，参考了别人的Demo重新实现了。