drawing a checkbox in a TListView
One relatively simple way to get rid of this bug is to owner-draw the entire item. Set OwnerDraw := true
, remove your OnCustomDrawSubItem
routine, and add
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;
The code above needs further testing, but is probably in the right direction. Now it's very late, and I have to go.
Related videos on Youtube
Salvador
Updated on June 04, 2022Comments
-
Salvador almost 2 years
I need to draw a checkbox in a particular column in a
TListView
, so i check this questionHow can I setup TListView with CheckBoxes in only certain columns?
and in the accepted answer suggest use the method described in this another questionHow to set a Checkbox TStringGrid in Delphi?
, now porting that code to work with a ListView i come with this :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;
but i fail miserably in my attempt to draw a checkbox :(, can someone point me in the right direction to draw the checkbox in the listview, (the code does not draw any checkbox in the listview).
The listview is in vsReport mode and had 3 columns, i want put the checkbox in the third column. please don't suggest which use a thrid party component, i want use the TlistView control.
UPDATE 1 : thanks to the sertac recomendattion setting the
DefaultDraw
value now the checkboxes are shown, but the another columns looks awfull.UPDATE 2 , following the Andreas suggestions the listview now look better, but still shown the black box;
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;
-
Salvador about 13 yearsThanks very much @Andreas. do you have an idea as remove the black box?
-
Andreas Rejbrand about 13 years@Salvador: No, I have no idea. It would probably work well to owner-draw the entire item, but that shouldn't be necessary...