Флажки не прокручиваются в компоненте TListView

Question

Я создал ListView и добавил флажки для проверки каждой строки, если это необходимо. Все было хорошо до тех пор, пока в списке не появилось много элементов, поэтому его нужно было прокрутить. Я проверил онлайн, а затем увидел, что флажки не прокручиваются с другим контентом, если я прокручиваю полосу прокрутки.

Мой код:

unit ShareCommissionDialog;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, sButton, ComCtrls, sListView, sCheckBox, DataManager;

type
  TdlgShareCommission = class(TForm)
    lvEmployees: TsListView;
    btnCancel: TsButton;
    btnDone: TsButton;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnDoneClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);

  private
    manager: TDataManager;
    ListViewCheckBoxList: TList;
    employeeIDs: TStringList;

    procedure ListViewCheckBoxCreate(List: TsListView; employeeID: string; R: TRect);
    procedure ListViewCheckBoxClick(Sender: TObject);
    procedure ListViewCheckBoxSelected(item: Integer; List: TsListView);
    procedure ListViewCheckBoxUnselected(item: Integer; List: TsListView);

    procedure PopulateEmployees;
    procedure ShowSelectedEmployees;
    procedure MarkRows;

  public
    property DataManager: TDataManager read manager write manager;
    property CommissionReceivers: TStringList read employeeIDs write employeeIDs;

  end;

var
  dlgShareCommission: TdlgShareCommission;

implementation

{$R *.dfm}

procedure TdlgShareCommission.btnCancelClick(Sender: TObject);
begin
  employeeIDs := employeeIDs;
end;

procedure TdlgShareCommission.btnDoneClick(Sender: TObject);
var
  i, j: Integer;

begin
  employeeIDs := TStringList.Create;

  for i := 0 to ListViewCheckBoxList.Count - 1 do
  begin
    if TsCheckBox(ListViewCheckBoxList[i]).Checked then
    begin
      for j := 0 to manager.Data.Employees.Count - 1 do
      begin
        if TsCheckBox(ListViewCheckBoxList[i]).Tag = StrToInt(manager.Data.Employees[j].ID) then
        begin
          employeeIDs.Add(manager.Data.Employees[j].ID);
          Break;
        end;
      end;
    end;
  end;
end;

procedure TdlgShareCommission.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  manager.GetEmployees(manager.Data.SelectedPOS.ID);
end;

procedure TdlgShareCommission.FormCreate(Sender: TObject);
begin
  ListViewCheckBoxList := TList.Create;
end;

procedure TdlgShareCommission.ListViewCheckBoxCreate(List: TsListView; employeeID: string; R: TRect);
function NewViewCheckBox: TsCheckBox;
  begin
    Result := TsCheckBox.Create(Self);
    Result.Tag := StrToInt(employeeID);
    Result.Parent := List;
    Result.BoundsRect := R;
    Result.Checked := False;

    Result.OnClick := ListViewCheckBoxClick;
  end;
begin
  ListViewCheckBoxList.Add(NewViewCheckBox);
end;

procedure TdlgShareCommission.FormShow(Sender: TObject);
begin
  if employeeIDs <> nil then
  begin
    PopulateEmployees;
    ShowSelectedEmployees;
    MarkRows;
  end
  else
  begin
    PopulateEmployees;
    MarkRows;
  end;

  //PopulateEmployees;
  //MarkRows;
end;

procedure TdlgShareCommission.ListViewCheckBoxClick(Sender: TObject);
var
  i: Integer;

begin
  for i := 0 to ListViewCheckBoxList.Count - 1 do
  begin
    if (i+1) <= (ListViewCheckBoxList.Count - 1) then
      if not TsCheckBox(ListViewCheckBoxList[i+1]).Enabled then
      begin
        TsCheckBox(ListViewCheckBoxList[i+1]).Checked := TsCheckBox(ListViewCheckBoxList[i]).Checked;
      end;
  end;

  MarkRows;
end;

procedure TdlgShareCommission.MarkRows;
var
  j: Integer;

begin
  for j := 0 to lvEmployees.Items.Count - 1 do
  begin
    if not TsCheckBox(ListViewCheckBoxList[j]).Checked then
    begin
      ListViewCheckBoxSelected(j, lvEmployees);
    end
    else
    begin
      ListViewCheckBoxUnselected(j, lvEmployees);
    end;
  end;
end;

procedure TdlgShareCommission.ListViewCheckBoxSelected(item: Integer; List: TsListView);
begin
  with List do
  begin
    Items[item].Selected := False;
  end;
end;

procedure TdlgShareCommission.ListViewCheckBoxUnselected(item: Integer; List: TsListView);
begin
  with List do
  begin
    Items[item].Selected := False;
  end;
end;

procedure TdlgShareCommission.PopulateEmployees;
var
  i: Integer;
  R: TRect;
  employeeRow: TListItem;

begin
  with lvEmployees do
  try
    Items.BeginUpdate;
    Items.Clear;

    manager.GetEmployees(manager.Data.SelectedPOS.ID);

    for i := 0 to manager.Data.Employees.Count - 1 do
    begin
      employeeRow := Items.Add;

      R := Items[i].DisplayRect(drBounds);
      R.Left := 5;
      R.Top := R.Top + 1;
      ListViewCheckBoxCreate(lvEmployees, manager.Data.Employees[i].ID, R);
      Items[i].Data := TsCheckBox(ListViewCheckBoxList[i]);

      employeeRow.SubItems.Add(manager.Data.Employees[i].FirstName + ' ' + manager.Data.Employees[i].LastName);
    end;
  finally
    lvEmployees.Items.EndUpdate;
  end;
end;

procedure TdlgShareCommission.ShowSelectedEmployees;
var
  i, j: Integer;

begin
  for j := 0 to lvEmployees.Items.Count - 1 do
  begin
    for i := 0 to employeeIDs.Count - 1 do
    begin
      if TsCheckBox(ListViewCheckBoxList[j]).Tag = StrToInt(employeeIDs[i]) then
      begin
        TsCheckBox(ListViewCheckBoxList[j]).Checked := True;
      end;
    end;
  end;
end;
end.

Что мне нужно добавить к коду, чтобы флажки также прокручивались вместе с другим контентом?

Answer 1

У стандарта ListView есть свойство с именем checkboxes, которое может быть установлено в значение true.
Если вы используете это, вам не придется возиться с созданием собственных флажков.
У меня никогда не было проблем с флажками, которые не отображаются должным образом в этом элементе управления.

Это свойство лучше всего работает в ViewStyle:= vsList или ViewStyle:= vsReport

В качестве альтернативы, если вы хотите установить флажки для некоторых элементов, но нев других случаях создайте изображение флажка (1 не отмечен, 1 отмечен) и добавьте оба из них в ImageList.
Если элементу требуется флажок, установите его свойство ImageIndex равным свойству непроверенного элемента.Если это необходимо проверить, установите его свойство ImageIndex для проверенного изображения.
Это работает в ViewStyle:= vsReport и ViewStyle:= vsList.

Вы используете пользовательский ListView (TsListView) control, попробуйте вместо этого использовать стандартный ListView и посмотрите, появляется ли странное поведение.