Recent

Author Topic: using drawitem and drawsubitem in tlistview  (Read 222 times)

mangakissa

  • Hero Member
  • *****
  • Posts: 1022
using drawitem and drawsubitem in tlistview
« on: April 07, 2020, 03:06:46 pm »
Using TListview with subitems is more difficult on Lazarus then Delphi.
I have a Listview with vsreport. To color event rows I use this code (ownerdraw to true):
Code: Pascal  [Select][+][-]
  1. procedure TFrmBasisdata.LVBasisdataCustomDrawItem(Sender: TCustomListView;
  2.   Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
  3. var rt, r: TRect;
  4. begin
  5.   if Item.Index mod 2 = 0 then
  6.     TListView(Sender).Canvas.Brush.Color := clSilver
  7.   else
  8.     TListView(Sender).Canvas.Brush.Color := clWhite;
  9.   r := Item.DisplayRect(drBounds);
  10.   TListView(Sender).Canvas.FillRect(r);
  11.   rt := r;
  12.   rt.Left := rt.Left + 5;
  13.   rt.Top := rt.Top + 1;
  14.  
  15.   TListView(Sender).Canvas.TextOut(Item.Left, Item.Top, Item.Caption);
  16.   DefaultDraw:=False;
  17. end;                    
  18.  
This gives a full length of row with the selected color. But subitems are not showed.
AFAIK you have to use CustomDrawSubItem:
Code: Pascal  [Select][+][-]
  1. procedure TFrmBasisdata.LVBasisdataCustomDrawSubItem(Sender: TCustomListView;
  2.   Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  3.   var DefaultDraw: Boolean);
  4. begin
  5.   TListView(Sender).Canvas.TextOut(Item.Left, Item.Top, Item.SubItems[subitem]);
  6.   DefaultDraw := false;
  7. end;    
  8.  
But it shows no subitems. How do I get them displayed?
Lazarus 2.06 (64b) / FPC 3.0.4 / Windows 10
stucked on Delphi 10.3.1

wp

  • Hero Member
  • *****
  • Posts: 7047
Re: using drawitem and drawsubitem in tlistview
« Reply #1 on: April 07, 2020, 04:09:18 pm »
I suppose you want to have alternating background colors of the rows.

I do it this way:
  • Keep OwnerDraw at its default, false.
  • Add an event handler for OnCustomDrawItem:
Code: Pascal  [Select][+][-]
  1. procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
  2.   Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
  3. begin
  4.   if odd(Item.Index) then
  5.     Sender.Canvas.Brush.Color := clSilver;
  6. end;  
  • Note that I only change the brush color, all the rest should be done by the built-in routines. There DefaultDraw is not changed and left at its default true. If you set it to false then you must do all the background fills, text output, icon drawing etc.

[EDIT] As I noticed this procedure works only on Windows.
« Last Edit: April 08, 2020, 10:54:46 am by wp »
Lazarus trunk / fpc 3.0.4 / all 32-bit on Win-10

jamie

  • Hero Member
  • *****
  • Posts: 2896
Re: using drawitem and drawsubitem in tlistview
« Reply #2 on: April 07, 2020, 11:25:03 pm »
The poster needs the use the correct display rectangle for the sub items...

DisplayRectSubitem.left, top etc...

Number 1 at blue screen app creations!

mangakissa

  • Hero Member
  • *****
  • Posts: 1022
Re: using drawitem and drawsubitem in tlistview
« Reply #3 on: April 08, 2020, 10:41:08 am »
Thank you jamie and wp.

I created this:
Code: Pascal  [Select][+][-]
  1. procedure TFrmBasisdata.LVBasisdataCustomDrawItem(Sender: TCustomListView;
  2.   Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
  3. var rt, r    : TRect;
  4.     index    : Integer;
  5.     mycanvas : TCanvas;
  6.     style    : TTextStyle;
  7.  
  8. // Fit the rect used for TextRect
  9. Procedure PrepareTextRect;
  10. begin
  11.   rt := r;
  12.   rt.Left := rt.Left + 5;
  13.   rt.Top := rt.Top + 1;
  14. end;
  15.  
  16. begin
  17.   if (cdsSelected in state) then
  18.   begin
  19.     mycanvas := Sender.Canvas;
  20.     mycanvas.Brush.Color := clInactiveCaption ;
  21.     // will get the rect for Item + Subitems in ViewStyle = vsReport
  22.     r := Item.DisplayRect(drBounds);
  23.     mycanvas.FillRect(r);
  24.     // set width to get fitting rt for tfEndEllipsis
  25.     r.Right := r.Left + TListView(Sender).Columns[0].Width;
  26.     PrepareTextRect;
  27.     style.SingleLine := true;
  28.     style.EndEllipsis := true;
  29.     mycanvas.TextRect(rt, rt.Left, rt.Top, Item.Caption, style);
  30.  
  31.     if TListView(Sender).ViewStyle = vsReport then
  32.     begin // Paint the Subitems if ViewStyle = vsReport
  33.       for index := 0 to Item.SubItems.Count - 1 do
  34.       begin
  35.         r.Left := r.Left + TListView(Sender).Columns.Items[index].Width;
  36.         r.Right := r.Left + TListView(Sender).Columns.Items[index + 1].Width;
  37.         PrepareTextRect;
  38.         mycanvas.TextRect(rt,rt.Left, rt.Top,  Item.SubItems[index], style);
  39.       end;
  40.     end;
  41.     DefaultDraw := false;
  42.   end else
  43.   begin
  44.   if odd(Item.Index) then
  45.     myCanvas.Brush.Color := clSilver;
  46.   end;              
  47. end;
  48.  
  49. procedure TFrmBasisdata.LVBasisdataCustomDrawSubItem(Sender: TCustomListView;
  50.   Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  51.   var DefaultDraw: Boolean);
  52. begin
  53.   if odd(Item.Index) then
  54.     Sender.Canvas.Brush.Color := clSilver;
  55. end;
  56.  
« Last Edit: April 08, 2020, 10:46:57 am by mangakissa »
Lazarus 2.06 (64b) / FPC 3.0.4 / Windows 10
stucked on Delphi 10.3.1

 

TinyPortal © 2005-2018