在TListView中绘制一个复选框
Sal*_*dor 7 delphi checkbox listview tlistview delphi-xe
我需要在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;
但是我在尝试绘制一个复选框时失败了:(有人可以指向我正确的方向来绘制列表视图中的复选框,(代码不会在列表视图中绘制任何复选框).
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, 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;
摆脱这个错误的一个相对简单的方法是拥有者绘制整个项目.设置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;
示例用法http://privat.rejbrand.se/listbugs.png
上面的代码需要进一步测试,但可能是正确的方向.现在已经很晚了,我得走了.