Title: TreeView+ComboBox
Question: I want to show how to create the combobox with popup tree.
(sorry foe my bad English) ^)
Answer:
unit dkTreeBox;
interface
uses Classes, Graphics, {Types,} ComCtrls,
Controls, Windows, SysUtils, Messages, Forms,ImgList;
type
TdkTreeBox = class;
TdkListView = class(TCustomTreeView)
private
FEdit: TdkTreeBox;
procedure WMKillFocus(var Message: TMessage); message WM_KILLFOCUS;
protected
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure KeyPress(var Key: Char); override;
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); override;
end;
TdkTreeBox = class(TCustomControl)
private
FPopupList: TdkListView;
FListVisible: Boolean;
FText: string;
FButtonWidth: Integer;
FPressed: Boolean;
FHasFocus: Boolean;
FAlignment: TAlignment;
FOnDropDown: TNotifyEvent;
FOnCloseUp: TNotifyEvent;
procedure SetAlignment(const Value: TAlignment);
procedure WMSetFocus(var Message: TMessage); message WM_SETFOCUS;
procedure WMKillFocus(var Message: TMessage); message WM_KILLFOCUS;
procedure SetOnCloseUp(const Value: TNotifyEvent);
procedure SetOnDropDown(const Value: TNotifyEvent);
function GetItems: TTreeNodes;
procedure SetItems(const Value: TTreeNodes);
function GetImages: TCustomImageList;
function GetStateImages: TCustomImageList;
procedure SetImages(const Value: TCustomImageList);
procedure SetStateImages(const Value: TCustomImageList);
function GetListHeight: Integer;
procedure SetListHeight(const Value: Integer);
protected
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyUP(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure Paint; override;
procedure CreateParams(var Params: TCreateParams); override;
procedure DropDown; virtual;
procedure CloseUp(Accept: Boolean); virtual;
public
constructor Create(AOwner: TComponent); override;
property Text: string read FText;
published
property Alignment: TAlignment read FAlignment write SetAlignment;
property OnDropDown: TNotifyEvent read FOnDropDown write SetOnDropDown;
property OnCloseUp: TNotifyEvent read FOnCloseUp write SetOnCloseUp;
property Items: TTreeNodes read GetItems write SetItems;
property Images: TCustomImageList read GetImages write SetImages;
property StateImages: TCustomImageList read GetStateImages write SetStateImages;
property ListHeight:Integer read GetListHeight write SetListHeight;
property Anchors;
property BiDiMode;
property Color;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ImeMode;
property ImeName;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Visible;
property OnClick;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
procedure Register;
implementation
{ TdkTreeBox }
procedure Register;
begin
RegisterComponents('DelphiKindomDemo',[TdkTreeBox]);
end;
procedure TdkTreeBox.CloseUp(Accept: Boolean);
begin
SetFocus;
if Accept and Assigned(FPopupList.Selected) then
FText := FPopupList.Selected.Text;
SetWindowPos(FPopupList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
FListVisible := False;
if Assigned(FOnCloseUp) then FOnCloseUp(Self);
Repaint;
end;
constructor TdkTreeBox.Create(AOwner: TComponent);
begin
inherited;
FButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
ControlStyle := ControlStyle + [csReplicatable];
if NewStyleControls then
ControlStyle := [csOpaque]
else
ControlStyle := [csOpaque, csFramed];
ParentColor := False;
TabStop := True;
FPopupList := TdkListView.Create(Self);
FListVisible := False;
FPopupList.HideSelection := True;
Height:=24;
end;
procedure TdkTreeBox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
if NewStyleControls and Ctl3D then
ExStyle := ExStyle or WS_EX_CLIENTEDGE
else
Style := Style or WS_BORDER;
end;
procedure TdkTreeBox.DropDown;
var
P: TPoint;
Y: Integer;
begin
if Assigned(FOnDropDown) then FOnDropDown(Self);
FPopupList.Color := Color;
FPopupList.Font := Font;
FPopupList.Width := Width;
FListVisible := True;
P := Parent.ClientToScreen(Point(Left, Top));
Y := P.Y + Height;
if Y + FPopupList.Height Screen.Height then Y := P.Y - FPopupList.Height;
SetWindowPos(FPopupList.Handle, HWND_TOP, P.X, Y, 0, 0,
SWP_NOSIZE or SWP_SHOWWINDOW);
FPopupList.Repaint;
end;
function TdkTreeBox.GetImages: TCustomImageList;
begin
Result:=FPopupList.Images;
end;
function TdkTreeBox.GetItems: TTreeNodes;
begin
Result := FPopupList.Items;
end;
function TdkTreeBox.GetListHeight: Integer;
begin
Result:=FPopupList.Height;
end;
function TdkTreeBox.GetStateImages: TCustomImageList;
begin
Result:=FPopupList.StateImages;
end;
procedure TdkTreeBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited;
FPressed := True;
Invalidate;
if not FlistVisible then
DropDown
else
CloseUp(False);
end;
procedure TdkTreeBox.KeyPress(var Key: Char);
begin
inherited;
end;
procedure TdkTreeBox.KeyUP(var Key: Word; Shift: TShiftState);
begin
inherited;
Invalidate;
end;
procedure TdkTreeBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
inherited;
FPressed := True;
Invalidate;
if not FlistVisible then
DropDown
else
CloseUp(False);
end;
procedure TdkTreeBox.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
end;
procedure TdkTreeBox.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
inherited;
Invalidate;
end;
procedure TdkTreeBox.Paint;
var
W, X, Flags: Integer;
Selected: Boolean;
R: TRect;
begin
Canvas.Font := Font;
Canvas.Brush.Color := Color;
if Enabled then
Canvas.Font.Color := Font.Color
else
Canvas.Font.Color := clGrayText;
Selected := FHasFocus;
if Selected then
begin
Canvas.Font.Color := clHighlightText;
Canvas.Brush.Color := clHighlight;
end;
if (csDesigning in ComponentState) then
FText := Name;
if UseRightToLeftAlignment then ChangeBiDiModeAlignment(FAlignment);
W := ClientWidth - FButtonWidth;
X := 2;
case Alignment of
taRightJustify: X := W - Canvas.TextWidth(Text) - 3;
taCenter: X := (W - Canvas.TextWidth(Text)) div 2;
end;
SetRect(R, 1, 1, W - 1, ClientHeight - 1);
if (SysLocale.MiddleEast) and (BiDiMode = bdRightToLeft) then
begin
Inc(X, FButtonWidth);
Inc(R.Left, FButtonWidth);
R.Right := ClientWidth;
end;
if SysLocale.MiddleEast then TControlCanvas(Canvas).UpdateTextFlags;
Canvas.TextRect(R, X, 2, Text);
if Selected then Canvas.DrawFocusRect(R);
SetRect(R, W, 0, ClientWidth, ClientHeight);
if (SysLocale.MiddleEast) and (BiDiMode = bdRightToLeft) then
begin
R.Left := 0;
R.Right := FButtonWidth;
end;
if not Enabled then
Flags := DFCS_SCROLLCOMBOBOX or DFCS_INACTIVE
else if FPressed then
Flags := DFCS_SCROLLCOMBOBOX or DFCS_FLAT or DFCS_PUSHED
else
Flags := DFCS_SCROLLCOMBOBOX;
DrawFrameControl(Canvas.Handle, R, DFC_SCROLL, Flags);
FPressed := False;
end;
procedure TdkTreeBox.SetAlignment(const Value: TAlignment);
begin
FAlignment := Value;
end;
procedure TdkTreeBox.SetImages(const Value: TCustomImageList);
begin
FPopupList.Images:=Value;
end;
procedure TdkTreeBox.SetItems(const Value: TTreeNodes);
begin
FPopupList.Items.Assign(Value);
end;
procedure TdkTreeBox.SetListHeight(const Value: Integer);
begin
FPopupList.Height:=Value;
end;
procedure TdkTreeBox.SetOnCloseUp(const Value: TNotifyEvent);
begin
FOnCloseUp := Value;
end;
procedure TdkTreeBox.SetOnDropDown(const Value: TNotifyEvent);
begin
FOnDropDown := Value;
end;
procedure TdkTreeBox.SetStateImages(const Value: TCustomImageList);
begin
FPopupList.StateImages:=Value;
end;
procedure TdkTreeBox.WMKillFocus(var Message: TMessage);
begin
FHasFocus := False;
inherited;
if not FPopupList.Focused then CloseUp(True);
end;
procedure TdkTreeBox.WMSetFocus(var Message: TMessage);
begin
FHasFocus := True;
inherited;
Invalidate;
end;
{ TdkListView }
constructor TdkListView.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FEdit := TdkTreeBox(AOwner);
Parent := FEdit;
Visible := False;
ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable];
end;
procedure TdkListView.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
Style := Style or WS_POPUP or WS_VSCROLL or WS_BORDER;
ExStyle := WS_EX_TOOLWINDOW;
AddBiDiModeExStyle(ExStyle);
WindowClass.Style := CS_SAVEBITS;
end;
end;
procedure TdkListView.KeyPress(var Key: Char);
begin
inherited;
if (Key = #13) or (Key = #32) then FEdit.CloseUp(True);
if Key = #27 then FEdit.CloseUp(False);
end;
procedure TdkListView.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
VNode: TTreeNode;
VCanClose: Boolean;
R: Trect;
begin
inherited;
VNode := GetNodeAt(x, y);
if Assigned(VNode) then
begin
R := VNode.DisplayRect(True);
VCanClose := (R.TopLeft.X (R.TopLeft.y if VCanClose then
FEdit.CloseUp(True);
end;
end;
procedure TdkListView.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
Selected := GetNodeAt(x, y);
end;
procedure TdkListView.WMKillFocus(var Message: TMessage);
begin
inherited;
try
FEdit.SetFocus;
except
end;
end;
end.