Delphi: Canvas.FillRect in List View

我们两清 提交于 2019-12-11 19:36:55

问题


On change of a text of List View's SubItem I need to brush and fill a whole row:

procedure TForm1.ListViewDrawItem(Sender: TCustomListView;
  Item: TListItem; Rect: TRect; State: TOwnerDrawState);
begin
  if Item.SubItems[2]='Done'
   then
  begin
    Sender.Canvas.Font.Color := clBlack;
    Sender.Canvas.Brush.Color := clGreen;
    Sender.Canvas.Brush.Style := bsSolid;
    Sender.Canvas.FillRect(Rect);
  end;
end;

But Sender.Canvas.FillRect(Rect) will fill only a Rect of the SubItem. How to fill a whole row?

The question is asked on a base of Delphi: how to draw small icons in List View on CustomDrawItem

Thanks!


回答1:


First, if you have three columns, they are Caption, SubItems[0], and SubItems[1], remember? There is no SubItems[2]!

Anyhow, this is very easy. You only need a very, very small modification of the old code.

procedure TForm1.ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
  Rect: TRect; State: TOwnerDrawState);
var
  i: Integer;
  x1, x2: integer;
  r: TRect;
  S: string;
const
  DT_ALIGN: array[TAlignment] of integer = (DT_LEFT, DT_RIGHT, DT_CENTER);
begin
  if SameText(Item.SubItems[1], 'done') then
  begin
    Sender.Canvas.Font.Color := clBlack;
    Sender.Canvas.Brush.Color := clLime;
  end
  else
    if Odd(Item.Index) then
    begin
      Sender.Canvas.Font.Color := clBlack;
      Sender.Canvas.Brush.Color := $F6F6F6;
    end
    else
    begin
      Sender.Canvas.Font.Color := clBlack;
      Sender.Canvas.Brush.Color := clWhite;
    end;
  Sender.Canvas.Brush.Style := bsSolid;
  Sender.Canvas.FillRect(Rect);
  x1 := 0;
  x2 := 0;
  r := Rect;
  Sender.Canvas.Brush.Style := bsClear;
  Sender.Canvas.Draw(3, r.Top + (r.Bottom - r.Top - bm.Height) div 2, bm);
  for i := 0 to ListView1.Columns.Count - 1 do
  begin
    inc(x2, ListView1.Columns[i].Width);
    r.Left := x1;
    r.Right := x2;
    if i = 0 then
    begin
      S := Item.Caption;
      r.Left := bm.Width + 6;
    end
    else
      S := Item.SubItems[i - 1];
    DrawText(Sender.Canvas.Handle,
      S,
      length(S),
      r,
      DT_SINGLELINE or DT_ALIGN[ListView1.Columns[i].Alignment] or
        DT_VCENTER or DT_END_ELLIPSIS);
    x1 := x2;
  end;
end;

Notice in particular that I use clLime instead of clGreen, because clBlack text on a clGreen background looks horrible! You might consider clWhite text on a clGreen background, though:

Update in response to comments:

To change the third column of the list view, it doesn't do to just do

procedure TForm1.FormClick(Sender: TObject);
begin
  ListView1.Items[3].SubItems[1] := 'Done';
end;

Indeed, Windows doesn't know that the data of one column affects the appearance of the entire row! The simplest fix is to tell Windows to repaint the entire control when you have changed the value Better: just tell Windows to redraw the current row:

procedure TForm1.FormClick(Sender: TObject);
begin
  ListView1.Items[3].SubItems[1] := 'Done';
  ListView1.Items[3].Update;
end;


来源:https://stackoverflow.com/questions/6617058/delphi-canvas-fillrect-in-list-view

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!