delphi - 在 TListView 中绘制复选框

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 中绘制复选框的正确方向吗？(代码不会在 ListView 中绘制任何复选框)。

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

更新 1:由于 sertac 建议设置了 DefaultDraw 值，现在会显示复选框，但其他列看起来很糟糕。

更新2，按照Andreas的建议， ListView 现在看起来更好，但仍然显示黑框；

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;

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