Customdraw TreeView - cannot change font colour

steve-west
steve-west used Ask the Experts™
on
Overriding the CustomDrawItem event and setting default draw to false - thereby performing all the drawing of the tree nodes myself.

If find that I'm allowed one change of font colour. Any changes after this are being ignored.

For example
var
  DisplayText : string;
  NodeRect : TRect;



With TTreeView(Sender).Canvas do
begin
     DefaultDraw := false;
     NodeRect := Node.DisplayRect(False);
     FillRect(NodeRect);
     Font.Color := clBlue;
     DisplayText := Node.Text;
     DrawText(Handle,  DisplayText[1], Length(DisplayText), NodeRect, dt_SingleLine or dt_vcenter);
     NodeRect.Left := Noderect.Left + 100;
     Font.Color := clGreen;
     DrawText(Handle,  DisplayText[1], Length(DisplayText), NodeRect, dt_SingleLine or dt_vcenter);
end;

This will display both occurrences of the text in the colour blue.

Any ideas anyone?

Thanks

Steve


Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Martin BarredaPropietario asociado

Commented:
This is an example code that is working for me at OnCustomDraw event in TTreeView:

procedure TForm1.tvTareasCustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
var i: integer;
begin
  //this portion of code change color and font properties depending on a state
  i := eTareas.IndexOf(Node.Text); //look for text in a TStringList to take the state of the node in i
  if i <> -1 then
    with (Sender as TTreeView) do
      with Canvas do
        begin
          case i of
            eWaiting: begin
                           Brush.Color := clRed;
                           Font.Color  := clWhite;
                         end;
            eStandBy   : Brush.Color := clYellow;
            eFinished: begin
                           Brush.Color := clGreen;
                           Font.Color  := clWhite;
                         end;
          end;
          //Font.Style := [fsBold];
        end;
  //this portion paint internal nodes
  i := eNotas.IndexOf(Node.Text); //this search iin another TStringList for another state
  if i <> -1 then
    with (Sender as TTreeView) do
      with Canvas do
        begin
          case i of
            ePendiente : Brush.Color := clRosa;
            eStandBy   : Brush.Color := clAmarillo;
            eFinalizada: Brush.Color := clVerde;
          end;
          //Font.Style := [fsBold];
        end;
  //this paint most important nodes
  if Node.Parent = nil then
    with (Sender as TTreeView) do
      with Canvas do
        Font.Color := clNavy;
//  else if Node.Parent.Parent = nil then
  //this put bold for all text in the treeview
  with (Sender as TTreeView) do
    with Canvas do
      Font.Style := [fsBold];
end;

Hope this help!
Martin BarredaPropietario asociado

Commented:
Sorry... OnCustomDrawItem event... not at OnCustomDraw as i formerly said.
Commented:
procedure TForm1.TreeView1CustomDrawItem(Sender: TCustomTreeView;
  Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
var
  DisplayText : string;
  NodeRect : TRect;
  BitmapRect: TRect;
  Bitmap: TBitmap;
begin
 DefaultDraw := false;
 NodeRect := Node.DisplayRect(False);
 DisplayText := Node.Text;
 Bitmap := TBitmap.Create;
 try
  Bitmap.Height := NodeRect.Bottom - NodeRect.Top;
  Bitmap.Width := NodeRect.Right - NodeRect.Left;
  Bitmap.Canvas.Font.Color := clBlue;
  BitmapRect := Bitmap.Canvas.ClipRect;
  //Bitmap.Canvas.FillRect(Bitmap.Canvas.ClipRect);
  DrawText(Bitmap.Canvas.Handle, PChar(DisplayText), Length(DisplayText), BitmapRect, DT_SINGLELINE or DT_VCENTER);
  BitmapRect.Left := BitmapRect.Left + 100;
  Bitmap.Canvas.Font.Color := clGreen;
  DrawText(Bitmap.Canvas.Handle, PChar(DisplayText), Length(DisplayText), BitmapRect, DT_SINGLELINE or DT_VCENTER);
  BitBlt(TTreeView(Sender).Canvas.Handle, NodeRect.Left, NodeRect.Top,
         NodeRect.Right - NodeRect.Left, NodeRect.Bottom- NodeRect.Top,
         Bitmap.Canvas.Handle, 0, 0, SRCCOPY)
 finally
  Bitmap.Free
 end;
end;
CompTIA Cloud+

The CompTIA Cloud+ Basic training course will teach you about cloud concepts and models, data storage, networking, and network infrastructure.

Top Expert 2007

Commented:
Try Like this


For example
var
  DisplayText : string;
  NodeRect : TRect;



With TTreeView(Sender).Canvas do
begin
     DefaultDraw := false;
     NodeRect := Node.DisplayRect(False);
     FillRect(NodeRect);
     Font.Color := clBlue;
     DisplayText := Node.Text;
     DrawText(Handle,  DisplayText[1], Length(DisplayText), NodeRect, dt_SingleLine or dt_vcenter);
     NodeRect.Left := Noderect.Left + 100;
     Font.Color := clGreen;
     refresh;
     DrawText(Handle,  DisplayText[1], Length(DisplayText), NodeRect, dt_SingleLine or dt_vcenter);
end;
ZhaawZSoftware Developer

Commented:
You can also switch to using WinAPI to change font color in both places.

Instead of
     Font.Color := clBlue;
use
     SetTextColor(Handle, clBlue); // Handle - TreeView's Canvas.Handle

Author

Commented:
Hi dinlud

Thanks for this but wouldn't calling the refresh method during a paint process result in an infinite loop?

Anyway

Thanks for all who have contributed to this.

sas13 - your answer is the one that works the best - really all component drawing like this should be performed off screen.

Thanks to everyone

Steve

Top Expert 2007

Commented:
Hi Steve,

   >>>.....wouldn't calling the refresh method during a paint process result in an infinite loop?


  This is my reply. What ever your reply please post.(This is just for a fun)

Unit1.dfm
=======

object Form1: TForm1
  Left = 3
  Top = 197
  Width = 773
  Height = 199
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -16
  Font.Name = 'MS Sans Serif'
  Font.Style = [fsBold]
  OldCreateOrder = False
  OnPaint = FormPaint
  PixelsPerInch = 96
  TextHeight = 20
  object Button1: TButton
    Left = 288
    Top = 112
    Width = 97
    Height = 41
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
end


Unit1.pas
=======

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormPaint(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.TextOut(100,50,'Click On Button.If text not changed, then i will accept your reply.');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Canvas.FillRect(Canvas.ClipRect);
  Canvas.Refresh ;
  Canvas.TextOut(100,50,'Now did you accept my answer?. i except your reply. This is just for fun');
end;

end.




   
ZhaawZSoftware Developer

Commented:
>> Thanks for this but wouldn't calling the refresh method during a paint process result in an infinite loop?

Answer is in the help of Delphi ;)

TControl.Refresh and TCanvas.Refresh do different things. Why I am talking about TControl? Because TControl is ancestor of TTreeView (TControl -> TWinControl -> TCustomTreeView -> TTreeView).

TControl.Refresh - Repaints the control on the screen.
TCanvas.Refresh - Deselects the Pen, Brush, and Font from the device context.

Author

Commented:
ZhaawZ / dinilud:

Accepted ;)
 I thought the refresh call would have called the Refresh of the form, not of the Canvas. I wasn't
aware of the Canvas.Refresh method.

Steve
Top Expert 2007

Commented:
Thank you.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial