Adding Timage or a Combobox to a column in VirtualTree (Gem soft)

The way you draw the images is very inefficient, you are really slowing down a fast grid component. I'll show you how to do a combobox in a short while

For your image, it would be better if you preload them into an TImageList so you dont have to read from the resource all the time.

Before drawing the image set its width and height (Probably width only)

procedure Tdsmainform.mytreeAfterCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellRect: TRect);
var
  X, Y, i: Integer;
  xx : trect;
  ResName : string;
  Png : Tpngimage;
  Res: TResourceStream;
  data : pertreedata;
  fnumber : string;
begin
  data:=mytree.GetNodeData(node);
  try
    fnumber:=TTreeDataClass(data.FObject).flag;
    xx:= mytree.Header.Columns[34].GetRect  ;
    X := xx.Left  + TVirtualStringTree(Sender).Margin;
    Y := xx.Top + ((xx.bottom-xx.top) div 2) + 2;
    ResName := 'FLAGS' + fnumber;
    Png := tpngimage.create;
    Res := TResourceStream.Create(hInstance,ResName,RT_RCDATA);
    try
      Png.LoadFromStream(Res);
      //you need to set the width of the image, this may be unproportional
      Png.Width := xx.Right - X;
      Png.Height := xx.Bottom - Y;
      TargetCanvas.draw(X, Y, png);
    finally
      freeAndNil(res);
    end;
  finally
    FreeAndNil(png);
  end;
end;

Select allOpen in new window

I'll do this in steps

First thing is to create an editors unit
(This is a strip down of my library that uses DevExpress components, I just modified to use the statndard TComboBox,
You may need to adjust a few things)

unit VirtualTreeEditors;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls, ComCtrls,
  TypInfo, VirtualTrees;  

  TCustomPropertyEditLink = class(TInterfacedObject, IVTEditLink)
  private
    FColumn: Integer;                 // The column of the node being edited.
    FEdit: TWinControl;               // One of the property editor classes.
    FNode: PVirtualNode;              // The node being edited.
    FOldEditText: string;
    FOldWndProc: TWndMethod;
    FStopping: Boolean;
    FTree: TVirtualStringTree;        // A back reference to the tree calling.
  protected
    function CreateEditControl: TWinControl; virtual; abstract;
    procedure DoExit(Sender: TObject);
    procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); virtual;
    procedure EditWndProc(var Message: TMessage); virtual;
    function GetEditText: WideString; virtual;
    function Modified: Boolean; virtual;
    procedure PrepareEditControl; virtual;
    procedure SetEditText(const Value: WideString); virtual;
    procedure StopEdit; virtual;
    property EditControl: TWinControl read FEdit;
  public
    destructor Destroy; override;
    function BeginEdit: Boolean; stdcall;
    function CancelEdit: Boolean; stdcall;
    function EndEdit: Boolean; stdcall;
    function GetBounds: TRect; stdcall;
    function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex): Boolean; stdcall;
    procedure ProcessMessage(var Message: TMessage); stdcall;
    procedure SetBounds(Rect: TRect); virtual; stdcall;
  end;

  TComboPropertyEditLink = class(TCustomPropertyEditLink)
  private
    FPickList: TStringList;
    FSorted: Boolean;
  private
    procedure CreatePickList;
  protected
    function CreateEditControl: TWinControl; override;
    function GetEditText: WideString; override;
    procedure SetEditText(const Value: WideString); override;
    procedure PrepareEditControl; override;
    procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); override;
  public
    constructor Create(const AList: string; ASorted: Boolean = False); overload;
    constructor Create(APickList: TStrings; ASorted: Boolean = False); overload;
    destructor Destroy; override;
  end;

implementation

type
  THackWinControl = class(TWinControl);

function CountOf(const AChar: Char; const AStr: string): Integer;
var
  I: Integer;
begin
  Result := 0;
  if AStr <> EmptyStr then
  begin
    for I := 1 to Length(AStr) do
      if AChar = AStr[I] then
        Inc(Result);
  end;
end;

{ TCustomPropertyEditLink }

function TCustomPropertyEditLink.BeginEdit: Boolean;
begin
  Result := not FStopping;
  if Result then
  begin
    FEdit.Show;
    FEdit.SetFocus;
    FOldWndProc := FEdit.WindowProc;
    FEdit.WindowProc := EditWndProc;
    FOldEditText := GetEditText;
  end;
