Как реализовать правильный выпадающий контрол (Combo)
Когда-то потратил немало времени на разбор, как же все таки работаю дропдаун контролы. В итоге мной был написан маленький юнит, который я положил у себя в каталоге Demo для ознакомления интерисующихся. Он маленький (его основная задача -- показать принцип работы, а все остальное -- как реализуешь), я думаю, что большинству он пригодиться, поэтому публикую здесь.
unit edit1;
interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;
type
TPopupListbox = class(TCustomListbox)
protectedprocedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
override;
end;
TTestDropEdit = class(TEdit)
private
FPickList: TPopupListbox;
procedure CMCancelMode(varmessage: TCMCancelMode); message CM_CancelMode;
procedure WMKillFocus(varmessage: TMessage); message WM_KillFocus;
protectedprocedure CloseUp(Accept: Boolean);
procedure DropDown;
procedure WndProc(varmessage: TMessage); override;
publicconstructor Create(Owner: TComponent); override;
destructor Destroy; override;
end;
implementationprocedure TPopupListBox.CreateParams(var Params: TCreateParams);
begininherited;
with Params dobegin
Style := Style or WS_BORDER;
ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
WindowClass.Style := CS_SAVEBITS;
end;
end;
procedure TPopupListbox.CreateWnd;
begininherited CreateWnd;
Windows.SetParent(Handle, 0);
CallWindowProc(DefWndProc, Handle, WM_SETFOCUS, 0, 0);
end;
procedure TPopupListbox.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begininherited MouseUp(Button, Shift, X, Y);
TTestDropEdit(Owner).CloseUp((X >= 0) and (Y >= 0) and
(X < Width) and (Y < Height));
end;
{ TTestDropEdit }constructor TTestDropEdit.Create(Owner: TComponent);
begininherited Create(Owner);
Parent := Owner as TWinControl;
FPickList := TPopupListbox.Create(nil);
FPickList.Visible := False;
FPickList.Parent := Self;
FPickList.IntegralHeight := True;
FPickList.ItemHeight := 11;
FPickList.Items.CommaText :='1,2,3,4,5,6,7,8,9,0';
end;
destructor TTestDropEdit.Destroy;
begin
FPickList.Free;
inherited;
end;
procedure TTestDropEdit.CloseUp(Accept: Boolean);
beginif FPickList.Visible thenbeginif GetCapture <> 0 then
SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
SetWindowPos(FPickList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
if FPickList.ItemIndex <> -1 then
Text := FPickList.Items.Strings[FPickList.ItemIndex];
FPickList.Visible := False;
Invalidate;
end;
end;
procedure TTestDropEdit.DropDown;
var
P: TPoint;
I,J,Y: Integer;
beginif Assigned(FPickList) and (not FPickList.Visible) thenbegin
FPickList.Width := Width;
FPickList.Color := Color;
FPickList.Font := Font;
FPickList.Height := 6 * FPickList.ItemHeight + 4;
FPickList.ItemIndex := FPickList.Items.IndexOf(Text);
P := Parent.ClientToScreen(Point(Left, Top));
Y := P.Y + Height;
if Y + FPickList.Height > Screen.Height then
Y := P.Y - FPickList.Height;
SetWindowPos(FPickList.Handle, HWND_TOP, P.X, Y, 0, 0,
SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
FPickList.Visible := True;
Invalidate;
Windows.SetFocus(Handle);
end;
end;
procedure TTestDropEdit.CMCancelMode(varmessage: TCMCancelMode);
beginif (message.Sender <> Self) and (message.Sender <> FPickList) then
CloseUp(False);
end;
procedure TTestDropEdit.WMKillFocus(varmessage: TMessage);
begininherited;
CloseUp(False);
end;
procedure TTestDropEdit.WndProc(varmessage: TMessage);
procedure DoDropDownKeys(var Key: Word; Shift: TShiftState);
begincase Key of
VK_UP, VK_DOWN:
if ssAlt in Shift thenbeginif FPickList.Visible then
CloseUp(True)
else
DropDown;
Key := 0;
end;
VK_RETURN, VK_ESCAPE:
if FPickList.Visible andnot (ssAlt in Shift) thenbegin
CloseUp(Key = VK_RETURN);
Key := 0;
end;
end;
end;
begincasemessage.Msg of
WM_KeyDown, WM_SysKeyDown, WM_Char:
with TWMKey(message) dobegin
DoDropDownKeys(CharCode, KeyDataToShiftState(KeyData));
if (CharCode <> 0) and FPickList.Visible thenbeginwith TMessage(message) do
SendMessage(FPickList.Handle, Msg, WParam, LParam);
Exit;
end;
endend;
inherited;
end;
end.
Перевод контента на русский язык:
Код, который вы предоставили, - это кастомное реализация комбобокса (выпадающего списка) в Delphi. Это хороший подход для создания повторно используемого компонента, но есть некоторые проблемы и области для улучшения:
PopupListbox: Класс TPopupListbox appears to be a custom version of the standard TListBox. Однако, он не наследуется от TListBox, что означает, что вам придется реализовывать все методы и свойства вручную. Рекомендуется наследоваться от TListBox и переопределять только необходимые методы.
CreateParams: В методе CreateParams вы устанавливаете несколько стиля окон, включая WS_BORDER, WS_EX_TOOLWINDOW и CS_SAVEBITS. Хотя эти стили могут быть полезны для выпадающего списка, они не нужны для комбобокса. Рекомендуется удалить их или изменить на более подходящие для вашего случая.
CreateWnd: Метод CreateWnd устанавливает родителя для списка в 0, что означает, что он не будет иметь родительского окна. Это, вероятно, преднамеренное решение, но вам может быть полезно изменить это и установить родителя в комбобокс.
MouseUp: В методе MouseUp вы вызываете CloseUp, когда клик мышью происходит вне списка. Однако, вам также нужно проверять, был ли отпущен левый кнопок мыши (то есть Button = mbLeft) перед вызовом CloseUp.
DropDown: В методе DropDown вы устанавливаете ширину списка в соответствии с шириной комбобокса. Рекомендуется использовать Width := Parent.ClientWidth вместо этого, чтобы список адаптировался к ширине родительского окна.
Font и Color: Вы устанавливаете шрифт и цвет списка в соответствие с шрифтом и цветом комбобокса. Хотя это приятно, вам может быть полезно использовать системный дефолтный шрифт и цвет для списка.
Альтернативное решение:
Вместо создания кастомного класса TPopupListbox вы можете использовать стандартный контрол TComboBox в Delphi и настроить его внешний вид и поведение через свойства и события. Например, вы можете установить свойство Style в csDropDown, чтобы включить функцию выпадающего списка, и обрабатывать событие OnSelect, чтобы ответить на выбор элемента.
Вот упрощенный пример реализации базового комбобокса с кастомным списком:
typeTCustomComboBox=class(TComboBox)privateFListbox:TListBox;publicconstructorCreate(AOwner:TComponent);override;procedureDropDown;override;end;implementationconstructorTCustomComboBox.Create(AOwner:TComponent);begininheritedCreate(AOwner);FListbox:=TListBox.Create(nil);FListbox.Parent:=self;FListbox.Height:=100;// Настройка внешнего вида и поведения списка...end;procedureTCustomComboBox.DropDown;beginFListbox.Visible:=True;// Аjustment позиции и размера списка...end;
В этом примере создается кастомный комбобокс, который имеет дочерний список. Когда кнопка выпадающего списка кликнута, метод DropDown делает список видимым. Вам может быть полезно настроить внешний вид и поведение списка через его свойства и события.
Обратите внимание, что это только упрощенный пример, и вам может потребоваться реализация дополнительной логики для обработки навигации по клавиатуре, выбора элемента и других функций в зависимости от вашего требования.
В статье описывается реализация правильного выпадающего контрола (Combo) в Delphi с использованием unit edit1 и создания класса TTestDropEdit.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.