Советы по Delphi

         

Хочу реализовать правильный выпадающий контрол (combo). Как это сделать?


Nomadic отвечает:

Когда-то потратил немало времени на разбор, как же все таки работают дропдаун-контролы. В итоге мной был написан маленький юнит, который я положил у себя в каталоге 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

{  TPopupListBox  }

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.

[001112]



Содержание раздела