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.