Before the drop-down list is to be painted, a WM_CTLCOLORLISTBOX message is issued.
By overriding the combobox WindowProc
it is possible to shrink the drop down list width.
The WM_CTLCOLORLISTBOX
message is detected and since the message supplies the handle of the list window, we can grab the list bounds and call MoveWindow
with a shrinked width.
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;

You can make a small hack by creating an interposer class. Either put it in a separate unit and declare it after vcl.StdCtrls
, or put it in your form unit.
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;
Either set the drop-down width with cb.Perform(CB_SETDROPPEDWIDTH,newWidth,0);
or cb.DropDownWidth := newWidth;