TComboBox - 如何在下拉列表中调整下拉列表高度?

zig*_*zig 8 delphi combobox delphi-7

我受到了这个问题的启发:如何制作一个具有全文搜索自动完成支持的组合框

回答工作得很好,但我想调整的建议列表高度/ DropDownCount当用户键入文本,而列表已经掉了下来.

这是一个经过微小修改的MCVE - 当用户开始输入时,下拉列表将下拉,我还修复了当列表下拉时未设置为箭头的鼠标光标效果:

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.
Run Code Online (Sandbox Code Playgroud)

我在方法中添加了AdjustDropDownHeight(灵感来自TCustomCombo.AdjustDropDown)FilterItems,但似乎没有按预期工作.窗口隐藏,并且它的高度不会根据TComboBox下拉时的实际项目进行调整.

好像FDropHandle没有响应(或HANDELING)所述SetWindowPos(FDropHandle, ...AdjustDropDownHeight方法.

这可以修复吗?如何根据实际物品调低下拉高度?


编辑:设置DropDownCount := Items.Count(如答案中所示)是我尝试的第一件事(它设置了最大项目数).但是,在键入文本时,下拉窗口不会更改其高度(当它已经下拉时).SetDropDownCount塞特只是设置FDropDownCount := Value.这将在下次删除下拉列表设置下拉计数/高度.我需要改变,而它掉了下来.希望现在更清楚.

(也许较新的Delphi版本有不同的SetDropDownCountsetter?)


为了更好地展示我想要的东西:

用户类型 Mr

在此输入图像描述

然后Mrs(调整列表的高度)

在此输入图像描述

然后用户按退格键Mr(再次调整列表高度):

在此输入图像描述


编辑2: @Dsm是正确的,并给了我正确的方向.较新的Delphi版本SetDropDownCountsetter发送额外的CB_SETMINVISIBLE消息,这按预期工作:

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;
Run Code Online (Sandbox Code Playgroud)

对于旧版本定义:

const
  CBM_FIRST               = $1700;
  CB_SETMINVISIBLE        = CBM_FIRST + 1;
Run Code Online (Sandbox Code Playgroud)

Dsm*_*Dsm 6

实际上这很简单

procedure TComboBox.AdjustDropDownHeight;
begin
  DropDownCount := Items.Count;
end;
Run Code Online (Sandbox Code Playgroud)

我使用你的MCVE进行了测试,效果很好.

  • 对我来说,它立即改变了高度,即*下次下降时不*.也许它是Delphi的版本.我在柏林.我明天会看一下安装员,看看它是否给出了线索​​. (2认同)