listview and custom font color per item with delphi

Question

I am trying to find a way so when I add an item to a TListView I can assign its own text color (by matching its name with a name I am entering into an edit box). I got it working, sort of, but the issue is when I add more then 2 items the font colors are changed for all of the items.

Here is my test code:

procedure TMainForm.ListCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  if Edit2.Text = Item.Caption then // match my name with item name
  begin
    Sender.Canvas.Font.Color := Font.Font.Color; // assign from font dialogue
    Sender.Canvas.Font.Style := Font.Font.Style; // assign from font dialogue
  end;
end;

Does anyone have any ideas?

Answer 1

You are not resetting the ListView's Canvas.Font parameters for list items that do not match your text.

procedure TMainForm.ListCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  if Edit2.Text = Item.Caption then
  begin
    Sender.Canvas.Font.Color := Font.Font.Color;
    Sender.Canvas.Font.Style := Font.Font.Style;
  end else begin
    // add this...
    Sender.Canvas.Font.Color := Sender.Font.Color;
    Sender.Canvas.Font.Style := Sender.Font.Style;
  end;
end;

That being said, if you know the colors you want to use ahead of time, a different way to set per-item colors is to derive a new class from TListItem and add your own Font property to it, then you can use that during drawing.

type
  TMyListItem = class(TListItem)
  private
    fFont: TFont;
    procedure FontChanged(Sender: TObject);
    procedure SetFont(AValue: TFont);
  public
    constructor Create(AOwner: TListItems); override;
    destructor Destroy; override;
    property Font: TFont read fFont write SetFont;
  end;

constructor TMyListItem.Create(AOwner: TListItems);
begin
  inherited;
  fFont := TFont.Create;
  fFont.OnChange := FontChanged;
end;

destructor TMyListItem.Destroy;
begin
  fFont.Free;
  inherited;
end;

procedure TMyListItem.FontChanged(Sender: TObject);
begin
  Update;
end;

procedure TMyListItem.SetFont(AValue: TFont);
begin
  fFont.Assign(AValue);
end;

// OnCreateItemClass event handler
procedure TMainForm.ListCreateItemClass(Sender: TCustomListView; var ItemClass: TListItemClass);
begin
  ItemClass := TMyListItem;
end;

procedure TMainForm.ListCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  Sender.Canvas.Font := TMyListItem(Item).Font;
end;

...

var
  Item: TMyListItem;
begin
  ...
  Item := TMyListItem(List.Items.Add);
  Item.Caption := ...;
  if Edit2.Text = Item.Caption then
    Item.Font := Font.Font // assign from font dialogue
  else
    Item.Font := List.Font; // assign from listview
  ...
end;