加入收藏 | 设为首页 | 会员中心 | 我要投稿 李大同 （https://www.lidatong.com.cn/）- 科技、建站、经验、云计算、5G、大数据,站长网!
当前位置： 首页 > 大数据 > 正文

delphi – 在TListView中绘制一个复选框

发布时间：2020-12-15 10:11:25 所属栏目：大数据 来源：网络整理
导读：我需要在aTListView的特定列中绘制一个复选框,所以我检查这个问题 How can I setup TListView with CheckBoxes in only certain columns? 并在接受的答案建议中使用另一个问题 How to set a Checkbox TStringGrid in Delphi? 中描述的方法,现在移植该代码以
我需要在aTListView的特定列中绘制一个复选框,所以我检查这个问题 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,IfThen(CompareText(Item.SubItems[1],'True')=0,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,DFC_BUTTON,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]),DT_SINGLELINE or DT_VCENTER or DT_LEFT or DT_END_ELLIPSIS);
  end
  else
  DefaultDraw:=False;
end;

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

listview是在vsReport模式下有3列,我想把复选框放在第三列.请不要建议哪个使用第三方组件,我想使用TlistView控件.

更新1：由于sertac recomendattion设置了DefaultDraw值,现在显示了复选框,但是其他列看起来很糟糕.

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

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,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,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,IfThen(CompareText(Item.SubItems[SubItem-1],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,DFCS_BUTTONCHECK));
    end;
  end;
end;

解决方法

摆脱这个错误的一个相对简单的方法是拥有者绘制整个项目.设置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,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,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,1));
        end;
      end
      else
        s := Item.SubItems[i - 1];
      Sender.Canvas.Brush.Style := bsClear;
      DrawText(Sender.Canvas.Handle,PChar(s),length(s),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,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,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,DFCS_BUTTONCHECK));
      end;

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

end;

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

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

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!
    相关内容
      推荐文章
        站长推荐
        热点阅读

          【免责声明】本站内容转载自互联网，其发布内容言论不代表本站观点，如果其链接、内容的侵犯您的权益，烦请提交相关链接至邮箱bqsm@foxmail.com我们将及时予以处理。

          建议您使用1920×1080分辨率、谷歌浏览器Google Chrome、Microsoft Edge以获得本站的最佳浏览效果

          Copygight © 2008-2022 https://www.lidatong.com.cn/ All Rights Reserved. 李大同