TComboBox - how to adjust drop down list height while it is dropped down?

I was inspired by this question: How to make a combo box with full-text search autocomplete support?

The answer works just fine but I want to adjust the suggestion list Height/DropDownCount when the user types the text while the list is already dropped down.

Here is an MCVE with minor modifications - When the user starts typing, the drop down list will drop-down, and I also fixed the mouse cursor effect not being set to arrow when the list dropped down:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, StrUtils, ExtCtrls;

type
  TComboBox = class(StdCtrls.TComboBox)
  private
    FStoredItems: TStringList;
    FOldCursor: TCursor; // NEW !!!
    procedure FilterItems;
    procedure StoredItemsChange(Sender: TObject);
    procedure SetStoredItems(const Value: TStringList);
    procedure CNCommand(var AMessage: TWMCommand); message CN_COMMAND; 
    procedure AdjustDropDownHeight; // NEW !!!
  protected
    // NEW !!!
    procedure KeyPress(var Key: Char); override;
    procedure DropDown; override;
    procedure CloseUp; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property StoredItems: TStringList read FStoredItems write SetStoredItems;
  end;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

constructor TComboBox.Create(AOwner: TComponent);
begin
  inherited;
  AutoComplete := False;
  FStoredItems := TStringList.Create;
  FStoredItems.OnChange := StoredItemsChange;
end;

destructor TComboBox.Destroy;
begin
  FStoredItems.Free;
  inherited;
end;

procedure TComboBox.CNCommand(var AMessage: TWMCommand);
begin
  // we have to process everything from our ancestor
  inherited;
  // if we received the CBN_EDITUPDATE notification
  if AMessage.NotifyCode = CBN_EDITUPDATE then
    // fill the items with the matches
    FilterItems;
end;

procedure TComboBox.FilterItems;
var
  I: Integer;
  Selection: TSelection;
begin
  // store the current combo edit selection
  SendMessage(Handle, CB_GETEDITSEL, WPARAM(@Selection.StartPos),
    LPARAM(@Selection.EndPos));
  // begin with the items update
  Items.BeginUpdate;
  try
    // if the combo edit is not empty, then clear the items
    // and search through the FStoredItems
    if Text <> '' then
    begin
      // clear all items
      Items.Clear;
      // iterate through all of them
      for I := 0 to FStoredItems.Count - 1 do
        // check if the current one contains the text in edit
        if ContainsText(FStoredItems[I], Text) then
          // and if so, then add it to the items
          Items.Add(FStoredItems[I]);
    end
    // else the combo edit is empty
    else
      // so then we'll use all what we have in the FStoredItems
      Items.Assign(FStoredItems)
  finally
    // finish the items update
    Items.EndUpdate;
  end;
  // and restore the last combo edit selection
  SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(Selection.StartPos,
    Selection.EndPos));

  // NEW !!! - if the list is dropped down adjust the list height
  if DroppedDown then
    AdjustDropDownHeight;
end;

procedure TComboBox.StoredItemsChange(Sender: TObject);
begin
  if Assigned(FStoredItems) then
    FilterItems;
end;

procedure TComboBox.SetStoredItems(const Value: TStringList);
begin
  if Assigned(FStoredItems) then
    FStoredItems.Assign(Value)
  else
    FStoredItems := Value;
end;

//  NEW !!!
procedure TComboBox.KeyPress(var Key: Char);
begin
  inherited;
  if not (Ord(Key) in [VK_RETURN, VK_ESCAPE]) then
  begin
    if (Items.Count <> 0) and not DroppedDown then
      // SendMessage(Handle, CB_SHOWDROPDOWN, 1, 0); 
      DroppedDown := True;
  end;
end;

procedure TComboBox.DropDown;
begin
  FOldCursor := Screen.Cursor;
  Screen.Cursor := crArrow;
  inherited;
end;

procedure TComboBox.CloseUp;
begin
  Screen.Cursor := FOldCursor;
  inherited;
end;

procedure TComboBox.AdjustDropDownHeight;
var
  Count: Integer;
begin
  Count := Items.Count;
  SetWindowPos(FDropHandle, 0, 0, 0, Width, ItemHeight * Count +
    Height + 2, SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_NOREDRAW or
    SWP_HIDEWINDOW);
  SetWindowPos(FDropHandle, 0, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or
    SWP_NOZORDER or SWP_NOACTIVATE or SWP_NOREDRAW or SWP_SHOWWINDOW);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  ComboBox: TComboBox;
begin
  // here's one combo created dynamically
  ComboBox := TComboBox.Create(Self);
  ComboBox.Parent := Self;
  ComboBox.Left := 10;
  ComboBox.Top := 10;

  // here's how to fill the StoredItems
  ComboBox.StoredItems.BeginUpdate;
  try
    ComboBox.StoredItems.Add('Mr John Brown');
    ComboBox.StoredItems.Add('Mrs Amanda Brown');
    ComboBox.StoredItems.Add('Mr Brian Jones');
    ComboBox.StoredItems.Add('Mrs Samantha Smith');
  finally
    ComboBox.StoredItems.EndUpdate;
  end;      
end;    

end.

I have added the AdjustDropDownHeight (inspired by TCustomCombo.AdjustDropDown) in the FilterItems method, but it not seems to work as expected. The window hides and it's height is not adjusted according to the actual items in the TComboBox while it is dropped down.

Seems like the FDropHandle is not responding (or handeling) the SetWindowPos(FDropHandle, ... in the AdjustDropDownHeight method.

Can this be fixed? how to adjust the height of the drop down while it is dropped down according to the actual items?

EDIT: Setting DropDownCount := Items.Count (as suggested in the answer) was the first thing I have tried (it sets the max number of items). However the drop down Window does not change its height while typing the text (while it is already dropped down). SetDropDownCount setter simply sets FDropDownCount := Value. this will set the drop down count/height the next time the drop down list is dropped. and I need it to change while it is dropped down. Hope its more clear now.

(Maybe newer Delphi versions have a different SetDropDownCount setter?)

To show better what I want:

User types Mr

Then Mrs (the height of the list is adjusted)

Then user press backspace to Mr (list height adjusted again):

EDIT 2: @Dsm was correct, and gave me the right direction. newer Delphi version SetDropDownCount setter sends extra CB_SETMINVISIBLE message, and this works as expected:

procedure TCustomCombo.SetDropDownCount(const Value: Integer);
begin
  if Value <> FDropDownCount then
  begin
    FDropDownCount := Value;
    if HandleAllocated and CheckWin32Version(5, 1) and ThemeServices.ThemesEnabled then
      SendMessage(Handle, CB_SETMINVISIBLE, WPARAM(FDropDownCount), 0);
  end;
end;

For older version define:

const
  CBM_FIRST               = $1700;
  CB_SETMINVISIBLE        = CBM_FIRST + 1;

Recommended topics

Hot tags