end;

function TCustomPropertyEditLink.CancelEdit: Boolean;
begin
  Result := not FStopping;
  if Result then
  try
    FStopping := True;
    FEdit.Hide;
    FTree.CancelEditNode;
    StopEdit;
  finally
    FStopping := False;
  end;
end;

destructor TCustomPropertyEditLink.Destroy;
begin
  FEdit.Free;
  inherited Destroy;
end;

procedure TCustomPropertyEditLink.DoExit(Sender: TObject);
begin
  if not FStopping then
    FTree.EndEditNode;
end;

procedure TCustomPropertyEditLink.EditKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_ESCAPE:
      FTree.CancelEditNode;
    VK_RETURN:
      if Shift = [] then
        FTree.EndEditNode
      else
        Exit;
    else
      Exit;
  end;
  Key := 0;
end;

procedure TCustomPropertyEditLink.EditWndProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_CHAR:
      if not (TWMChar(Message).CharCode in [VK_ESCAPE, VK_TAB]) then
        FOldWndProc(Message);
    WM_GETDLGCODE:
      Message.Result := Message.Result or DLGC_WANTARROWS or DLGC_WANTALLKEYS;
  else
    FOldWndProc(Message);
  end;
end;

function TCustomPropertyEditLink.EndEdit: Boolean;
var
  NewText: WideString;
begin
  Result := not FStopping;
  if Result then
  try
    FStopping := True;
    if Modified then
    begin
      NewText := GetEditText;
      FTree.Text[FNode, FColumn] := NewText;
    end;
    FTree.EndEditNode;
    StopEdit;
  finally
    FStopping := False;
  end;
end;

function TCustomPropertyEditLink.GetBounds: TRect;
begin
  Result := FEdit.BoundsRect;
end;

function TCustomPropertyEditLink.GetEditText: WideString;
var
  Len: Integer;
begin
  Len := GetWindowTextLengthW(FEdit.Handle);
  SetLength(Result, Len);
  if Len > 0 then
    GetWindowTextW(FEdit.Handle, @Result[1], Len);
end;

function TCustomPropertyEditLink.Modified: Boolean;
begin
  Result := GetEditText <> FOldEditText;
end;

function TCustomPropertyEditLink.PrepareEdit(Tree: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex): Boolean;
begin
  Result := not FStopping;
  if Result then
  begin
    FTree := Tree as TVirtualStringTree;
    FNode := Node;
    FColumn := Column;
    FreeAndNil(FEdit);
    FEdit := CreateEditControl;
    Result := Assigned(FEdit);
    if Result then
      with FEdit do
      begin
        Visible := False;
        Parent := FTree;
        THackWinControl(FEdit).OnKeyDown := EditKeyDown;
        THackWinControl(FEdit).OnExit := DoExit;
        FEdit.BoundsRect := FTree.GetDisplayRect(FNode, FColumn, False);
        PrepareEditControl;
        SetEditText(FTree.Text[FNode, FColumn]);
      end;
  end;
end;

procedure TCustomPropertyEditLink.PrepareEditControl;
begin
  //
end;

procedure TCustomPropertyEditLink.ProcessMessage(var Message: TMessage);
begin
  FEdit.WindowProc(Message);
end;

procedure TCustomPropertyEditLink.SetBounds(Rect: TRect);
var
  L, R: Integer;
  NodeRect: TRect;
begin
  // Since we don't want to activate grid extensions in the tree
  //(this would influence how the selection is drawn)
  // we have to set the edit's width explicitly to the width of the column.
  if not (toGridExtensions in TVirtualStringTree(FTree).TreeOptions.MiscOptions) then
  begin
    NodeRect := FTree.GetDisplayRect(FNode, FColumn, True);
    Rect.Left := NodeRect.Left;
    TVirtualStringTree(FTree).Header.Columns.GetColumnBounds(FColumn, L, R);
    Rect.Right := R;
  end;
  FEdit.BoundsRect := Rect;
end;

procedure TCustomPropertyEditLink.SetEditText(const Value: WideString);
begin
  SetWindowTextW(FEdit.Handle, PWideChar(Value));
