Precisamente he desarrollado el mismo truco pero a un nivel de programación más bajo, con API.
La solución está basada en una clase que realiza un subclassing del formulario para controlar las notificaciones que envían la cabecera y el ListView. La clase agrega un ChecBox en la cabecera de la primera columna y en cada Item. También genera dos eventos, uno cuando se marca el CheckBox de la caberera y otro cuando se marca el de un Item, de esta forma tendremos control desde el formulario de lo que está pasando. Cuando se marca la cabecera, automáticamente se marcan todos los Items y cuando están marcados todos los Items individualmente, se marca la cabecera.
Esta funcionalidad aparece desde Vista en adelante.
El código de la clase es este:
Código Delphi
[-]
unit LVCheckBox;
interface
uses Windows, Messages, CommCtrl;
const
HDN_ITEMSTATEICONCLICK: integer = $FFFFFEC4;
HDF_CHECKBOX = $0040;
HDF_CHECKED = $0080;
HDF_FIXEDWIDTH = $0100;
HDS_CHECKBOXES = $0400;
type
PNMHEADER = ^TagNMHEADER;
TOnHeaderChecked = procedure(Checked: boolean) of object;
TOnItemChecked = procedure(Index: integer; Checked: boolean) of object;
type
TLVCheckBox = class
private
hListView: HWND;
OldWndProc: Pointer;
function WndProc(Handle: HWND; Msg: DWORD; WParam: Longint; LParam: Longint): Longint; stdcall;
public
OnHeaderChecked: TOnHeaderChecked;
OnItemChecked: TOnItemChecked;
constructor Create; overload;
constructor Create(hListView: HWND); overload;
destructor Destroy; override;
procedure SetHeaderCheck;
procedure SetHandle(hLV: HWND);
end;
implementation
function DefWndProc(Handle: HWND; Msg: DWORD; WParam: Longint; LParam: Longint): Longint; stdcall;
var
pLVCheckBox: TLVCheckBox;
begin
pLVCheckBox:= TLVCheckBox(GetWindowLong(Handle, GWL_USERDATA));
if pLVCheckBox <> nil then
Result:= pLVCheckBox.WndProc(Handle, Msg, WParam, LParam)
else
Result:= DefWindowProc(Handle, Msg, WParam, LParam);
end;
constructor TLVCheckBox.Create;
begin
OnHeaderChecked:= nil;
OnItemChecked:= nil;
SetHandle(0);
end;
constructor TLVCheckBox.Create(hListView: HWND);
begin
OnHeaderChecked:= nil;
OnItemChecked:= nil;
SetHandle(hListView);
end;
function TLVCheckBox.WndProc(Handle: HWND; Msg: DWORD; WParam: Longint; LParam: Longint): Longint; stdcall;
var
pNMH: PNMHEADER;
pNMLV: PNMLISTVIEW;
HeaderChecked: bool;
i: integer;
begin
if Msg = WM_NOTIFY then
begin
pNMH:= PNMHEADER(LParam);
if pNMH.hdr.code = HDN_ITEMSTATEICONCLICK then
begin
if (0 <> (pNMH.PItem.mask and HDI_FORMAT)) and (0 <> (pNMH.PItem.fmt and HDF_CHECKBOX)) then
begin
HeaderChecked:= (0 = (pNMH.pitem.fmt and HDF_CHECKED));
if @OnHeaderChecked <> nil then
OnHeaderChecked(HeaderChecked);
for i:= 0 to ListView_GetItemCount(hListView)-1 do
ListView_SetCheckState(hListView, i, HeaderChecked);
end;
end;
if pNMH.hdr.code = LVN_ITEMCHANGED then
begin
pNMLV:= PNMLISTVIEW(LParam);
if (pNMLV.uChanged and LVIF_STATE) <> 0 then
begin
if @OnItemChecked <> nil then
OnItemChecked(pNMLV.iItem, ListView_GetCheckState(hListView, pNMLV.iItem) <> 0);
SetHeaderCheck;
end;
end;
end;
Result:= CallWindowProc(OldWndProc, Handle, Msg, WParam, LParam);
end;
procedure TLVCheckBox.SetHeaderCheck;
var
HeaderChecked: boolean;
i: integer;
hHeader: HWND;
HDI: HD_ITEM;
begin
HeaderChecked:= true;
for i:= 0 to ListView_GetItemCount(hListView)-1 do
begin
if ListView_GetCheckState(hListView, i) = 0 then
begin
HeaderChecked:= false;
break;
end;
end;
hHeader:= ListView_GetHeader(hListView);
HDI.mask:= HDI_FORMAT;
Header_GetItem(hHeader, 0, HDI);
if HeaderChecked then
HDI.fmt:= HDI.fmt or HDF_CHECKED
else
HDI.fmt:= HDI.fmt and not HDF_CHECKED;
Header_SetItem(hHeader, 0, HDI);
end;
procedure TLVCheckBox.SetHandle(hLV: HWND);
var
hHeader: HWND;
HD: HD_ITEM;
begin
if (hLV <> INVALID_HANDLE_VALUE) and (hLV <> hListView) then
begin
if hLV = 0 then
begin
SetWindowLong(GetParent(hListView), GWL_USERDATA, 0);
SetWindowLong(GetParent(hListView), GWL_WNDPROC, LongInt(OldWndProc));
end;
if hLV <> 0 then
begin
ListView_SetExtendedListViewStyle(hLV, LVS_EX_CHECKBOXES or LVS_EX_FULLROWSELECT);
hHeader:= ListView_GetHeader(hLV);
SetWindowLong(hHeader, GWL_STYLE, GetWindowLong(hHeader, GWL_STYLE) or HDS_CHECKBOXES);
ZeroMemory(@HD, sizeof(HD_ITEM));
HD.mask:= HDI_FORMAT;
Header_GetItem(hHeader, 0, HD);
HD.fmt:= HD.fmt or HDF_CHECKBOX or HDF_FIXEDWIDTH;
Header_SetItem(hHeader, 0, HD);
SetWindowLong(GetParent(hLV), GWL_USERDATA, LongInt(self));
OldWndProc:= Pointer(SetWindowLong(GetParent(hLV), GWL_WNDPROC, LongInt(@DefWndProc)));
end;
hListView:= hLV;
end;
end;
destructor TLVCheckBox.Destroy;
begin
OnHeaderChecked:= nil;
OnItemChecked:= nil;
SetHandle(0);
end;
end.
Un ejemplo de uso:
Código Delphi
[-]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, CommCtrl, XPMan, LVCheckBox, StdCtrls;
type
TForm1 = class(TForm)
ListView1: TListView;
XPManifest1: TXPManifest;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
LVC: TLVCheckBox;
procedure OnHeaderChecked(Checked: boolean);
procedure OnItemChecked(Index: integer; Checked: boolean);
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
LVC:= TLVCheckBox.Create(ListView1.Handle);
LVC.OnHeaderChecked:= OnHeaderChecked;
LVC.OnItemChecked:= OnItemChecked;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
LVC.SetHandle(ListView1.Handle);
LVC.OnHeaderChecked:= OnHeaderChecked;
LVC.OnItemChecked:= OnItemChecked;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
LVC.SetHandle(0);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
LVC.Free;
end;
procedure TForm1.OnHeaderChecked(Checked: boolean);
begin
Windows.Beep(500, 100);
end;
procedure TForm1.OnItemChecked(Index: integer; Checked: boolean);
begin
Windows.Beep(1000, 100);
end;
end.
Probado en Delphi 7 y Berlin.
Saludos.