如何在TListView标题列中显示复选框？

Question

I need to have a check box in a column header of a TListView:

I have tried the following code:

with CheckBox1 do
begin
  Parent := ListView1;
  Top := 0;
  Left := 4;
end;

but the check box doesn't always work as expected. How can I properly create a check box in TListView header column ?

Answer 1

The following code will add the check box to the list view's header and shows how to handle the click event for it.

Please note, that the following code is supported since Windows Vista.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, CommCtrl;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
  private
    HeaderID: Integer;
    procedure WMNotify(var AMessage: TWMNotify); message WM_NOTIFY;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMNotify(var AMessage: TWMNotify);
begin
  if AMessage.NMHdr^.idFrom = HeaderID then
    if AMessage.NMHdr^.code = HDN_ITEMSTATEICONCLICK then
      ShowMessage('You have clicked the header check box');

  inherited;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  HeaderHandle: HWND;
  HeaderItem: HD_ITEM;
  HeaderStyle: Integer;
begin
  ListView_SetExtendedListViewStyle(ListView1.Handle, LVS_EX_CHECKBOXES or LVS_EX_FULLROWSELECT);
  HeaderHandle := ListView_GetHeader(ListView1.Handle);
  HeaderStyle := GetWindowLong(HeaderHandle, GWL_STYLE);
  HeaderStyle := HeaderStyle or HDS_CHECKBOXES;
  SetWindowLong(HeaderHandle, GWL_STYLE, HeaderStyle);

  HeaderItem.Mask := HDI_FORMAT;
  Header_GetItem(HeaderHandle, 0, HeaderItem);
  HeaderItem.fmt := HeaderItem.fmt or HDF_CHECKBOX or HDF_FIXEDWIDTH;
  Header_SetItem(HeaderHandle, 0, HeaderItem);

  HeaderID := GetDlgCtrlID(HeaderHandle);
end;

end.

Answer 2

If you are targeting Vista and later, obvious answer is TLama's . If not, parent the check box in the header control, not in the list box (again as TLama commented to the question). The check box will send notifications to its parent - the header control, so you need to subclass it. Working sample:

type
  TForm1 = class(TForm)
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FListHeaderWnd: HWND;
    FListHeaderChk: TCheckBox;
    FSaveListHeaderWndProc, FListHeaderWndProc: Pointer;
    procedure ListHeaderWndProc(var Msg: TMessage);
  end;

var
  Form1: TForm1;

implementation

uses
  commctrl;

{$R *.dfm}

function GetCheckSize: TPoint;     // from checklst.pas
begin
  with TBitmap.Create do
    try
      Handle := LoadBitmap(0, PChar(OBM_CHECKBOXES));
      Result.X := Width div 4;
      Result.Y := Height div 3;
    finally
      Free;
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  CheckSize: TPoint;
  HeaderSize: TRect;
begin
  ListView1.HandleNeeded;
  FListHeaderWnd := ListView_GetHeader(ListView1.Handle);

  FListHeaderChk := TCheckBox.Create(nil);
  CheckSize := GetCheckSize;
  FListHeaderChk.Height := CheckSize.X;
  FListHeaderChk.Width := CheckSize.Y;

  // the below won't show anything since the form is not visible yet
  ShowWindow(ListView1.Handle, SW_SHOWNORMAL); // otherwise header is not sized
  windows.GetClientRect(FListHeaderWnd, HeaderSize);
  FListHeaderChk.Top := (HeaderSize.Bottom - FListHeaderChk.Height) div 2;
  FListHeaderChk.Left := FListHeaderChk.Top;

  FListHeaderChk.Parent := Self;
  windows.SetParent(FListHeaderChk.Handle, FListHeaderWnd);

  FListHeaderWndProc := classes.MakeObjectInstance(ListHeaderWndProc);
  FSaveListHeaderWndProc := Pointer(GetWindowLong(FListHeaderWnd, GWL_WNDPROC));
  SetWindowLong(FListHeaderWnd, GWL_WNDPROC, NativeInt(FListHeaderWndProc));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  SetWindowLong(FListHeaderWnd, GWL_WNDPROC, NativeInt(FSaveListHeaderWndProc));
  classes.FreeObjectInstance(FListHeaderWndProc);
  FListHeaderChk.Free;
end;

procedure TForm1.ListHeaderWndProc(var Msg: TMessage);
begin
  if (Msg.Msg = WM_COMMAND) and (HWND(Msg.LParam) = FListHeaderChk.Handle)
        and (Msg.WParamHi = BN_CLICKED) then begin
    FListHeaderChk.Checked := not FListHeaderChk.Checked;

    // code that checks/clears all items

  end;

  Msg.Result := CallWindowProc(FSaveListHeaderWndProc, FListHeaderWnd,
                               Msg.Msg, Msg.WParam, Msg.LParam);
end;

Note that if you've 'ColumnClick' set, it looks ugly that the check box does not 'push' with the header button when you click on it.