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