如何使 ComboBox 下拉列表比 ComboBox 本身*窄*

Question

是否可以使组合框下拉列表比组合框本身更窄？

有很多例子设置宽度使用 SendMessage(Handle, CB_SETDROPPEDWIDTH, 100, 200);

但是 最小值 取自组合框本身，无论此处指定了什么。

所有这些例子都让它变大了。

Answer 1

在绘制下拉列表之前，发出WM_CTLCOLORLISTBOX消息。

通过覆盖组合框 WindowProc 可以缩小下拉列表的宽度。

检测到 WM_CTLCOLORLISTBOX 消息，并且由于消息提供了列表 window 的句柄，我们可以获取列表边界并以缩小的宽度调用 MoveWindow。

type
  TMyForm = class(TForm)
    ...
    ComboBox1 : TComboBox;
    procedure FormCreate(Sender: TObject);
    ...
  private
    { Private declarations }
    ComboBox1WindowProcORIGINAL : TWndMethod;
    procedure ComboBox1WindowProc(var Message: TMessage);
    ...
  end;

procedure TMyForm.ComboBox1WindowProc(var Message: TMessage);
var
  lbr: TRect;
begin
  //drawing the list box with combobox items
  if Message.Msg = WM_CTLCOLORLISTBOX then
  begin
    //list box rectangle
    GetWindowRect(Message.LParam, lbr);
    //Shrink window width
    MoveWindow( Message.LParam,
                lbr.Left,
                lbr.Top,
                50,                  // New width
                lbr.Bottom-lbr.Top,
                false); 
  end;
  ComboBox1WindowProcORIGINAL(Message);  
end;

procedure TMyForm.FormCreate(Sender: TObject);
begin
  //attach custom WindowProc for ComboBox1
  ComboBox1WindowProcORIGINAL := ComboBox1.WindowProc;
  ComboBox1.WindowProc := ComboBox1WindowProc;
end;

---

您可以通过创建一个中介层 class 来做一些小改动。要么放在一个单独的单元中并在 vcl.StdCtrls 之后声明，要么放在你的表单单元中。

type
  TComboBox = class(vcl.StdCtrls.TComboBox)
    private
      FDropDownWidth : Integer;
      function GetDropDownWidth : Integer;
    protected
      procedure WndProc(var Mess: TMessage); override;
    public
      Constructor Create( aOwner: TComponent ); override;
      property DropDownWidth : Integer read GetDropDownWidth write FDropDownWidth;
  end;

constructor TComboBox.Create(aOwner: TComponent);
begin
  inherited;
  DropDownWidth := -1;  // Default state
end;

function TComboBox.GetDropDownWidth: Integer;
begin
  if FDropDownWidth = -1 then // Just keep a default state
    Result := Self.Width
  else
    Result := FDropDownWidth;
end;

procedure TComboBox.WndProc(var Mess: TMessage);
var
  lbr: TRect;
begin    
  if Mess.Msg = WM_CTLCOLORLISTBOX then
  begin
    //list box rectangle
    GetWindowRect(Mess.LParam, lbr);
    //Shrink window width
    MoveWindow( Mess.LParam,
                lbr.Left,
                lbr.Top,
                DropDownWidth,
                lbr.Bottom-lbr.Top,
                false);
  end
  else
  if Mess.Msg = CB_SETDROPPEDWIDTH then
    DropDownWidth := Mess.WParam;

  Inherited WndProc(Mess);
end;

用cb.Perform(CB_SETDROPPEDWIDTH,newWidth,0);或cb.DropDownWidth := newWidth;

设置下拉宽度