end;

procedure TCustomPropertyEditLink.StopEdit;
begin
  if Assigned(FEdit) then
  begin
    FEdit.Hide;
    FEdit.WindowProc := FOldWndProc;
    FEdit.Parent := nil;
  end;
end;

{ TComboPropertyEditLink }

constructor TComboPropertyEditLink.Create(const AList: string; ASorted: Boolean);
begin
  CreatePickList;
  FSorted := ASorted;
  FPickList.CommaText := AList;
end;

constructor TComboPropertyEditLink.Create(APickList: TStrings; ASorted: Boolean);
begin
  CreatePickList;
  FSorted := ASorted;
  FPickList.AddStrings(APickList);
end;

function TComboPropertyEditLink.CreateEditControl: TWinControl;
begin
  Result := TComboBox.Create(nil);
end;

procedure TComboPropertyEditLink.CreatePickList;
begin
  FPickList := TStringlist.Create;
end;

destructor TComboPropertyEditLink.Destroy;
begin
  FreeAndNil(FPickList);
  inherited;
end;

procedure TComboPropertyEditLink.EditKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
var
  CanAdvance: Boolean;
begin
  case Key of
    VK_ESCAPE:
    begin
      FTree.CancelEditNode;
      Key := 0;
    end;
    VK_RETURN:
    begin
      FTree.EndEditNode;
      Key := 0;
    end;
    VK_UP, VK_DOWN:
    begin
      // Consider special cases before finishing edit mode.
      CanAdvance := Shift = [];
      if FEdit is TcxComboBox then
        CanAdvance := CanAdvance and not TComboBox(FEdit).DroppedDown;
      if CanAdvance then
      begin
        // Forward the keypress to the tree. It will asynchronously change the focused node.
        PostMessage(FTree.Handle, WM_KEYDOWN, Key, 0);
        Key := 0;
      end;
    end;
  end;
end;

function TComboPropertyEditLink.GetEditText: WideString;
begin
  Result := TComboBox(EditControl).Text;
end;

procedure TComboPropertyEditLink.PrepareEditControl;
begin
  inherited;
  with EditControl as TComboBox do
  begin
    Visible := False;
    Parent := FTree;
    Items := FPickList;
  end;
end;

procedure TComboPropertyEditLink.SetEditText(const Value: WideString);
begin
  TComboBox(EditControl).Text := Value;
end;

Select allOpen in new window

To implement in the virtualtree, you two events

procedure VirtualTreeChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure CreateEditor(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);

procedure TForm1.VirtualTreeChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
begin
  with Sender do
  begin
    // Start immediate editing as soon as another node gets focused.
    if Assigned(Node) and (Node.Parent <> RootNode) and not (tsIncrementalSearching in TreeStates) then
    begin
      // We want to start editing the currently selected node. However it might well happen that this change event
      // here is caused by the node editor if another node is currently being edited. It causes trouble
      // to start a new edit operation if the last one is still in progress. So we post us a special message and
      // in the message handler we then can start editing the new node. This works because the posted message
      // is first executed *after* this event and the message, which triggered it is finished.
      PostMessage(Self.Handle, UM_STARTEDITING, Integer(Node), 0);
    end;
  end;
end;

procedure TForm1.VirtualTreeCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode; 
  Column: TColumnIndex; out EditLink: IVTEditLink);
begin
  //FItemList this is the list of items you want in your combobox drop down list
  if Column = 2 then  //this is the column in which you want the combobox
    EditLink := TComboPropertyEditLink.Create(FItemList);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FItemList := TStringList.Create;
  FItemList.Add('one');
  FItemList.Add('two'); 
  FItemList.Add('three');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FItemList);
end;

Select allOpen in new window

For the start edit message handler

const
  UM_STARTEDITING = WM_USER + 101;

TForm1 = class(TForm)
private
  ....
  procedure UMStartEditing(var Message: TMessage); message UM_STARTEDITING;
  ....
end;

procedure TForm1.UMStartEditing(var Message: TMessage);
// This message was posted by ourselves from the node change handler above to decouple that change event and our
// intention to start editing a node. This is necessary to avoid interferences between nodes editors potentially created
// for an old edit action and the new one we start here.
var
  Node: PVirtualNode;
