8

我需要在 a 中的特定列中绘制一个复选框TListView，所以我检查了这个问题How can I setup TListView with CheckBoxes in only certain columns?，并在接受的答案中建议使用另一个问题中描述的方法How to set a Checkbox TStringGrid in Delphi?，现在将该代码移植到我附带的 ListView 中：

procedure TForm15.ListView1CustomDrawSubItem(Sender: TCustomListView; Item: TListItem; SubItem: Integer; State: TCustomDrawState; var DefaultDraw: Boolean);
const
  PADDING = 4;
var
  h    : HTHEME;
  s    : TSize;
  r    : TRect;
  Rect : TRect;
  i    : Integer;
  Dx   : Integer;
begin
  if (SubItem=1) then
  begin
    DefaultDraw:=True;
    Rect  :=Item.DisplayRect(drBounds);
    Dx:=0;

    for i := 0 to SubItem do
    Inc(Dx,Sender.Column[i].Width);
    Rect.Left  :=Rect.Left+Dx;

    Rect.Right :=Rect.Left+Sender.Column[SubItem+1].Width;

    FillRect(Sender.Canvas.Handle, Rect, GetStockObject(WHITE_BRUSH));
    s.cx := GetSystemMetrics(SM_CXMENUCHECK);
    s.cy := GetSystemMetrics(SM_CYMENUCHECK);
    if UseThemes then
    begin
      h := OpenThemeData(Sender.Handle, 'BUTTON');
      if h <> 0 then
        try
          GetThemePartSize(h, Sender.Canvas.Handle, BP_CHECKBOX, CBS_CHECKEDNORMAL, nil, TS_DRAW, s);
          r.Top    := Rect.Top + (Rect.Bottom - Rect.Top - s.cy) div 2;
          r.Bottom := r.Top + s.cy;
          r.Left   := Rect.Left + PADDING;
          r.Right  := r.Left + s.cx;
          DrawThemeBackground(h, Sender.Canvas.Handle, BP_CHECKBOX, IfThen(CompareText(Item.SubItems[1],'True')=0, CBS_CHECKEDNORMAL, CBS_UNCHECKEDNORMAL), r, nil);
        finally
          CloseThemeData(h);
        end;
    end
    else
    begin
      r.Top    := Rect.Top + (Rect.Bottom - Rect.Top - s.cy) div 2;
      r.Bottom := r.Top + s.cy;
      r.Left   := Rect.Left + PADDING;
      r.Right  := r.Left + s.cx;
      DrawFrameControl(Sender.Canvas.Handle, r, DFC_BUTTON, IfThen(CompareText(Item.SubItems[1],'True')=0, DFCS_CHECKED, DFCS_BUTTONCHECK));
    end;
   //r := Classes.Rect(r.Right + PADDING, Rect.Top, Rect.Right, Rect.Bottom);
   // DrawText(Sender.Canvas.Handle,   StringGrid1.Cells[ACol, ARow], length(StringGrid1.Cells[ACol, ARow]),  r, DT_SINGLELINE or DT_VCENTER or DT_LEFT or DT_END_ELLIPSIS);
  end
  else
  DefaultDraw:=False;
end;

但我在尝试绘制复选框时惨遭失败:(，有人可以指出我在列表视图中绘制复选框的正确方向吗，（代码不会在列表视图中绘制任何复选框）。

列表视图处于 vsReport 模式并有 3 列，我想将复选框放在第三列。请不要建议使用第三方组件，我想使用 TlistView 控件。

更新 1：感谢 sertac recomendattion 设置DefaultDraw值现在显示复选框，但另一列看起来很糟糕。

在此处输入图像描述

更新 2，按照 Andreas 的建议，列表视图现在看起来更好，但仍显示黑框；

在此处输入图像描述

procedure TForm15.ListView1CustomDrawSubItem(Sender: TCustomListView; Item: TListItem; SubItem: Integer; State: TCustomDrawState; var DefaultDraw: Boolean);
var
  h    : HTHEME;
  s    : TSize;
  r    : TRect;
  Rect : TRect;
  i    : Integer;
  Dx   : Integer;
begin
  if (SubItem=2) then
  begin
    DefaultDraw:=False;
    Rect  :=Item.DisplayRect(drBounds);

    Dx:=0;
    for i := 0 to SubItem-1 do
      Inc(Dx,Sender.Column[i].Width);

    Rect.Left  :=Rect.Left+Dx;
    Rect.Right :=Rect.Left+Sender.Column[SubItem].Width;
    FillRect(Sender.Canvas.Handle, Rect, GetStockObject(WHITE_BRUSH));
    s.cx := GetSystemMetrics(SM_CXMENUCHECK);
    s.cy := GetSystemMetrics(SM_CYMENUCHECK);
    Dx   := (Sender.Column[SubItem].Width-GetSystemMetrics(SM_CXMENUCHECK)) div 2;
    if UseThemes then
    begin
      h := OpenThemeData(Sender.Handle, 'BUTTON');
      if h <> 0 then
        try
          GetThemePartSize(h, Sender.Canvas.Handle, BP_CHECKBOX, CBS_CHECKEDNORMAL, nil, TS_DRAW, s);
          r.Top    := Rect.Top + (Rect.Bottom - Rect.Top - s.cy) div 2;
          r.Bottom := r.Top + s.cy;
          r.Left   := Rect.Left + Dx;
          r.Right  := r.Left + s.cx;
          DrawThemeBackground(h, Sender.Canvas.Handle, BP_CHECKBOX, IfThen(CompareText(Item.SubItems[SubItem-1],'True')=0, CBS_CHECKEDNORMAL, CBS_UNCHECKEDNORMAL), r, nil);
        finally
          CloseThemeData(h);
        end;
    end
    else
    begin
      r.Top    := Rect.Top + (Rect.Bottom - Rect.Top - s.cy) div 2;
      r.Bottom := r.Top + s.cy;
      r.Left   := Rect.Left + Dx;
      r.Right  := r.Left + s.cx;
      DrawFrameControl(Sender.Canvas.Handle, r, DFC_BUTTON, IfThen(CompareText(Item.SubItems[SubItem-1],'True')=0, DFCS_CHECKED, DFCS_BUTTONCHECK));
    end;
  end;
end;
4

3 回答 3

10

消除此错误的一种相对简单的方法是所有者绘制整个项目。设置OwnerDraw := true、删除您的OnCustomDrawSubItem例程并添加

procedure TForm15.ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
  Rect: TRect; State: TOwnerDrawState);

  function ShrinkRect(const r: TRect; const X0, X1, Y0, Y1: integer): TRect; inline;
  begin
    result := r;
    inc(result.Left, X0);
    inc(result.Top, Y0);
    dec(result.Right, X1);
    dec(result.Bottom, Y1);
  end;

