Question

我需要在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;

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

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

UPDATE 1 ：由于sertac recomendattion设置了DefaultDraw值，现在会显示复选框，但其他列看起来很糟糕。

enter image description here

更新2 ，按照安德烈亚斯的建议，列表视图现在看起来更好，但仍显示黑匣子;

enter image description here

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;

Answer 1

摆脱这个错误的一个相对简单的方法是拥有者绘制整个项目。设置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;

Sample usage http://privat.rejbrand.se/listbugs.png

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

Answer 2

首先，您应该在绘制复选框列时将DefaultDraw设置为false，否则设置为true，因为DefaultDraw表示VCL执行绘图，而不是您。目前你正好相反。

此外，由于某些奇怪的原因，控件将第一个子项视为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代码联合中的某个错误。

Answer 3

如果没有完全切换到OwnerDraw，我发现以下内容是合理可以接受的：

不填充字幕列（或用于索引）并将其初始宽度设置为0
将标签放在第一个SubItem列（第2列）中，然后选中复选框
使用CustomDrawSubItem例程使用“TextOut”绘制标签，例如：

ListView1.Canvas.TextOut（2，y，'我的标签'）;

这会隐藏黑匣子，您可以看到文字标签。但是，选择不适用于文本。在我看来，虽然支付的价格很小。

在TListView中绘制一个复选框

3 个答案: