Solved

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

Posted on 2011-03-18
27
1,201 Views
Last Modified: 2012-05-11
I am trying to get a 2nd image into another cell/column in VT.

I have the following created and seems to be working, but when I shrink the column,
the image is getting into the other column
so i must be doing something wrong.

Also I would like to have in 1 of the colums a Combobox in a cell.  how do I do that?

thank so much

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);
 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);
 Png.LoadFromStream(Res);
 TargetCanvas.draw(X, Y, png);
 freeAndNil(res);
 FreeAndNil(png);
end;

Open in new window

0
Comment
Question by:perry4916
  • 15
  • 12
27 Comments
 
LVL 32

Expert Comment

by:ewangoya
ID: 35172871

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
0
 
LVL 32

Expert Comment

by:ewangoya
ID: 35172905
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;

Open in new window

0
 
LVL 32

Expert Comment

by:ewangoya
ID: 35172947

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;

Open in new window

0
 
LVL 32

Expert Comment

by:ewangoya
ID: 35172978

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;

Open in new window

0
 
LVL 32

Expert Comment

by:ewangoya
ID: 35172993

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;

Open in new window

0
 

Author Comment

by:perry4916
ID: 35173456
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
0
 
LVL 32

Expert Comment

by:ewangoya
ID: 35173470

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
0
 

Author Comment

by:perry4916
ID: 35173522
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.

0
 
LVL 32

Expert Comment

by:ewangoya
ID: 35173580

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;

Open in new window

0
 

Author Comment

by:perry4916
ID: 35173738
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);

0
 
LVL 32

Expert Comment

by:ewangoya
ID: 35173755

Did you change fnumber to integer
0
 
LVL 32

Expert Comment

by:ewangoya
ID: 35173759

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

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

Author Comment

by:perry4916
ID: 35173782
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)
0
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 

Author Comment

by:perry4916
ID: 35173787
here is a picture
 screen captyre
0
 
LVL 32

Expert Comment

by:ewangoya
ID: 35173795


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;
0
 
LVL 32

Expert Comment

by:ewangoya
ID: 35173823

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;
0
 

Author Comment

by:perry4916
ID: 35173837
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)

0
 
LVL 32

Expert Comment

by:ewangoya
ID: 35173855

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;

Open in new window

0
 
LVL 32

Accepted Solution

by:
ewangoya earned 500 total points
ID: 35173859
or
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 - R.Left, 16);  
  BitBlt(TargetCanvas.Handle, R.Left, R.Top, R.Right, FBitmap.Height, FBitmap.Canvas.Handle, 0, 0, SRCCOPY);
  
end;

Open in new window

0
 

Assisted Solution

by:perry4916
perry4916 earned 0 total points
ID: 35173989
I got it to work  now,  had to make some changes, since it didn't show correctly.
the Cellrect  was tricky, since it always stays 0 .  so the image was flat


but this is the end code, and it's working now :)

FBitmap:=tbitmap.Create;
 FBitmap.Width := ImageList1.Width;
 FBitmap.Height := ImageList1.Height;
 fnumber:= StrToIntDef(TTreeDataClass(data.FObject).flag, 0);
 R := perrytree.Header.Columns[34].GetRect;
 R.Left := R.Left  + TVirtualStringTree(Sender).Margin;
 R.Top := ((ImageList1.Height-CellRect.top) div 2) +2 ;
 ImageList1.Draw(FBitmap.Canvas, 0, 0, fnumber, True);
 R.Right := Min(R.Right, FBitmap.Width + R.Left);
 TargetCanvas.StretchDraw(R, FBitmap);
 freeandnil(FBitmap);

Open in new window

0
 
LVL 32

Expert Comment

by:ewangoya
ID: 35174000

That was interesting I must say
0
 

Author Comment

by:perry4916
ID: 35174086
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.
0
 

Author Comment

by:perry4916
ID: 35174105
Forgot to award the points to the user
0
 
LVL 32

Expert Comment

by:ewangoya
ID: 35174106
Oops, did you forget to assign points
0
 

Author Comment

by:perry4916
ID: 35174228
I did an object and awarded you the 500 points.   for some reason, I clicked on myself to Accept the solution instead of you.
0
 

Author Comment

by:perry4916
ID: 35174231
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.
0
 

Author Closing Comment

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

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…
This tutorial demonstrates a quick way of adding group price to multiple Magento products.

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now