Delphi自定义组件开发：将TDBLookupComboBox下拉控件替换为TCheckListBox

核心实现思路 #

TDBLookupComboBox的原生下拉列表是系统自带的组合框窗口，要替换为TCheckListBox，需要拦截下拉触发的系统消息，替换为自定义弹出窗口。无需完全从零用WinAPI编写窗口，用Delphi的TForm封装TCheckListBox更高效，同时结合少量WinAPI调整窗口外观以匹配原生控件风格。

具体实现步骤 #

1. 定义组件类与弹出窗口

创建继承自TDBLookupComboBox的组件，同时定义承载TCheckListBox的弹出窗口类：

unit DBCheckLookupComboBox;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, StdCtrls, DB, DBCtrls, Forms, CheckLst;

type
  TPopupCheckListForm = class(TForm)
    CheckListBox: TCheckListBox;
  private
    FOwnerCombo: TDBLookupComboBox;
    procedure WMDeactivate(var Msg: TWMDeactivate); message WM_DEACTIVATE;
    procedure SyncData;
  public
    constructor Create(AOwner: TComponent; ACombo: TDBLookupComboBox); reintroduce;
    procedure ShowAtCombo;
  end;

  TDBCheckLookupComboBox = class(TDBLookupComboBox)
  private
    FPopupForm: TPopupCheckListForm;
    procedure WndProc(var Message: TMessage); override;
    procedure DropDown;
    procedure ClosePopup;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    destructor Destroy; override;
  end;

implementation

{$R *.dfm}

{ TPopupCheckListForm }

constructor TPopupCheckListForm.Create(AOwner: TComponent; ACombo: TDBLookupComboBox);
begin
  inherited CreateNew(AOwner);
  FOwnerCombo := ACombo;
  BorderStyle := bsNone;
  FormStyle := fsPopup;
  Position := poDesigned;
  // 同步字体与颜色
  Font.Assign(ACombo.Font);
  Color := ACombo.Color;
  // 添加原生边框效果
  SetWindowLongPtr(Handle, GWL_EXSTYLE, GetWindowLongPtr(Handle, GWL_EXSTYLE) or WS_EX_CLIENTEDGE);
  SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or SWP_NOMOVE or SWP_NOSIZE);
  
  // 创建TCheckListBox
  CheckListBox := TCheckListBox.Create(Self);
  CheckListBox.Parent := Self;
  CheckListBox.Align := alClient;
  CheckListBox.OnClick := procedure(Sender: TObject)
    var
      SelectedText: string;
      I: Integer;
    begin
      // 拼接选中项文本回写到原组件
      SelectedText := '';
      for I := 0 to CheckListBox.Items.Count - 1 do
        if CheckListBox.Checked[I] then
          if SelectedText = '' then
            SelectedText := CheckListBox.Items[I]
          else
            SelectedText := SelectedText + ', ' + CheckListBox.Items[I];
      FOwnerCombo.Text := SelectedText;
    end;
  SyncData;
end;

procedure TPopupCheckListForm.SyncData;
var
  I: Integer;
  CurrentValue: string;
begin
  CheckListBox.Items.Clear;
  if not Assigned(FOwnerCombo.ListSource) or not Assigned(FOwnerCombo.ListSource.DataSet) then Exit;
  
  CurrentValue := FOwnerCombo.Text;
  FOwnerCombo.ListSource.DataSet.First;
  while not FOwnerCombo.ListSource.DataSet.Eof do
  begin
    CheckListBox.Items.Add(FOwnerCombo.ListSource.DataSet.FieldByName(FOwnerCombo.ListField).AsString);
    // 根据当前值设置初始选中状态
    I := CheckListBox.Items.Count - 1;
    CheckListBox.Checked[I] := Pos(CheckListBox.Items[I], CurrentValue) > 0;
    FOwnerCombo.ListSource.DataSet.Next;
  end;
end;

procedure TPopupCheckListForm.ShowAtCombo;
var
  R: TRect;
begin
  R := FOwnerCombo.ClientRect;
  R := FOwnerCombo.ClientToScreen(R);
  // 匹配原组件宽度，固定下拉高度（可根据项数动态调整）
  SetBounds(R.Left, R.Bottom, FOwnerCombo.Width, 200);
  Show;
end;

procedure TPopupCheckListForm.WMDeactivate(var Msg: TWMDeactivate);
begin
  inherited;
  // 失去焦点时关闭弹出窗口
  if Msg.Active = 0 then Close;
end;

{ TDBCheckLookupComboBox }

destructor TDBCheckLookupComboBox.Destroy;
begin
  ClosePopup;
  inherited;
end;

procedure TDBCheckLookupComboBox.DropDown;
begin
  if not Assigned(FPopupForm) then
    FPopupForm := TPopupCheckListForm.Create(Self, Self);
  FPopupForm.ShowAtCombo;
end;

procedure TDBCheckLookupComboBox.ClosePopup;
begin
  if Assigned(FPopupForm) then
  begin
    FPopupForm.Free;
    FPopupForm := nil;
  end;
end;

procedure TDBCheckLookupComboBox.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    CB_SHOWDROPDOWN:
      begin
        // 拦截原生下拉消息，替换为自定义弹出
        if Boolean(Message.WParam) then
          DropDown
        else
          ClosePopup;
        Message.Result := 0;
        Exit;
      end;
  end;
  inherited WndProc(Message);
end;

procedure TDBCheckLookupComboBox.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FPopupForm) then
    FPopupForm := nil;
end;

end.

2. 关键技术点说明

• 拦截下拉消息：重写WndProc处理CB_SHOWDROPDOWN消息，完全替代原生下拉行为，触发自定义弹出窗口。
• 弹出窗口外观匹配：
  • 设置FormStyle为fsPopup，确保窗口始终在父组件上方且无任务栏图标；
  • 通过SetWindowLongPtr添加WS_EX_CLIENTEDGE扩展样式，实现原生下拉框的边框效果；
  • 同步原组件的字体、背景色，保证视觉一致性。
• 数据同步：弹出窗口初始化时从原组件的ListSource加载选项，根据当前文本值设置复选框初始选中状态，点击复选框时拼接选中项回写到原组件。

3. 关于WinAPI的使用

不需要完全用WinAPI创建弹出窗口，用Delphi的TForm封装更便捷，但需少量WinAPI调用调整窗口样式、处理窗口位置，确保行为与原生控件一致。

内容的提问来源于stack exchange，提问作者Sam