Consultando a cerca de un combobox que despliegue un árbol

[rarratia]

Amigos, ¿alguien conoce algún componente que sea un combobox pero que despliegue un TreeView????

[Casimiro Notevi]

Por favor, recuerda poner títulos descriptivos a lo que preguntas, gracias.

[rarratia]

Ok, disculpa, pero ¿conoces algún componente en delphi que lo haga???

[Casimiro Notevi]

No recuerdo ninguno, no sé si te sirve un virtualtreeview

[rarratia]

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, {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 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

{ TdkTreeBox }
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;

{ 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 < 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.

[rarratia]

Empezado por Casimiro Notevi

No recuerdo ninguno, no sé si te sirve un virtualtreeview

Amigo, uso el virtualtreeview que es buenísimo pero no es un combobox que despliega un árbol, por eso he puesto la unidad para que puedan usarla que si lo hace. Saludos

[Casimiro Notevi]

Empezado por rarratia

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:

Vaya, qué inteligente y qué generoso de tu parte

Aunque se te olvidó mencionar que el paquete se puede descargar de aquí y que además le has quitado la cabecera al código que has puesto, falta una parte del principio, la que dice:

{-----------------------------------------------------------------------------
Unit Name: dkTreeBox
Author: Eugine Veselov
Purpose: Ïðèìåð èç ñòàòüè. Äëÿ Êîðîëåâñòâà Äåëôè
History:
-----------------------------------------------------------------------------}

Ya sabes, hay que ser generoso con el trabajo de los demás y qué menos que dejar la parte donde está anotado el autor del código que vas a usar gracias a él

[rarratia]

Disculpa, pero tuve problemas con la compilación del paquete, me generaba error el nombre y volé la cabecera del componente y le cambié el nombre a la unidad, si te fijas dice: u_dkTreeBox y no era el nombre original. Pero no me he atribuido como autor del componente. Si sabías, podrías haberme ahorrado búsqueda, pero en fin igual se agradece.

Saludos

[rarratia]

A propósito, le cambié también el solo lectura de la propiedad Text, ese fue otro cambio, ahora se puede escribir dicha propiedad en tiempo de ejecución...