Re: [Lazarus] Displaying a Listview entry in bold and a different colour

[Howard Page-Clark]

On 15/09/2014 13:10, Richard Mace wrote:
Hi All,
I just want to make sure that I am not doing anything wrong here, please
can somebody give me a little code example of how to correctly set the
font to bold and a differnet colour in a listview entry?

I wouldn't claim the following is 'correct', but it works on Windows 
using TListView's OnCustomDrawItem() event.

Howard

==code==

unit mainListviewOwnerDraw;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Graphics, ComCtrls, LCLType, StdCtrls;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure ListView1CustomDrawItem(Sender: TCustomListView; Item: 
TListItem;
      State: TCustomDrawState; var DefaultDraw: Boolean);
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  li: TListItem;
  lc: TListColumn;
  i: Integer;
begin
  ListView1.ViewStyle:=vsReport;
  ListView1.OwnerDraw:=True;
  lc:=TListColumn.Create(ListView1.Columns);
  lc.Caption:='Select an item to show custom draw:';
  lc.Width:=ListView1.Canvas.TextWidth(lc.Caption) + 20;
  for i:=0 to 4 do begin
    li:=TListItem.Create(ListView1.Items);
    li.Caption:=Format('Item number %d',[i]);
    ListView1.Items.AddItem(li);
  end;
end;

procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
var
  rct: TRect;
begin
  DefaultDraw:=False;
  if (cdsSelected in State) then begin
    Sender.Canvas.Font.Style:=[fsBold];
    Sender.Canvas.Font.Color:=clRed;
  end
  else begin
    Sender.Canvas.Font.Style:=[];
    Sender.Canvas.Font.Color:=clBlack;
  end;
  rct:=Item.DisplayRect(drLabel);
  Sender.Canvas.FillRect(rct); //paint background with default brush colour
  Sender.Canvas.TextOut(rct.Left, rct.Top, Item.Caption);
end;

end.

--
_______________________________________________
Lazarus mailing list
Lazarus@lists.lazarus.freepascal.org
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus