Simon Wpgn Lewis
Simon Wpgn Lewis

Reputation: 133

listview and custom font color per item with delphi

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?

Upvotes: 4

Views: 4800

Answers (2)

Remy Lebeau
Remy Lebeau

Reputation: 596342

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;

Upvotes: 6

David Heffernan
David Heffernan

Reputation: 612993

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;

The problem is what happens when the if condition is False. You don't specify font color and style, and so the state of the canvas remains what it was previously. You need to do the following:

  1. For each item in the list you must remember that items color and style.
  2. When ListCustomDrawItem is called you must specify the canvas color and style to the the value that you remembered in step 1.

Upvotes: 1

Related Questions