Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Why does ListView ignores font and brush settings in custom drawing? [duplicate]

I'm trying to draw items in listview with custom font styles and background colors. There is a default listview on the form. I've changed ViewStyle to vsReport and OwnerDraw to True. Added 3 columns and 3 items. And assign OnCustomDrawItem event:

procedure TForm1.lv1CustomDrawItem(Sender: TCustomListView; Item: TListItem;
  State: TCustomDrawState; var DefaultDraw: Boolean);
var
  lvCanvas: TCanvas;
  R: TRect;
  S: string;
begin
  DefaultDraw := False;

  lvCanvas := Sender.Canvas;

  // column 1
  R := Item.DisplayRect(drBounds);
  R.Right := Sender.Column[0].Width;

  lvCanvas.Brush.Color := clRed;
  lvCanvas.Font.Style := [fsBold];
  S := 'Bold with red background';

  lvCanvas.FillRect(R);
  lvCanvas.TextRect(R, S, [tfSingleLine, tfEndEllipsis, tfCenter, tfVerticalCenter]);

  // column 2
  R.Left := R.Right;
  R.Right := R.Left + Sender.Column[1].Width;

  lvCanvas.Brush.Color := clGreen;
  lvCanvas.Font.Style := [fsItalic];
  S := 'Italic with green background';

  lvCanvas.FillRect(R);
  lvCanvas.TextRect(R, S, [tfSingleLine, tfEndEllipsis, tfCenter, tfVerticalCenter]);

  // column 3
  R.Left := R.Right;
  R.Right := R.Left + Sender.Column[2].Width;

  lvCanvas.Brush.Color := clBlue;
  lvCanvas.Font.Style := [fsUnderline];
  S := 'Underline with blue background';

  lvCanvas.FillRect(R);
  lvCanvas.TextRect(R, S, [tfSingleLine, tfEndEllipsis, tfCenter, tfVerticalCenter]);
end;

But result is not as expected:

enter image description here

Text in second column should be italic, but not bold and with green background. Text in third column should be underline, but not bold and with blue background.

  • Using TextOut instead of TextRect for text drawing gives the same result.
  • I've tried to run this test project in delphi-xe5, but result is the same.
  • The color of the text background in all columns is always as in the first column.

Can anyone explain to me what is happening?

like image 587
kot-da-vinci Avatar asked Nov 26 '25 08:11

kot-da-vinci


1 Answers

I tried the same, and indeed, it doesn't work. The canvas does not do what you want. So I tried with an own control canvas, in the hope it would do better, and indeed, it does. (I might post a pic later).

Try the following code:

var
  lvCanvas: TCanvas;
  R: TRect;
  S: string;
begin
  DefaultDraw := False;

  lvCanvas := TControlCanvas.Create;

  { Try-finally-end is needed, because this Canvas is under our control. }
  try
    TControlCanvas(lvCanvas).Control := lv1;

    { ... Start of original drawing code ... }
    // column 1
    R := Item.DisplayRect(drBounds);

    { ... Drawing code is same as in question; snipped for brevity. ... }

    lvCanvas.TextRect(R, S, [tfSingleLine, tfEndEllipsis, tfCenter, tfVerticalCenter]);
    { ... End of original drawing code ... }

  finally
    lvCanvas.Free;
  end;
end;

This does what you want to do. Only the first column shows bold text, the second shows italic text, etc. and there is no red background in the second and third column anymore.

Update

As the duplicate shows, using the original Sender.Canvas and doing an lvCanvas.Refresh; each time you have changed the font settings, works as well. This is apparently not necessary for a TControlCanvas. So you can use a TControlCanvas as an alternative, although that binds a few more resources.

like image 162
Rudy Velthuis Avatar answered Nov 28 '25 15:11

Rudy Velthuis



Donate For Us

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!