How to sort a TCheckListBox without loosing the check state

Problem/Question/Abstract:

How to sort a TCheckListBox without loosing the check state

Answer:

Sorting without loosing the check state is a bit of a challenge, but it can be done. The code below has only been superficially tested:

{ ... }
type
  TItemState = class
  public
    Data: TObject;
    Checked: Boolean;
    constructor Create(aData: TObject; aChecked: Boolean);
  end;

constructor TItemState.Create(aData: TObject; aChecked: Boolean);
begin
  inherited Create;
  Data := aData;
  Checked := aChecked;
end;

procedure CustomSortChecklist(aList: TChecklistbox; Compare: TStringListSortCompare = nil);
var
  sl: TStringlist;
  i: Integer;
  stateobj: TItemState;
begin
  Assert(Assigned(aList), 'CustomSortChecklist: no list to sort.');
  sl := TStringlist.Create;
  try
    sl.Assign(aList.Items);
    for i := 0 to sl.Count - 1 do
      sl.Objects[i] := TItemState.Create(sl.Objects[i], aList.Checked[i]);
    if Assigned(Compare) then
      sl.CustomSort(Compare)
    else
      sl.Sort;
    alist.Items.BeginUpdate;
    try
      aList.Clear;
      for i := 0 to sl.Count - 1 do
      begin
        stateobj := sl.Objects[i] as TItemState;
        aList.Items.AddObject(sl[i], stateobj.Data);
        aList.Checked[i] := stateobj.Checked;
      end;
    finally
      aList.Items.EndUpdate;
    end;
  finally
    for i := 0 to sl.Count - 1 do
      if Assigned(sl.Objects[i]) and (sl.Objects[i] is TItemState) then
        sl.Objects[i].Free;
    sl.free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CustomSortChecklist(checklistbox1);
end;

function ReverseSort(List: TStringList; Index1, Index2: Integer): Integer;
begin
  result := AnsiCompareText(list[index2], list[index1]);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  CustomSortChecklist(checklistbox1, Reversesort);
end;