TComboBox - 如何在下拉时调整下拉列表高度？
TComboBox - how to adjust drop down list height while it is dropped down?
我被这个问题启发了：How to make a combo box with full-text search autocomplete support?
answer 工作得很好，但我想在用户键入文本 而 [=79= 时调整建议列表高度/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.
我在 FilterItems 方法中添加了 AdjustDropDownHeight（受 TCustomCombo.AdjustDropDown 启发），但它似乎没有按预期工作。 window隐藏，下拉时不根据TComboBox中的实际项目调整高度。
似乎 FDropHandle 没有响应（或处理）AdjustDropDownHeight 方法中的 SetWindowPos(FDropHandle, ...。
这可以修复吗？如何根据实际项目调整下拉框的高度？
编辑： 设置 DropDownCount := Items.Count（如答案中所建议的）是我尝试的第一件事（它设置 max 项目数）。然而，下拉 Window 在键入文本时不会改变其高度（虽然它已经被下拉）。 SetDropDownCount setter 只是设置 FDropDownCount := Value。这将设置下拉列表 count/height 下一次 下拉列表被删除。我需要它来更改 而 它被下拉。希望现在更清楚了。
（也许较新的 Delphi 版本有不同的 SetDropDownCount setter？）
为了更好地展示我想要的：
用户类型Mr
然后Mrs（调整了列表的高度）
然后用户按退格键到Mr（再次调整列表高度）：
编辑 2：
@Dsm 是正确的，给了我正确的方向。较新的 Delphi 版本 SetDropDownCount setter 发送额外的 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;
对于旧版本定义：
const
CBM_FIRST = 00;
CB_SETMINVISIBLE = CBM_FIRST + 1;
其实就这么简单
procedure TComboBox.AdjustDropDownHeight;
begin
DropDownCount := Items.Count;
end;
我用你们的 MCVE 测试过，效果很好。
我被这个问题启发了：How to make a combo box with full-text search autocomplete support?
answer 工作得很好，但我想在用户键入文本 而 [=79= 时调整建议列表高度/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.
我在 FilterItems 方法中添加了 AdjustDropDownHeight（受 TCustomCombo.AdjustDropDown 启发），但它似乎没有按预期工作。 window隐藏，下拉时不根据TComboBox中的实际项目调整高度。
似乎 FDropHandle 没有响应（或处理）AdjustDropDownHeight 方法中的 SetWindowPos(FDropHandle, ...。
这可以修复吗？如何根据实际项目调整下拉框的高度？
编辑： 设置 DropDownCount := Items.Count（如答案中所建议的）是我尝试的第一件事（它设置 max 项目数）。然而，下拉 Window 在键入文本时不会改变其高度（虽然它已经被下拉）。 SetDropDownCount setter 只是设置 FDropDownCount := Value。这将设置下拉列表 count/height 下一次 下拉列表被删除。我需要它来更改 而 它被下拉。希望现在更清楚了。
（也许较新的 Delphi 版本有不同的 SetDropDownCount setter？）
为了更好地展示我想要的：
用户类型Mr
然后Mrs（调整了列表的高度）
然后用户按退格键到Mr（再次调整列表高度）：
编辑 2：
@Dsm 是正确的，给了我正确的方向。较新的 Delphi 版本 SetDropDownCount setter 发送额外的 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;
对于旧版本定义：
const
CBM_FIRST = 00;
CB_SETMINVISIBLE = CBM_FIRST + 1;
其实就这么简单
procedure TComboBox.AdjustDropDownHeight;
begin
DropDownCount := Items.Count;
end;
我用你们的 MCVE 测试过，效果很好。