Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
KANSoftWare

Как реализовать правильный выпадающий контрол (Combo)

Delphi , Компоненты и Классы , Создание компонент

Как реализовать правильный выпадающий контрол (Combo)

Когда-то потратил немало времени на разбор, как же все таки работаю дропдаун контролы. В итоге мной был написан маленький юнит, который я положил у себя в каталоге Demo для ознакомления интерисующихся. Он маленький (его основная задача -- показать принцип работы, а все остальное -- как реализуешь), я думаю, что большинству он пригодиться, поэтому публикую здесь.


unit edit1;

interface

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

type
  TPopupListbox = class(TCustomListbox)
  protected
    procedure 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(var message: TCMCancelMode); message CM_CancelMode;
    procedure WMKillFocus(var message: TMessage); message WM_KillFocus;
  protected
    procedure CloseUp(Accept: Boolean);
    procedure DropDown;
    procedure WndProc(var message: TMessage); override;
  public
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
end;

implementation

procedure TPopupListBox.CreateParams(var Params: TCreateParams);
begin
  inherited;
  with Params do
  begin
    Style := Style or WS_BORDER;
    ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
    WindowClass.Style := CS_SAVEBITS;
  end;
end;

procedure TPopupListbox.CreateWnd;
begin
  inherited CreateWnd;
  Windows.SetParent(Handle, 0);
  CallWindowProc(DefWndProc, Handle, WM_SETFOCUS, 0, 0);
end;

procedure TPopupListbox.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
  inherited 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);
begin
  inherited 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);
begin
  if FPickList.Visible then
  begin
    if 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;
begin
  if Assigned(FPickList) and (not FPickList.Visible) then
  begin
    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(var message: TCMCancelMode);
begin
  if (message.Sender <> Self) and (message.Sender <> FPickList) then
    CloseUp(False);
end;

procedure TTestDropEdit.WMKillFocus(var message: TMessage);
begin
  inherited;
  CloseUp(False);
end;

procedure TTestDropEdit.WndProc(var message: TMessage);

  procedure DoDropDownKeys(var Key: Word; Shift: TShiftState);
  begin
    case Key of
      VK_UP, VK_DOWN:
        if ssAlt in Shift then
        begin
          if FPickList.Visible then
            CloseUp(True)
          else
            DropDown;
          Key := 0;
        end;
      VK_RETURN, VK_ESCAPE:
        if FPickList.Visible and not (ssAlt in Shift) then
        begin
          CloseUp(Key = VK_RETURN);
          Key := 0;
        end;
    end;
  end;

begin
  case message.Msg of
    WM_KeyDown, WM_SysKeyDown, WM_Char:
      with TWMKey(message) do
      begin
        DoDropDownKeys(CharCode, KeyDataToShiftState(KeyData));
        if (CharCode <> 0) and FPickList.Visible then
        begin
          with TMessage(message) do
            SendMessage(FPickList.Handle, Msg, WParam, LParam);
          Exit;
        end;
      end
  end;
  inherited;
end;

end.

Перевод контента на русский язык:

Код, который вы предоставили, - это кастомное реализация комбобокса (выпадающего списка) в Delphi. Это хороший подход для создания повторно используемого компонента, но есть некоторые проблемы и области для улучшения:

  1. PopupListbox: Класс TPopupListbox appears to be a custom version of the standard TListBox. Однако, он не наследуется от TListBox, что означает, что вам придется реализовывать все методы и свойства вручную. Рекомендуется наследоваться от TListBox и переопределять только необходимые методы.
  2. CreateParams: В методе CreateParams вы устанавливаете несколько стиля окон, включая WS_BORDER, WS_EX_TOOLWINDOW и CS_SAVEBITS. Хотя эти стили могут быть полезны для выпадающего списка, они не нужны для комбобокса. Рекомендуется удалить их или изменить на более подходящие для вашего случая.
  3. CreateWnd: Метод CreateWnd устанавливает родителя для списка в 0, что означает, что он не будет иметь родительского окна. Это, вероятно, преднамеренное решение, но вам может быть полезно изменить это и установить родителя в комбобокс.
  4. MouseUp: В методе MouseUp вы вызываете CloseUp, когда клик мышью происходит вне списка. Однако, вам также нужно проверять, был ли отпущен левый кнопок мыши (то есть Button = mbLeft) перед вызовом CloseUp.
  5. DropDown: В методе DropDown вы устанавливаете ширину списка в соответствии с шириной комбобокса. Рекомендуется использовать Width := Parent.ClientWidth вместо этого, чтобы список адаптировался к ширине родительского окна.
  6. Font и Color: Вы устанавливаете шрифт и цвет списка в соответствие с шрифтом и цветом комбобокса. Хотя это приятно, вам может быть полезно использовать системный дефолтный шрифт и цвет для списка.

Альтернативное решение:

Вместо создания кастомного класса TPopupListbox вы можете использовать стандартный контрол TComboBox в Delphi и настроить его внешний вид и поведение через свойства и события. Например, вы можете установить свойство Style в csDropDown, чтобы включить функцию выпадающего списка, и обрабатывать событие OnSelect, чтобы ответить на выбор элемента.

Вот упрощенный пример реализации базового комбобокса с кастомным списком:

type
  TCustomComboBox = class(TComboBox)
  private
    FListbox: TListBox;
  public
    constructor Create(AOwner: TComponent); override;
    procedure DropDown; override;
  end;

implementation

constructor TCustomComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FListbox := TListBox.Create(nil);
  FListbox.Parent := self;
  FListbox.Height := 100;
  // Настройка внешнего вида и поведения списка...
end;

procedure TCustomComboBox.DropDown;
begin
  FListbox.Visible := True;
  // Аjustment позиции и размера списка...
end;

В этом примере создается кастомный комбобокс, который имеет дочерний список. Когда кнопка выпадающего списка кликнута, метод DropDown делает список видимым. Вам может быть полезно настроить внешний вид и поведение списка через его свойства и события.

Обратите внимание, что это только упрощенный пример, и вам может потребоваться реализация дополнительной логики для обработки навигации по клавиатуре, выбора элемента и других функций в зависимости от вашего требования.

В статье описывается реализация правильного выпадающего контрола (Combo) в Delphi с использованием unit edit1 и создания класса TTestDropEdit.


Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.


:: Главная :: Создание компонент ::


реклама


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru

Время компиляции файла: 2024-12-22 20:14:06
2025-01-28 04:55:35/0.0040488243103027/0