Карта сайта 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.

Статья Как реализовать правильный выпадающий контрол (Combo) раздела Компоненты и Классы Создание компонент может быть полезна для разработчиков на Delphi и FreePascal.


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


Ваше мнение или вопрос к статье в виде простого текста (Tag <a href=... Disabled). Все комментарии модерируются, модератор оставляет за собой право удалить непонравившейся ему комментарий.

заголовок

e-mail

Ваше имя

Сообщение

Введите код




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



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


реклама



©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru Rambler's Top100
29.03.2024 00:32:37/0.032748937606812/0