help with colouring certain subitems in listview 2

[CADTenchy]

I'm using a TListView to display some of my entered data.

I've had working for ages this small procedure to colour the rows alternately:

// OnDrawing ListView1, colour the rows alternately
procedure TMainForm.ListView1CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  with ListView1.Canvas.Brush do
  begin
    if Item.Index mod 2 = 0 then Color := $FFFFFF else Color := $F6F4F4;
  end;
end;

Now I'm trying to highlight certain sub-items in red, when they are the first instance entered, as so:

[highlight #FFFFFF]18:20 Harry Fish 20Kg[/highlight]
[highlight #F6F4F4]18:22 Harry Cheese 5Kg[/highlight]
[highlight #FFFFFF]19:01 Fred Fish 3Kg[/highlight]
[highlight #F6F4F4]19:02 John Fish 5Kg[/highlight]
[highlight #FFFFFF]19:07 Fred Milk 2l[/highlight]
[highlight #F6F4F4]19:13 Harry Milk 5l[/highlight]

As the rows of data are entered, or read from file, a line at a time, I'm setting a flag for each entry type which would indicate whether it should be coloured red or not. The flag is set true or false each time to suit.

I'm trying to colour the text with this procedure:

procedure TMainForm.ListView1AdvancedCustomDrawSubItem(
  Sender: TCustomListView; Item: TListItem; SubItem: Integer;
  State: TCustomDrawState; Stage: TCustomDrawStage; var DefaultDraw: Boolean);
begin
  with ListView1.Canvas.Font do
  begin
    if (SubItem = 1) and (NewNameFlag) then Color := clRed else Color := clBlack;
    if (SubItem = 2) and (NewItemFlag) then Color := clRed else Color := clBlack;
  end;
end;

However, I find this isn't quite working, and I can't get the combination of procedures to work in harmony.

Firstly, the new ListView1AdvancedCustomDrawSubItem procedure has broken the previously working ListView1CustomDrawItem procedure, so now only the caption is coloured alternately.

Also the ListView1AdvancedCustomDrawSubItem procedure is colouring the entire column, as if the flag is always true.

It may be worth saying that I am using ListView1.Items.BeginUpdate and EndUpdate when I load the data from file, though this has never affected the alternate row colouring.

Steve (Delphi 2007 & XP)

 

[roo0047]

I would break it up.
Create a StringList and a function InList

function TMainForm.InList(aWord: string): boolean;
begin
  if List.IndexOf(aWord) < 0 then begin
    List.Add(aWord);
    result:= false;
  end else
    result:= true
end;

OR (less intuitive but faster)

function TMainForm.InList(aWord: string): boolean;
begin
  result:= List.IndexOf(aWord) < 0;
  if not result then List.Add(aWord);
end;

Then in your code:

procedure TMainForm.ListView1AdvancedCustomDrawSubItem(
  Sender: TCustomListView; Item: TListItem; SubItem: Integer;
  State: TCustomDrawState; Stage: TCustomDrawStage; var DefaultDraw: Boolean);
var
  aWord: string;
begin
  aWord:= <do what you need here...>;
  if not InList(aWord) then
    ListView1.Canvas.Font.Color:= clRed 
  else 
    ListView1.Canvas.Font.Color:= clBlack
end;

UNTESTED but you get the idea.
(Don't forget List.Free)

HTH

Roo
Delphi Rules!

 

[CADTenchy]

Hi, and thanks, Roo.

I've had some success.

I needed to remove the 'not' from the function to get the logic right.

Then with this I got all the right things coloured at startup:

procedure TMainForm.ListView1AdvancedCustomDrawSubItem(
  Sender: TCustomListView; Item: TListItem; SubItem: Integer;
  State: TCustomDrawState; Stage: TCustomDrawStage; var DefaultDraw: Boolean);
var
  aWord: string;
begin
if SubItem = 6 then
    begin
      aWord:= AnsiLeftStr(ListView1.Items[Item.Index].SubItems[5], 4);
    if InList(aWord) then
      ListView1.Canvas.Font.Color:= clRed
    else
      ListView1.Canvas.Font.Color:= clBlack;
    end
  else // this else stops subitems>6 being red
    ListView1.Canvas.Font.Color:= clBlack;   
end;

The issues I still have are that if I click the ListView vertical scroll or minimise/maximise the window, all revert to black.
Also, only the caption of each line is changing background colour too.
(Without the last commented else statement, the row up to but not including subitem 6 was alternate colours)

I assume I'm losing the colouring on redrawing from scrolling etc because the first instances still exist in the (string)List populated by the function?

Would this be easier in a stringgrid?

Oh, and I've free'd the List on form destroy! ;-)

Steve (Delphi 2007 & XP)

 

[roo0047]

Removing the NOT seems backward if you want aWord red if not in the list.

And YES, aWord would revert to black on re-draw since it was put in the list when first drawn. Sounds like a method is needed to remove it from the list when the line scrolls out of view but there has to be a better way, where "better" eq. "less_difficult".

TStringGrid is a much simpler control but I don't know that you can change aWord color, I think just the entire line but don't quote me.

Obviously, InList is only valid on the first time you draw it and maybe not such a good idea after all. I vaguely remember having a similar issue once upon a time and that the Stage and/or State params came into play somehow.

I just got back from a trip and I'm in catch-up mode. I'll try and play with it once I get caught up if no one else jumps in with a solution. *HINT*

Roo
Delphi Rules!

 

[CADTenchy]

I think the Inlist will still have a use, though it would be even better if you could pass a different list name to it, as I need to keep track of 3 columns.

I'll have further try myself today, just on the one column for now.

Re the Inlist logic, this is how I see it:

function TMainForm.InList(aWord: string): boolean;
begin
  result:= List.IndexOf(aWord) < 0; [COLOR=green]// true if indexof is -1, not in list[/color]
  if [s]not[/s] result then List.Add(aWord); [COLOR=green]// so I removed the not to add new item to list[/color]
end;

I guess there should be an inversion of the result there too...


Steve (Delphi 2007 & XP)

 

[whosrdaddy]

the correct logic would be:

function TMainForm.InList(aWord: string): boolean;
begin
  result := List.IndexOf(aWord) > -1; // word is in the list-> result = true
  if not result then List.Add(aWord); 
end;

/Daddy

-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!

 

[roo0047]

Yes, Daddy is correct. The logic was correct. The operator incorrect. It was correct in 1st example of my 1st post. I flubbed it the shortened (2nd) example:

(List.IndexOf(aWord) < 0) = false {not in list}
(List.IndexOf(aWord) = -1) = false {not in list}
(List.IndexOf(aWord) >= 0) = true {in list}
(List.IndexOf(aWord) > -1) = true {in list [Daddy's]}

As noted, was UNTESTED but above is correct.
Working function should return TRUE if in list and add to list if NOT.

Use Daddy's - just don't misinterpret the line wrap!!!

Roo
Delphi Rules!

 

[CADTenchy]

thanks both, got that cleared up.

I've had no joy with the colouring tho :-(

And the line wrap misinterpretation gives syntax error no?



Steve (Delphi 2007 & XP)

 

[roo0047]

RE: Line wrap - yes it would.
RE: Color - Post relevant code and I'll look at it.


Roo
Delphi Rules!

 

[CADTenchy]

my best effort so far is in my second post in this thread :-(

Steve (Delphi 2007 & XP)

 

[roo0047]

Code for filling ListView1 and some pseudo data (csv / xml / ???) would help.

Roo
Delphi Rules!

 

[CADTenchy]

Hmm, that's kinda pesky, as I fill the listview from 2 ways, one upon start of application, where I read from the last used file, and then, once that is done, add items one row at a time as they are input, via some edit boxes.

But actual adding is just done with:

ListItem := MainForm.ListView1.Items.Add();
ListItem.Caption := UTCTime;
ListItem.SubItems.Add(Edit1.Text);
ListItem.SubItems.Add(Edit2.Text);
ListItem.SubItems.Add(Edit3.Text);
ListItem.SubItems.Add(Edit4.Text);
ListItem.SubItems.Add(Edit5.Text);
ListItem.SubItems.Add(Edit6.Text);
ListItem.SubItems.Add(Edit7.Text);
ListItem.SubItems.Add(Edit7.Text);

Only some subitems need to be checked for uniqueness, and at time of ListItem.SubItems.Add a flag can be set to be true if unique.
HTH?

Steve (Delphi 2007 & XP)

 

[roo0047]

Well you sure didn't give me much to work with...
Heres MY code with YOUR code imbedded. I'm getting 'List index out of bounds' error on the [red]red[/red] highlighted line below (YOURS):

unit CADTenchy;

interface

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

type
  TStevRec = record
    aTime: string;
    nam1: string;
    nam2: string;
    aval: string;
  end;

const       //these values should look familiar :-)
  StevRecs: array [0..5] of TStevRec = (
    (aTime: '18:20'; nam1: 'Harry'; nam2: 'Fish';   aval: '20Kg'),
    (aTime: '18:22'; nam1: 'Harry'; nam2: 'Cheese'; aval: '5Kg'),
    (aTime: '19:01'; nam1: 'Fred';  nam2: 'Fish';   aval: '3Kg'),
    (aTime: '19:02'; nam1: 'John '; nam2: 'Fish';   aval: '5Kg'),
    (aTime: '19:07'; nam1: 'Fred';  nam2: 'Milk';   aval: '2l'),
    (aTime: '19:13'; nam1: 'Harry'; nam2: 'Milk';   aval: '5l'));

type
  TMainForm = class(TForm)
    ListView1: TListView;
    procedure ListView1AdvancedCustomDrawSubItem(Sender: TCustomListView;
      Item: TListItem; SubItem: Integer; State: TCustomDrawState;
      Stage: TCustomDrawStage; var DefaultDraw: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    List: TStringList;
    ListItem: TListItem;
    function InList(aWord: string): boolean;
    function Populate: boolean;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

function TMainForm.InList(aWord: string): boolean;
begin
  result:= List.IndexOf(aWord) > -1; 
  if not result then List.Add(aWord);
end;

procedure TMainForm.ListView1AdvancedCustomDrawSubItem(
  Sender: TCustomListView; Item: TListItem; SubItem: Integer;
  State: TCustomDrawState; Stage: TCustomDrawStage;
  var DefaultDraw: Boolean);
var
  aWord: string;
begin
  if SubItem = 6 then begin
    [red]aWord:= AnsiLeftStr(ListView1.Items[Item.Index].SubItems[5], 4);[/red]
    if InList(aWord) then
      ListView1.Canvas.Font.Color:= clRed
    else
      ListView1.Canvas.Font.Color:= clBlack;
  end else
    ListView1.Canvas.Font.Color:= clBlack; //this else stops subitems>6 being red
end;

function TMainForm.Populate: boolean;
var
  ListItem: TListItem;
  i: integer;
begin
  result:= false;
  try
    for i:= Low(StevRecs) to High(StevRecs) do begin
      ListItem:= ListView1.Items.Add;
      ListItem.Caption:=    StevRecs[i].aTime;
      ListItem.SubItems.Add(StevRecs[i].nam1);
      ListItem.SubItems.Add(StevRecs[i].nam2);
      ListItem.SubItems.Add(StevRecs[i].aval);
    end;
    result:= true
  except
  end
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  List:= TStringList.Create;
  Populate
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  List.Free
end;

end.

How your ListView is configured would also have helped. Here's what I'm using:

object MainForm: TMainForm
  Left = 384
  Top = 117
  Width = 431
  Height = 296
  Caption = 'MainForm'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object ListView1: TListView
    Left = 0
    Top = 0
    Width = 423
    Height = 262
    Align = alClient
    Columns = <
      item
      end
      item
      end
      item
      end
      item
      end
      item
      end
      item
      end
      item
      end
      item
      end
      item
      end>
    TabOrder = 0
    ViewStyle = vsReport
    OnAdvancedCustomDrawSubItem = ListView1AdvancedCustomDrawSubItem
  end
end

Nothing like working in the dark...

Roo
Delphi Rules!

 

[roo0047]

Ok I got it all working as you requested.
Major issues are:

1) You must clear the list to prevent loosing color on redraws:

  if i = 0 then
    if firstpass then begin
      List.Clear;
      firstpass:= false;
    end else
  else firstpass:= true;

2) The word you want to paint red is one less the the current SubItem. (Don't know why but it is)

  if (n = 1) or (n = 2) then begin
    aWord:= copy(ListView1.Items[i].SubItems[n - 1], 1, 255);

My earlier problem was filling the grid in OnCreate. It now populates with a button press. I also made some changes to ListView properties. Form is further below the code.
Here's the entire working code:

unit CADTenchy;

interface

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

type
  TStevRec = record
    aTime: string;
    nam1: string;
    nam2: string;
    aval: string;
  end;

const
  StevRecs: array [0..5] of TStevRec = (
    (aTime: '18:20'; nam1: 'Harry'; nam2: 'Fish';   aval: '20Kg'),
    (aTime: '18:22'; nam1: 'Harry'; nam2: 'Cheese'; aval: '5Kg'),
    (aTime: '19:01'; nam1: 'Fred';  nam2: 'Fish';   aval: '3Kg'),
    (aTime: '19:02'; nam1: 'John';  nam2: 'Fish';   aval: '5Kg'),
    (aTime: '19:07'; nam1: 'Fred';  nam2: 'Milk';   aval: '2l'),
    (aTime: '19:13'; nam1: 'Harry'; nam2: 'Milk';   aval: '5l'));

type
  TMainForm = class(TForm)
    ListView1: TListView;
    Panel1: TPanel;
    Button1: TButton;
    procedure ListView1AdvancedCustomDrawSubItem(Sender: TCustomListView;
      Item: TListItem; SubItem: Integer; State: TCustomDrawState;
      Stage: TCustomDrawStage; var DefaultDraw: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    List: TStringList;
    ListItem: TListItem;
    function InList(aWord: string): boolean;
    function Populate: boolean;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

function TMainForm.InList(aWord: string): boolean;
begin
  result:= List.IndexOf(aWord) > -1;
  if not result then List.Add(aWord);
end;

var
  firstpass: boolean;

procedure TMainForm.ListView1AdvancedCustomDrawSubItem(
  Sender: TCustomListView; Item: TListItem; SubItem: Integer;
  State: TCustomDrawState; Stage: TCustomDrawStage;
  var DefaultDraw: Boolean);
var
  aWord: string;
  n, i: integer;
begin
  n:= SubItem;
  i:= Item.Index;
  if i = 0 then
    if firstpass then begin
      List.Clear;
      firstpass:= false;
    end else //nada
  else firstpass:= true;
  if (n = 1) or (n = 2) then begin
    aWord:= copy(ListView1.Items[i].SubItems[n - 1], 1, 255);
    if not InList(aWord) then
      ListView1.Canvas.Font.Color:= clRed
    else
      ListView1.Canvas.Font.Color:= clBlack;
  end else
    ListView1.Canvas.Font.Color:= clBlack; //this else stops subitems>6 being red
end;

function TMainForm.Populate: boolean;
var
  i: integer;
begin
  result:= false;
  firstpass:= true;
  List.Clear;
  try
    for i:= Low(StevRecs) to High(StevRecs) do begin
      ListItem:= ListView1.Items.Add;
      ListItem.Caption:= StevRecs[i].aTime;
      ListItem.SubItems.Add(StevRecs[i].nam1);
      ListItem.SubItems.Add(StevRecs[i].nam2);
      ListItem.SubItems.Add(StevRecs[i].aval);
    end;
    result:= true
  except
  end
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
  Populate
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  List:= TStringList.Create;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  List.Free
end;

end.

And the form:

object MainForm: TMainForm
  Left = 471
  Top = 121
  Width = 575
  Height = 384
  Caption = 'MainForm'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object ListView1: TListView
    Left = 0
    Top = 0
    Width = 567
    Height = 296
    Align = alClient
    Columns = <
      item
        Width = 100
      end
      item
        Width = 100
      end
      item
        Width = 100
      end
      item
        Width = 100
      end
      item
        Width = 100
      end>
    ColumnClick = False
    GridLines = True
    TabOrder = 0
    ViewStyle = vsReport
    OnAdvancedCustomDrawSubItem = ListView1AdvancedCustomDrawSubItem
  end
  object Panel1: TPanel
    Left = 0
    Top = 296
    Width = 567
    Height = 54
    Align = alBottom
    Caption = 'Panel1'
    TabOrder = 1
    object Button1: TButton
      Left = 232
      Top = 16
      Width = 75
      Height = 25
      Caption = 'Populate'
      TabOrder = 0
      OnClick = Button1Click
    end
  end
end

I haven't used ListViews much. Usually pick TreeView or StringGrid. After this exercise, I think I'll be using them more often, so thanks!

Have fun!

Roo
Delphi Rules!

 

[CADTenchy]

Many thanks for the efforts Roo! It is appreciated.

This is doing the job, but there are conditions where I can get it confused.

First one is when you resize the listview to have an auto right scrollbar.(Mine is on a panel with a horizontal TSplitter, and also I have a TAdvSplitter to it's right)
As soon as you scroll down, all text reverts to black, and stays so until you scroll up until first item is in view.
Then, all red highlight is shown except for first item.

If you then double click a column heading splitter to resize, sometimes once, sometimes twice, first item is highlighted then.

Another behavior is if half of an item that should be red is showing due to the scroll bar, and you drag the horizontal splitter down to reveal all the item, only the part of the text that was hidden before is now red.

All these things are I'm sure a result of the GUI changes not calling the ListView1AdvancedCustomDrawSubItem procedure.

I wondered about saying heck, just do a for count = o to listview1.items.count-1 loop on it on any change, but firstly I can't really see what event would always be called, and also wondered it that was bit over the top.

Worth mentioning that the Listview will probably never exceed 1000 or so items (rows).

Also worthy of a mention perhaps is the fact I'm using this when an item is entered (rather than loaded):

MainForm.ListView1.Items.Item[MainForm.ListView1.items.count-1].MakeVisible(true);

to scroll the last entry into view.
The red highlight procedure does work when this statement is executed.

Also, you have your ListView properties set as mine, here are a few more that may be significant:

OwnerDraw: false (only captions shown if true)
Rowselect: true
ShowColumnHeader: true
SortType: stNone

On one hand I'm wondering if I should accept defeat and press on with other aspects, as the alternate row colouring is still broken too, but the other half of me says it can be done, as I got the idea from someone else's app, which works. (Theirs was done in C++ BTW)

But at least you may use ListViews more now, so some good already, and you're very welcome!


Steve (Delphi 2007 & XP)

 

[roo0047]

All very interesting but hard to follow without your actual code. If I were in your position, here's what I'd do:

I assume you actually pasted my code as a separate app and actually tried it. Give it a stress test as is. See if you can make mine misbehave in any of the ways you've described yours as doing.

Upon success, start adding the features that are in yours, but missing from mine... one at a time and repeat the stress test. Resolve the quirks before adding another feature. By isolation, you should be able to figure out what's needed for each and get it going the way you want it.

A word of caution: Don't overload ListView1AdvancedCustomDrawSubItem with lots of activity. Make every line quick and brief as possible. Otherwise performance can really suffer.

Good luck my friend!

Roo
Delphi Rules!

 

[CADTenchy]

In honesty, I waded in and pasted into my main app.

I will do so though, and let you know...


Steve (Delphi 2007 & XP)

 

[CADTenchy]

Finally found time to sit down and do this.

I had a bit of trouble with access violations on the List.Clear
I could only solve that by pasting in to my .pas and .dfm exactly as above.

I found that this app did perform better than mine, but I was still able to create pseudo random effects with vertical scrolling.
Dragging the right hand edge of running form in and out to cover and uncover the columns I was 100% unable to break the colouring.
Doing the same with bottom edge I got results from perfect to all black, and some interesting ones like this:

Similar by reducing form height and using scroll bar icons, though much less so.
On my main app, use of scroll icons pretty much meant 100% black text.
Maybe the test app not having the row colouring procedure helps?

I was interested to wonder how this worked:

procedure TMainForm.Button1Click(Sender: TObject);
begin
  Populate
end;

It works the same on my Delphi with or without the line ending semi-colon after Populate!?

I'm tempted to say don't use up more of your time on this one, I could add further columns to carry new field flags which would be easy.
I really appreciate the efforts though!



Steve (Delphi 2007 & XP)

 

[whosrdaddy]

Steve,

please give Roo a star for his hard work in this thread. This is how we say thank you to other people on this forum. (-> * from me Roo)


/Daddy


-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!

 

[CADTenchy]

Of course, very remiss of me.

Thanks Roo!


Steve (Delphi 2007 & XP)