unit Unit1;

interface

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

type
  TLVCheckStateChangingEvent = procedure(Sender: TObject; Item: TListItem; ToBeChecked: Boolean;
    var AllowChange: Boolean) of object;

  TListView = class(ComCtrls.TListView)
  private
    FOnCheckStateChanging: TLVCheckStateChangingEvent;
    procedure CNNotify(var AMessage: TWMNotifyLV); message CN_NOTIFY;
  public
    property OnCheckStateChanging: TLVCheckStateChangingEvent read FOnCheckStateChanging write
      FOnCheckStateChanging;
  end;


type
  TForm1 = class(TForm)
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
  private
    FCheckIndex: Integer;
    procedure ListViewCheckStateChanging(Sender: TObject; Item: TListItem; ToBeChecked: Boolean;
      var AllowChange: Boolean);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  FCheckIndex := -1;

  ListView1.Columns.Add;
  ListView1.Checkboxes := True;
  ListView1.ViewStyle := vsReport;
  ListView1.OnCheckStateChanging := ListViewCheckStateChanging;

  for I := 1 to 10 do
    ListView1.AddItem('Item ' + IntToStr(I), nil);

  ListView1.Items[5].Checked := True;
end;

{ TListView }

function IsChecked(State: UINT): Boolean; inline;
begin
  Result := ((State and LVIS_STATEIMAGEMASK) and $2000) <> 0;
end;

function IsUnchecked(State: UINT): Boolean; inline;
begin
  Result := ((State and LVIS_STATEIMAGEMASK) and $1000) <> 0;
end;

function CheckChanged(OldState, NewState, Changed: UINT): Boolean; inline;
begin
  Result := (Changed = LVIF_STATE) and (((OldState and LVIS_STATEIMAGEMASK) and $3000) <>
    ((NewState and LVIS_STATEIMAGEMASK) and $3000));
end;

procedure TListView.CNNotify(var AMessage: TWMNotifyLV);
var
  AllowChange: Boolean;
begin
  if  AMessage.NMHdr.code = LVN_ITEMCHANGING then
  begin
    with AMessage.NMListView^ do
    begin
      if CheckChanged(uOldState, uNewState, uChanged) then
      begin
        AllowChange := True;

        if Assigned(FOnCheckStateChanging) then
          FOnCheckStateChanging(Self, Items[iItem], IsChecked(uNewState), AllowChange);

        if not AllowChange then
          AMessage.Result := 1;
      end
      else
        inherited;
    end;
  end
  else
    inherited;
end;

procedure TForm1.ListViewCheckStateChanging(Sender: TObject; Item: TListItem; ToBeChecked: Boolean;
  var AllowChange: Boolean);
var
  OldCheck: Integer;
begin
  AllowChange := ((not ToBeChecked) and (Item.Index <> FCheckIndex)) or ToBeChecked;
  if AllowChange and ToBeChecked then
  begin
    // store the check index of the item to be unchecked
    OldCheck := FCheckIndex;
    // remember the index of the item that will be checked
    FCheckIndex := Item.Index;
    // and uncheck the previously checked item if there was any; this can fail
    // with an access to a not existing item; there must be added other things
    // anyway, like e.g. updating the FCheckIndex field whenever the items are
    // reordered, deleted etc.
    if OldCheck <> -1 then
      ListView1.Items[OldCheck].Checked := False;
  end;
end;

end.