Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

VAR

R : TRect;

N : Integer;

Buff : ARRAY[0..255] OFChar;

BEGIN

WITHBitBtn1 DO BEGIN

Glyph.Canvas.Font := Self.Font;

Glyph.Width := Width-6;

Glyph.Height := Height-6;

R := Bounds(0,0,Glyph.Width,0);

StrPCopy(Buff, Caption);

Caption := '';

DrawText(Glyph.Canvas.Handle, Buff, StrLen(Buff), R, DT_CENTER ORDT_WORDBREAK ORDT_CALCRECT);

OffsetRect(R, (Glyph.Width-R.Right) DIV2, (Glyph.Height - R.Bottom) DIV2);

DrawText(Glyph.Canvas.Handle, Buff, StrLen(Buff), R, DT_CENTER ORDT_WORDBREAK);

END;

END;

procedureTForm1.ChgSpeedButton(Sender: TObject);

VAR

R : TRect;

N : Integer;

Buff : ARRAY[0..255] OFChar;

BEGIN

WITHSpeedButton1 DO BEGIN

Glyph.Canvas.Font := Self.Font;

Glyph.Width := Width-6;

Glyph.Height := Height-6;

R := Bounds(0,0,Glyph.Width,0);

StrPCopy(Buff, Caption);

Caption := '';

DrawText(Glyph.Canvas.Handle, Buff, StrLen(Buff), R,DT_CENTER ORDT_WORDBREAK ORDT_CALCRECT);

OffsetRect(R, (Glyph.Width-R.Right) DIV2, (Glyph.Height - R.Bottom) DIV2);

DrawText(Glyph.Canvas.Handle, Buff, StrLen(Buff), R,DT_CENTER ORDT_WORDBREAK);

END;

END;

procedureTForm1.BitBtn1Click(Sender: TObject);

begin

Close;

end;

end.

-Dennis Passmore

Nomadicотвечает:

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

unitedit1;

interface

usesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type

TPopupListbox = class(TCustomListbox)

protected

procedureCreateParams( varParams: TCreateParams); override;

procedureCreateWnd; override;

procedureMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

end;

TTestDropEdit = class(TEdit)

private

FPickList: TPopupListbox;

procedureCMCancelMode( varMessage: TCMCancelMode); messageCM_CancelMode;

procedureWMKillFocus( var Message: TMessage); messageWM_KillFocus;

protected

procedureCloseUp(Accept: Boolean);

procedureDropDown;

procedureWndProc( var Message: TMessage); override;

public

constructorCreate(Owner: TComponent); override;

destructorDestroy; override;

end;

implementation

{ TPopupListBox }

procedureTPopupListBox.CreateParams( varParams: TCreateParams);

begin

inherited;

withParams do begin

Style := Style orWS_BORDER;

ExStyle := WS_EX_TOOLWINDOW orWS_EX_TOPMOST;

WindowClass.Style := CS_SAVEBITS;

end;

end;

procedureTPopupListbox.CreateWnd;

begin

inheritedCreateWnd;

Windows.SetParent(Handle, 0);

CallWindowProc(DefWndProc, Handle, WM_SETFOCUS, 0, 0);

end;

procedureTPopupListbox.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

inheritedMouseUp(Button, Shift, X, Y);

TTestDropEdit(Owner).CloseUp((X >= 0) and(Y >= 0) and(X < Width) and(Y < Height));

end;

{ TTestDropEdit }

constructorTTestDropEdit.Create(Owner: TComponent);

begin

inheritedCreate(Owner);

Parent := Owner asTWinControl;

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;

destructorTTestDropEdit.Destroy;

begin

FPickList.Free;

inherited;

end;

procedureTTestDropEdit.CloseUp(Accept: Boolean);

begin

ifFPickList.Visible then begin

ifGetCapture <> 0 thenSendMessage(GetCapture, WM_CANCELMODE, 0, 0);

SetWindowPos(FPickList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER orSWP_NOMOVE orSWP_NOSIZE orSWP_NOACTIVATE orSWP_HIDEWINDOW);