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

Question

我需要在TListView的列标题中有一个复选框：

我尝试过以下代码：

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

但复选框并不总是按预期工作。如何在TListView标题列中正确创建复选框？

Answer 1

以下代码会将复选框添加到列表视图的标题中，并显示如何处理它的click事件。

请注意，自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

如果您的目标是Vista及更高版本，那么明显的答案是TLama's。如果没有，请在标题控件中输入复选框，而不是在列表框中（同样，TLama对问题进行了评论）。该复选框将向其父级发送通知 - 标头控件，因此您需要对其进行子类化。工作样本：

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;

请注意，如果你设置了'ColumnClick'，那么当你点击它时，复选框没有按下标题按钮，看起来很难看。