Listview con Checkbox

[[escafandra]]

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;

//--------------------------------------------------------------------------------------------------
// TLVCheckBox (Versión Hook estilo C++)
// escafandra 2017
// Clase para manejo de CheckBox en la cabecera e Items de un ListView

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;
//  PNMLISTVIEW = ^TagNMLISTVIEW;

  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
    // Notificación del cambio del CheckBox de la cabecera
    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;

    // Notificación del cambio del CheckBox de un Item
    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 = (HANDLE)SendMessage(hListView, LVM_GETHEADER, 0, 0);
      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
    { Public declarations }
  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.