Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  133

•  TDictionary Custom Sort  3 315

•  Fast Watermark Sources  3 065

•  3D Designer  4 824

•  Sik Screen Capture  3 319

•  Patch Maker  3 533

•  Айболит (remote control)  3 635

•  ListBox Drag & Drop  2 995

•  Доска для игры Реверси  81 551

•  Графические эффекты  3 926

•  Рисование по маске  3 231

•  Перетаскивание изображений  2 612

•  Canvas Drawing  2 735

•  Рисование Луны  2 560

•  Поворот изображения  2 166

•  Рисование стержней  2 161

•  Paint on Shape  1 564

•  Генератор кроссвордов  2 226

•  Головоломка Paletto  1 764

•  Теорема Монжа об окружностях  2 213

•  Пазл Numbrix  1 682

•  Заборы и коммивояжеры  2 052

•  Игра HIP  1 279

•  Игра Go (Го)  1 224

•  Симулятор лифта  1 471

•  Программа укладки плитки  1 214

•  Генератор лабиринта  1 542

•  Проверка числового ввода  1 352

•  HEX View  1 489

•  Физический маятник  1 355

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Как реализовать правильный выпадающий контрол (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.





Похожие по теме исходники

DBLookupComboBox in StringGrid

ListBox ComboBox




Copyright © 2004-2024 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте