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.