Me vi en la necesidad de utilizar un Tlistview y debía tener algunas columnas con checkbox que pudiera marcar y desmarcar, debido a ello buscando encontre como hacerlo y quiero compartir el código. De seguro a alguien le servirá.
Intente flexibilizar un poco el código, ya que el original había que indicar desde que columnas deberían ser checkbox lo que limita un poco, ya que en mi caso requeria intercalar las columnas checkbox con otras.
Bueno no tantas palabras. Los procedimientos que hacen el trabajo son:
- ListviewChecked(Sender:TObject)
- ListViewDrawCheckbox(Sender: TCustomListView; Item: TListItem; Rect: TRect; State: TOwnerDrawState)
Código Delphi
[-]
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Winapi.CommCtrl, Vcl.ExtCtrls, Vcl.StdCtrls;
type
TForm1 = class(TForm)
ListView1: TListView;
procedure FormCreate(Sender: TObject);
private
public
procedure ListviewChecked(Sender:TObject);
procedure ListViewDrawCheckbox(Sender: TCustomListView; Item: TListItem; Rect: TRect; State: TOwnerDrawState);
end;
var
Form1: TForm1;
implementation
uses UxTheme, System.Math;
{$R *.dfm}
procedure TForm1.ListviewChecked(Sender: TObject);
var
pt: TPoint;
item : TLIstItem;
hittestinfo: TLVHitTestInfo;
begin
pt:= TListView(Sender).ScreenToClient( mouse.cursorpos );
item := TListView(Sender).GetItemAt( pt.x, pt.y );
If Not Assigned( Item ) then
Exit;
FillChar( hittestinfo, sizeof( hittestinfo ), 0 );
hittestinfo.pt := pt;
If -1 <>listview1.perform( LVM_SUBITEMHITTEST, 0, lparam(@hittestinfo)) Then
Begin
if hittestinfo.iSubItem>0 then
begin
TListView(Sender).items[hittestinfo.iItem].Subitems[ hittestinfo.iSubItem-1];
If CompareText(TListView(Sender).items[hittestinfo.iItem].Subitems[ hittestinfo.iSubItem-1],DefaultTrueBoolStr)=0 then
TListView(Sender).items[hittestinfo.iItem].Subitems[ hittestinfo.iSubItem-1]:=DefaultFalseBoolStr
else
TListView(Sender).items[hittestinfo.iItem].Subitems[ hittestinfo.iSubItem-1]:=DefaultTrueBoolStr;
end;
End;
end;
procedure TForm1.ListViewDrawCheckbox(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 = 1;
PADDING = 5;
var
r: TRect;
i, oldleft: Integer;
s: string;
size: TSize;
h: HTHEME;
ListItem: TListItem;
checked:Boolean;
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=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,
System.Math.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;
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
if (Not TryStrToBool(Item.SubItems[i-1],checked)) then
begin
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);
oldleft:=R.Left;
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);
oldleft:=R.Left;
r.Top := Rect.Top + (Rect.Bottom - Rect.Top - size.cy) div 2;
r.Bottom := r.Top + size.cy;
r.Left := r.Left + (r.Right - r.Left - size.cx) div 2;
r.Right := r.Left + size.cx;
DrawThemeBackground(h, Sender.Canvas.Handle, BP_CHECKBOX, IfThen(CompareText(Item.SubItems[i-1],DefaultTrueBoolStr)=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 + (r.Right - r.Left - size.cx) div 2;
r.Right := r.Left + size.cx;
DrawFrameControl(Sender.Canvas.Handle, r, DFC_BUTTON, IfThen(CompareText(Item.SubItems[i-1],DefaultTrueBoolStr)=0, DFCS_CHECKED, DFCS_BUTTONCHECK));
end;
r.Left:=oldleft;
end
end;
inc(r.Left, Sender.Column[i].Width);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
const
Names: array[0..5, 0..1] of string = (
('Rubble', 'Barney'),
('Michael', 'Johnson'),
('Bunny', 'Bugs'),
('Silver', 'HiHo'),
('Simpson', 'Bart'),
('Squirrel', 'Rocky')
);
var
I: Integer;
NewColumn: TListColumn;
ListItem: TListItem;
ListView: TListView;
begin
ListView1.Items.Clear;
with ListView1 do
begin
Parent := Self;
Align := alClient;
ViewStyle := vsReport;
NewColumn := Columns.Add;
NewColumn.Caption := 'Last';
NewColumn := Columns.Add;
NewColumn.Caption := 'Age';
NewColumn := Columns.Add;
NewColumn.Caption := 'Select';
NewColumn := Columns.Add;
NewColumn.Caption := 'Comment';
NewColumn := Columns.Add;
NewColumn.Caption := 'View';
for I := Low(Names) to High(Names) do
begin
ListItem := Items.Add;
ListItem.Caption := Names[i][0];
ListItem.SubItems.Add(Names[i][1]);
ListItem.SubItems.Add(DefaultTrueBoolStr); ListItem.SubItems.Add('comentarios');
ListItem.SubItems.Add(DefaultFalseBoolStr); end;
end;
ListView1.OwnerDraw :=True;
ListView1.OnDrawItem:=ListViewDrawCheckbox;
ListView1.OnClick := ListviewChecked;
end;
end.
Espero sea de utilidad