begin
  Node := Pointer(Message.WParam);
  // Note: the test whether a node can really be edited is done in the OnEditing event.
  VirtualTree.EditNode(Node, 1);
end;

Select allOpen in new window

the 2 lines

   Png.Width := xx.Right - X;
   Png.Height := xx.Bottom - Y;
 

do not work, I am getting the error, that I cannot assign a value to a read-only component.

would this though make the difference that it will not overlap to a new column when you shrink the column when you click on the header?



I noticed for the combobox issue, that you basicly need to rewite the component?
I thought that it was as easy as just adding a standard component, and hooking itt up to a cell.
but looks like that's not the case

Changing the width and height of the image will solve the problem at hand, Try using bitmap, with that you can change the width and height
I've never used TPNGImage so I did not know the width and height are read only

Adding the combo box is quite complicated and so is any other control. You have to handle a lot of things your self

Thanks.

I wat trying it wit a Timage  but did not work  so far.
I  can load from file then, but not from stream.
When I use Timage.Picture.Graphice.loadfromstream   then it will give me a 00000000  error.

I will try it with a Tbitmap, and see what happens.

Otherwise I have to figure it out how to use it with a Timagelist   (not the default in VT, caise I am using that one already)
Because I have no clue about that one.

Alternatively you can use BtBlt to transfer the data from the png to the tree canvas if the TPNGImage exposes its canvas

  BitBlt(TargetCanvas.Handle, X, Y, xx-X, yy-Y, Png.Canvas.Handle, 0, 0, SRCCOPY);

For TImageList
You just add the images to a TImageList with position corresponding to what you currently have in the resource file, I see you are using some kind of numbering (fnumber), I'm assuming its an integer

procedure Tdsmainform.mytreeAfterCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellRect: TRect);
var
  X, Y, i: Integer;
  xx : trect;
  data : pertreedata;
  fnumber : Integer;
begin
  data:=mytree.GetNodeData(node);
  
  fnumber:= StrToIntDef(TTreeDataClass(data.FObject).flag, 0);
  xx:= mytree.Header.Columns[34].GetRect  ;
  X := xx.Left  + TVirtualStringTree(Sender).Margin;
  Y := xx.Top + ((xx.bottom-xx.top) div 2) + 2;
    
  FBitmap.Clear;  //you can declare FBitmap in the form and create it in OnFormCreate event
                  //remember to free it OnFormDestroy event
  FBitmap.Width := ImageList.Width;
  FBitmap.Height := ImageList.Height;
  ImageList1.Draw(FBitmap.Canvas, X, Y, fnumber, True); //this will draw to bitmap canvas

  BitBlt(TargetCanvas.Handle, X, Y, xx-X, yy-Y, FBitmap.Canvas.Handle, 0, 0, SRCCOPY); 
end;

Select allOpen in new window

I am getting the error

[DCC Error] mainform.pas(26433): E2250 There is no overloaded version of 'Draw' that can be called with these arguments  on this line

ImageList1.Draw(FBitmap.Canvas, X, Y, fnumber, True);

Did you change fnumber to integer

Actually should have been
ImageList1.Draw(FBitmap.Canvas, 0, 0, fnumber, True)

Or use this instead
ImageList1.GetBitmap(fnumber, FBitmap);

ok, it's working now,  but I still have the same problem.

If I have 2 columns

1st = the image
2nd = some text

when I shrink/drag the column to make it smaller,  the image goes into the view of colum 2
instead of being cut off.

(like the original  Imagelist does in VT)

here is a picture
 

My fault

I did not set the FBitmap.Width correctly, because its initially set to 16

to cut it off
procedure Tdsmainform.mytreeAfterCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellRect: TRect);
var
  X, Y, i: Integer;
  xx : trect;
  data : pertreedata;
  fnumber : Integer;
