Listview Custom Draw slow

[knuckles]

I'm trying to custom draw TListView which is in vsIcon mode. The idea is to draw the images from the assigned imagelist on top of a underlying bitmap, then display both (it is important to retain the original imagelist images, e.g never modify them)

Code: Pascal  [Select][+][-]

1. unit App.Main;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, ExtCtrls;
9.  
10. type
11.   TForm1 = class(TForm)
12.     ImageList1: TImageList;
13.     ListView1: TListView;
14.     procedure FormCreate(Sender: TObject);
15.     procedure FormDestroy(Sender: TObject);
16.     procedure ListView1CustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState;
17.       var DefaultDraw: Boolean);
18.   private
19.     FUnderlay: TBitmap;
20.   public
21.  
22.   end;
23.  
24. var
25.   Form1: TForm1;
26.  
27. implementation
28.  
29. {$R *.lfm}
30.  
31. { TForm1 }
32.  
33. procedure TForm1.FormCreate(Sender: TObject);
34. begin
35.   FUnderlay := TBitmap.Create;
36.   FUnderlay.PixelFormat := pf24Bit;
37.   FUnderlay.SetSize(ImageList1.Width, ImageList1.Height); // 256 x 256
38.   FUnderlay.Canvas.Brush.Style := bsSolid;
39.   FUnderlay.Canvas.Brush.Color := clSkyBlue;
40.   FUnderlay.Canvas.FillRect(0, 0, FUnderlay.Width, FUnderlay.Height);
41. end;
42.  
43. procedure TForm1.FormDestroy(Sender: TObject);
44. begin
45.   FUnderlay.Free;
46. end;
47.  
48. procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState;
49.   var DefaultDraw: Boolean);
50. var
51.   R: TRect;
52.   ItemImageIndex: Integer;
53. begin
54.   R := Item.DisplayRect(drBounds);
55.  
56.   Sender.Canvas.Draw(R.Left, R.Top, FUnderlay);
57.  
58.   ItemImageIndex := Item.ImageIndex;
59.   if (ItemImageIndex >= 0) and (ItemImageIndex < ImageList1.Count) then
60.   begin
61.     ImageList1.Draw(Sender.Canvas, R.Left, R.Top, ItemImageIndex);
62.   end;
63.  
64.   DefaultDraw := False;
65. end;
66.  
67. end.

Delphi had the method:

Code: Pascal  [Select][+][-]

1. ListViewGetImageIndex(Sender: TObject; Item: TListItem);

which you could do something like:

Code: Pascal  [Select][+][-]

1. procedure TForm1.ListView1GetImageIndex(Sender: TObject; Item: TListItem);
2. begin
3.   ImageList1.Overlay(Item.Index + 1, 1);
4.   Item.ImageIndex := 0;
5.   Item.OverlayIndex := 1;
6. end;

I don't see a way of doing this in Lazarus, the method does not exist? So instead i've tried custom drawing the listview but it is extremely slow.

Any ideas?

Thanks

[knuckles]

Anyone can help?

Basically need a listview in vsIcon mode where under the image I can show an underlying bitmap, my purpose is to draw a transparency grid under the images.

[paweld]

Include a sample project, it will be easier for those interested to check the possibilities of solving the problem

[knuckles]

Unit1.lfm

Code: Pascal  [Select][+][-]

1. object Form1: TForm1
2.   Left = 598
3.   Height = 551
4.   Top = 250
5.   Width = 854
6.   Caption = 'Form1'
7.   ClientHeight = 551
8.   ClientWidth = 854
9.   OnCreate = FormCreate
10.   OnDestroy = FormDestroy
11.   object ListView1: TListView
12.     Left = 0
13.     Height = 551
14.     Top = 0
15.     Width = 854
16.     Align = alClient
17.     Columns = <>
18.     LargeImages = ImageList1
19.     SmallImages = ImageList1
20.     TabOrder = 0
21.     ViewStyle = vsIcon
22.     OnCustomDrawItem = ListView1CustomDrawItem
23.   end
24.   object ImageList1: TImageList
25.     Left = 760
26.     Top = 32
27.   end
28. end

