Amigos míos, hice esta pregunta porque resulta tremendamente útil tener un combobox que despliegue un arbol, por ejemplo cuando tienes que modificar una categoría y quieres elegir si esa categoría tiene que depender de otra rama, etc. Como sé la importancia que tiene todo esto, les comparto la unidad que hace dicha operación, puesto que una vez más encontré primero la respuesta:
Código Delphi
[-]unit u_dkTreeBox;
interface
uses Classes, Graphics, 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 SetText(const Value: string);
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 write SetText;
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
procedure Register;
begin
RegisterComponents('Unidades Propias',[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.SetText(const Value: string);
begin
FText := 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;
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 < X) and
(R.TopLeft.y < 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.