begin
  data:=mytree.GetNodeData(node);
 
  fnumber:= StrToIntDef(TTreeDataClass(data.FObject).flag, 0);
  xx:= mytree.Header.Columns[34].GetRect  ;
  X := xx.Left  + TVirtualStringTree(Sender).Margin;
  Y := xx.Top + ((xx.bottom-xx.top) div 2) + 2;
   
  FBitmap.Clear;  //you can declare FBitmap in the form and create it in OnFormCreate event
                  //remember to free it OnFormDestroy event
  FBitmap.Width := ImageList.Width;
  FBitmap.Height := ImageList.Height;
  ImageList1.Draw(FBitmap.Canvas, X, Y, fnumber, True); //this will draw to bitmap canvas
  FBitmap.Width := CellRect.Right - X ;  //we need to readjust the width to match the reactangle

  BitBlt(TargetCanvas.Handle, X, Y, xx-X, yy-Y, FBitmap.Canvas.Handle, 0, 0, SRCCOPY);
end;

An interesting question

Why don't you use CellRect, would it not be easier

procedure Tdsmainform.mytreeAfterCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellRect: TRect);
var
  R : TRect;
  data : pertreedata;
  fnumber : Integer;
begin
  data:=mytree.GetNodeData(node);

  fnumber:= StrToIntDef(TTreeDataClass(data.FObject).flag, 0);
  R := CellRect;
  R.Left := R.Left  + TVirtualStringTree(Sender).Margin;
  R.Top := R.Top + ((CellRect.bottom-CellRect.top) div 2) + 2;

  FBitmap.Clear;  //you can declare FBitmap in the form and create it in OnFormCreate event
                  //remember to free it OnFormDestroy event
  FBitmap.Width := ImageList.Width;
  FBitmap.Height := ImageList.Height;
  ImageList.GetBitmap(fnumber, FBitmap);
  //ImageList1.Draw(FBitmap.Canvas, 0, 0, fnumber, True); //this will draw to bitmap canvas
  FBitmap.Width := R.Right - R.Left ;  //we need to readjust the width to match the reactangle

  BitBlt(TargetCanvas.Handle, R.Left, R.Top, FBitmap.Width, FBitmap.Height, FBitmap.Canvas.Handle, 0, 0, SRCCOPY);
end;

I can't win.

Added that line, and it's giving me out of resources now

 FBitmap.Width :=cellrect.Right -x;


 BitBlt(TargetCanvas.Handle, X, Y, 16, 12, FBitmap.Canvas.Handle, 0, 0, SRCCOPY);

I changed from Bitblt the 16 and 12   since  xx-x and yy-y does not work. (or xx.top etc)

So it does not like you to change the width, there are always ways to force the computer to behave
We can write it using stretchdraw or adjust our BitBlt, hang in there

procedure Tdsmainform.mytreeAfterCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellRect: TRect);
var
  R : TRect;
  data : pertreedata;
  fnumber : Integer;
begin
  data:=mytree.GetNodeData(node);

  fnumber:= StrToIntDef(TTreeDataClass(data.FObject).flag, 0);
  R := CellRect;
  R.Left := R.Left  + TVirtualStringTree(Sender).Margin;
  R.Top := R.Top + ((CellRect.bottom-CellRect.top) div 2) + 2;
  FBitmap.Clear;  //you can declare FBitmap in the form and create it in OnFormCreate event
                  //remember to free it OnFormDestroy event
  FBitmap.Width := ImageList.Width;
  FBitmap.Height := ImageList.Height;
  ImageList1.Draw(FBitmap.Canvas, 0, 0, fnumber, True); //this will draw to bitmap canvas

  R.Right := Min(R.Right, 16 + R.Left);  
  TargetCanvas.StretchDraw(R, FBitmap);
  //BitBlt(TargetCanvas.Handle, R.Left, R.Top, FBitmap.Width, FBitmap.Height, FBitmap.Canvas.Handle, 0, 0, 
SRCCOPY);

  
end;

Select allOpen in new window

That was interesting I must say

it sure was..  
Now I am going to play with the combo box.. thing, but that's for another thread

Thanks for all your help.

Forgot to award the points to the user

Oops, did you forget to assign points

I did an object and awarded you the 500 points.   for some reason, I clicked on myself to Accept the solution instead of you.

Notice: perry4916 has requested that this question be closed by accepting ewangoya's comment #35173859 (500 points) as the solution and perry4916's comment #35173989 (0 points) as the assisted solution for the following reason:
Great help from this user.
I would have never thought about the way to handle it.
It gave me new knowledge for future items.

Great help from this user.
I would have never thought about the way to handle it.
It gave me new knowledge for future items.