Unit1.pas

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls;
9.  
10. type
11.   TForm1 = class(TForm)
12.     ImageList1: TImageList;
13.     ListView1: TListView;
14.     procedure FormCreate(Sender: TObject);
15.     procedure FormDestroy(Sender: TObject);
16.     procedure ListView1CustomDrawItem(Sender: TCustomListView; Item: TListItem;
17.       State: TCustomDrawState; var DefaultDraw: Boolean);
18.   private
19.     FUnderlay: TBitmap;
20.   public
21.  
22.   end;
23.  
24. var
25.   Form1: TForm1;
26.  
27. implementation
28.  
29. {$R *.lfm}
30.  
31. { TForm1 }
32.  
33. procedure TForm1.FormCreate(Sender: TObject);
34. var
35.   Png: TPortableNetworkGraphic;
36.   I: Integer;
37. const
38.   ImageWidth = 128;
39.   ImageHeight = 128;
40. begin
41.   FUnderlay := TBitmap.Create;
42.   FUnderlay.SetSize(ImageWidth, ImageHeight);
43.   FUnderlay.PixelFormat := pf24Bit;
44.   FUnderlay.Canvas.Brush.Style := bsSolid;
45.   FUnderlay.Canvas.Brush.Color := clGreen;
46.   FUnderlay.Canvas.FillRect(0, 0, FUnderlay.Width, FUnderlay.Height);
47.  
48.   ImageList1.Width := ImageWidth;
49.   ImageList1.Height := ImageHeight;
50.  
51.   Png := TPortableNetworkGraphic.Create;
52.   try
53.     Png.LoadFromFile(ExtractFilePath(ParamStr(0)) + '/test.png');
54.     ImageList1.Add(Png, nil);
55.     ImageList1.Add(Png, nil);
56.     ImageList1.Add(Png, nil);
57.     ImageList1.Add(Png, nil);
58.     ImageList1.Add(Png, nil);
59.     ImageList1.Add(Png, nil);
60.     ImageList1.Add(Png, nil);
61.     ImageList1.Add(Png, nil);
62.     ImageList1.Add(Png, nil);
63.   finally
64.     Png.Free;
65.   end;
66.  
67.   for I := 0 to ImageList1.Count - 1 do
68.   begin
69.     with ListView1.Items.Add do
70.     begin
71.       Caption := 'item' + I.ToString;
72.       ImageIndex := I;
73.     end;
74.   end;
75. end;
76.  
77. procedure TForm1.FormDestroy(Sender: TObject);
78. begin
79.   FUnderlay.Free;
80. end;
81.  
82. procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
83.   Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
84. var
85.   R: TRect;
86. begin
87.   R := Item.DisplayRect(drBounds); // causes slowdown ???
88.  
89.   Sender.Canvas.Draw(R.Left, R.Top, FUnderlay);
90.  
91.   DefaultDraw := False;
92. end;
93.  
94. end.
95.  

Put a 128x128 png image in the project folder called test.png

The slowdown appears to be caused by obtaining the bounds rect:

Code: Pascal  [Select][+][-]

1. procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
2.   Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
3. var
4.   R: TRect;
5. begin
6.   R := Item.DisplayRect(drBounds); // causes slowdown ???
7.   //...
8.   DefaultDraw := False;
9. end;  

[wp]

Please combine .pas, .lfm, .lpr and .lpi files (as well as any needed data files) into a common zip file which you can easily upload here under "Attachments and other options"; this makes it much easier for us to reproduce the issue. (Don't add any compiler-generated files to the zip because there is an upload size limit of 500 kB).

[zeljko]

Item.DisplayRect() calls WS, so yes, it can be slow - depends on ws implementation.

[ASerge]

How to detect a slowdown?
Visually, there is no difference in speed if commented out everything in ListView1CustomDrawItem, except for the image, of course
Windows x64.

[paweld]

Like @ASerge, I didn't notice any slowdown.Windows 10 x64, Lazrus trunk with FPC 3.2-fixes.sample project in attachment

[knuckles]

Sorry should of stated this was running Lazarus 3.4 on Linux Mint.

I'll try the attachment soon and on Windows when i can time see if there is any differences thanks.