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

时间:2018-05-01 12:22:53

标签: delphi combobox delphi-10.1-berlin

是否可以将ComboBox下拉列表设为 Narrower 而不是Combobox本身?

有很多例子可以设定宽度  count($n)

最小值取自组合框本身,无论此处具体是什么。

所有这些例子都使它更大。

1 个答案:

答案 0 :(得分:1)

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

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

检测到WM_CTLCOLORLISTBOX消息,并且由于消息提供了列表窗口的句柄,我们可以获取列表边界并以缩小的宽度调用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;

enter image description here enter image description here

你可以通过创建一个插入类来制作一个小的黑客。将它放在一个单独的单元中并在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;

设置下拉宽度