const
  CHECK_COL = 2;
  PADDING = 4;
var
  r: TRect;
  i: Integer;
  s: string;
  size: TSize;
  h: HTHEME;
begin

  FillRect(Sender.Canvas.Handle, Rect, GetStockObject(WHITE_BRUSH));
  r := Rect;
  inc(r.Left, PADDING);
  for i := 0 to TListView(Sender).Columns.Count - 1 do
  begin
    r.Right := r.Left + Sender.Column[i].Width;
    if i <> CHECK_COL then
    begin
      if i = 0 then
      begin
        s := Item.Caption;
        if not IsWindowVisible(ListView_GetEditControl(Sender.Handle)) then
        begin
          if UseThemes and ([odSelected, odHotLight] * State <> []) then
          begin
            h := OpenThemeData(Sender.Handle, 'LISTVIEW');
            if h <> 0 then
              try
                DrawThemeBackground(h, Sender.Canvas.Handle, LVP_GROUPHEADER, IfThen(odSelected in State, LVGH_CLOSESELECTED, LVGH_OPENHOT), ShrinkRect(r, -2, 6, 1, 1), nil);
              finally
                CloseThemeData(h);
              end;
          end;
          if (odSelected in State) and not UseThemes then
            DrawFocusRect(Sender.Canvas.Handle, ShrinkRect(r, -2, 6, 1, 1));
        end;
      end
      else
        s := Item.SubItems[i - 1];
      Sender.Canvas.Brush.Style := bsClear;
      DrawText(Sender.Canvas.Handle,
        PChar(s),
        length(s),
        r,
        DT_SINGLELINE or DT_VCENTER or DT_LEFT or DT_END_ELLIPSIS);
    end
    else
    begin

      size.cx := GetSystemMetrics(SM_CXMENUCHECK);
      size.cy := GetSystemMetrics(SM_CYMENUCHECK);
      if UseThemes then
      begin
        h := OpenThemeData(Sender.Handle, 'BUTTON');
        if h <> 0 then
          try
            GetThemePartSize(h, Sender.Canvas.Handle, BP_CHECKBOX, CBS_CHECKEDNORMAL, nil, TS_DRAW, size);
            r.Top    := Rect.Top + (Rect.Bottom - Rect.Top - size.cy) div 2;
            r.Bottom := r.Top + size.cy;
            r.Left   := r.Left + PADDING;
            r.Right  := r.Left + size.cx;
            DrawThemeBackground(h, Sender.Canvas.Handle, BP_CHECKBOX, IfThen(CompareText(Item.SubItems[1],'True')=0, CBS_CHECKEDNORMAL, CBS_UNCHECKEDNORMAL), r, nil);
          finally
            CloseThemeData(h);
          end;
      end
      else
      begin
        r.Top    := Rect.Top + (Rect.Bottom - Rect.Top - size.cy) div 2;
        r.Bottom := r.Top + size.cy;
        r.Left   := r.Left + PADDING;
        r.Right  := r.Left + size.cx;
        DrawFrameControl(Sender.Canvas.Handle, r, DFC_BUTTON, IfThen(CompareText(Item.SubItems[1],'True')=0, DFCS_CHECKED, DFCS_BUTTONCHECK));
      end;

    end;
    inc(r.Left, Sender.Column[i].Width);
  end;

end;

示例使用

上面的代码需要进一步测试，但可能是正确的方向。现在已经很晚了，我得走了。

于 2011-04-02T01:10:27.197 回答
0

首先，您应该在绘制复选框列时设置DefaultDraw为，否则，因为这意味着 VCL 进行绘图，而不是您。目前你做相反的事情。falsetrueDefaultDraw

另外，由于某种奇怪的原因，控件认为第一个子项是SubItem = 1，第二个子项是SubItem = 2。因此，您应该进行测试if SubItem = 2 then。

[当然，这意味着更改

for i := 0 to SubItem - 1 do
  Inc(Dx, Sender.Column[i].Width);

Rect.Right := Rect.Left+Sender.Column[SubItem].Width;

]

黑色矩形似乎是 VCL 和 Win32 代码联合中某处的错误。

于 2011-04-01T23:57:26.310 回答
0

在没有完全切换到 OwnerDraw 的情况下，我发现以下内容是可以接受的：

  1. 不要填充标题列（或将其用于索引）并将其初始宽度设置为 0
  2. 将您的标签放在第一个 SubItem 列（第二列），然后是复选框

  3. 使用 CustomDrawSubItem 例程使用“TextOut”绘制标签，例如：

    ListView1.Canvas.TextOut(2, y, '我的标签');

这隐藏了黑框，您可以看到您的文本标签。但是，选择不适用于文本。在我看来，付出的代价很小。

于 2013-03-22T15:18:23.407 回答