BLUF: I have not been able to change the font style or color for just a single line within a TListView.
I have been working on this for most of two days now and would like another set of eyes on it to ensure I haven't overlooked something entirely obvious. I have also searched this forum as well as the bug tracker and have not seen any issues addressing this particular problem - I may have missed that even.
The problem: I have a TListView control that I have populated with a list of names. While the control is populating, it calls AdvancedCustomDrawItem where I check if a single line meets my criteria (in the case of the example, if the name contains the word 'Van'). If the word is present, the line should be displayed with a bold, red font.
I have done the same thing with a TTreeView control, and it works correctly (to my expectations, at any rate!).
Here is my test project code:
unit tviewtest;
(*
created with Lazarus
version #: 0.9.30
Date: 2011-06-26
FPC Version: 2.4.2
SVN Revision: unknown
x86_64-linux-gtk 2
machine info:
AMD64
Linux (Fedora 14) 64bit
*)
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
StdCtrls, ButtonPanel, ShellCtrls, ExtCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
ListView1: TListView;
StatusBar1: TStatusBar;
TreeView1: TTreeView;
procedure Button1Click(Sender: TObject);
procedure ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
procedure ListView1CustomDrawItem(Sender: TCustomListView; Item: TListItem;
State: TCustomDrawState; var DefaultDraw: Boolean);
procedure TreeView1AdvancedCustomDrawItem(Sender: TCustomTreeView;
Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage;
var PaintImages, DefaultDraw: Boolean);
procedure TreeView1CustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode;
State: TCustomDrawState; var DefaultDraw: Boolean);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
// LISTVIEW ***************************************
procedure TForm1.ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
begin
if (pos('Van', Item.Caption) > 0) then
begin
statusbar1.Panels[0].Text := 'this text demonstrates that AdvancedCustomDrawItem event is firing as it should';
Sender.Canvas.Font.Color := clRed;
Sender.Canvas.Font.Style := [fsBold];
end
else
begin //if you think the next two lines are the offenders, comment them out and try again
Sender.Canvas.Font.Style := [];
Sender.Canvas.Font.Color := clBlue;
end;
(* yes, I have even tried to change the font attributes this way
un-comment this block and comment out the previous block to check *)
{ if (pos('Van', Item.Caption) > 0) then
begin
Sender.Font.Color := clRed;
Sender.Font.Style := [fsBold];
end
else
begin
Sender.Font.Style := []; //this sets the font and color for the
Sender.Font.Color := clBlack; //entire ListView
end; }
end;
procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
(* this has been commented out to ensure no conflicts with AdvancedCustomDrawItem
but is here for testing purposes - only one or the other method is used at a
time in the main program; if you uncomment this section, you should comment out
the AdvancedCustomDrawItem method *)
{ if (pos('Van', Item.Caption) > 0) then
begin
Sender.Canvas.Font.Color := clRed;
Sender.Canvas.Font.Style := [fsBold];
end
else
begin
Sender.Canvas.Font.Style := [];
Sender.Canvas.Font.Color := clBlack;
end; }
end;
//BUTTON1 *****************************************
procedure TForm1.Button1Click(Sender: TObject);
var LI : TListItem;
f : textfile;
str : string;
i : integer;
begin
(* even reloading the control after the form has finished painting has no effect *)
i := 0;
ListView1.Clear;
statusbar1.Panels[0].Text := 'reloaded from text file';
AssignFile(f, 'testfile');
Reset(f);
while not eof(f) do
begin
(* when I un-comment this section, I also comment out the AdvancedCustomDrawItem section.
this shows me that it is not just an issue with the CustomDrawItem methods*)
{ if i = 0 then
begin
ListView1.Canvas.Font.Style := [fsBold];
ListView1.Canvas.Font.Color := clRed;
end
else
begin
ListView1.Canvas.Font.Style := [];
ListView1.Canvas.Font.Color := clBlue;
end; }
Readln(f, str);
LI := ListView1.Items.Insert(0);
LI.Caption := str;
inc(i);
end;
CloseFile(f);
end;
// TREEVIEW1 ***********************************
procedure TForm1.TreeView1AdvancedCustomDrawItem(Sender: TCustomTreeView;
Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage;
var PaintImages, DefaultDraw: Boolean);
begin
if (pos('Van', Node.Text) > 0) then
begin
Sender.Canvas.Font.Color := clRed;
Sender.Canvas.Font.Style := [fsBold];
end
else
begin
Sender.Canvas.Font.Style := [];
Sender.Canvas.Font.Color := clBlue;
end;
end;
procedure TForm1.TreeView1CustomDrawItem(Sender: TCustomTreeView;
Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
(* this has been commented out to ensure no conflicts with AdvancedCustomDrawItem
but is here for testing purposes - only one or the other method is used at a
time in the main program; if you uncomment this section, you should comment out
the AdvancedCustomDrawItem method *)
{ if (pos('Van', Node.Text) > 0) then
begin
Sender.Canvas.Font.Color := clRed;
Sender.Canvas.Font.Style := [fsBold];
end
else
begin
Sender.Canvas.Font.Style := [];
Sender.Canvas.Font.Color := clBlack;
end; }
end;
end.
This is not a make or break for anything I am working on, but it sure is irritating; mainly because I just cannot leave it alone and move on to the rest of my application (personal fault)
I would appreciate any comments or a nudge in the right direction.
Thanks,
geno.
WIKI Timeout issues
