FMX TGrid OnCellClick событие

[dmitry2022]

На форме лежит TGrid у него есть TCheckColumn. Подключен обработчик OnCellClick.

Вопрос: как добиться надежного вызова OnCellClick события при кликах левой кнопкой мыши(ЛКМ) для  произвольной строки, если:

1) Нажатия ЛКМ происходят по одной и той же ячейке в колонке TCheckColumn;

2) Нажатия ЛКМ не сопровождаются смещением курсора мыши.

Для лучшего пояснения сути вопроса приведу картинку(см. ниже). На ней нажимается ЛКМ в одной и той же ячейке без смещений курсора. События возникающие в этой ситуации протоколируются в окне CodeSite(оно справа). Как видно из картинки: ячейка в столбце TCheckColumn меняет свое состояние(то появляется галочка то исчезает), но событие OnCellClick возникает только 1 раз.

Сама картинка:

Код тестового приложения привожу ниже:

Спойлер

 

 

 

unit uMain;

interface

uses
  System.SysUtils,
  System.Types,
  System.UITypes,
  System.Classes,
  System.Variants,
  System.Rtti,
  //
  FMX.Types,
  FMX.Controls,
  FMX.Forms,
  FMX.Graphics,
  FMX.Dialogs,
  FMX.Grid.Style,
  FMX.Grid,
  FMX.Controls.Presentation,
  FMX.ScrollBox,
  FMX.StdCtrls, 
  FMX.ImgList;
  //

type

  //строка грида
  TRow = record
    ID:integer;
    Checked:boolean;
  end;

  //Test form
  TForm1 = class(TForm)
    grd: TGrid;
    CheckColumn2: TCheckColumn;
    Label2: TLabel;
    IntegerColumn1: TIntegerColumn;
    procedure FormCreate(Sender: TObject);
    procedure grdGetValue(Sender: TObject; const ACol, ARow: Integer; var Value: TValue);
    procedure grdSetValue(Sender: TObject; const ACol, ARow: Integer; const Value: TValue);
    procedure grdCellClick(const Column: TColumn; const Row: Integer);
  private
    //контейнер значений ячеек грида
    FRowsA: array of TRow;
    FSelectedRow: integer;
    //
    procedure PopulateGrid;//заполняет Grid
    //
  end;

  //столбцы сетки
  TMyCols = (mcID, mcChecked);

var
  Form1: TForm1;

implementation

{$R *.fmx}

//FormCreate
procedure TForm1.FormCreate(Sender: TObject);
begin
  PopulateGrid;
end;
    
{$REGION 'TGrid'}

//PopulateGrid
procedure TForm1.PopulateGrid;
const
  rows = 10;//число строк
begin
  Grd.RowCount := rows ;
  SetLength(FRowsA, rows);
  //по строкам
  for var r := 0 to rows-1 do
  begin
    //
    FRowsA[r].ID := r;           //id
    FRowsA[r].Checked := false ; //check
  end;
end;

//grdCellClick
procedure TForm1.grdCellClick(const Column: TColumn; const Row: Integer);
var
  selRow, cnt: integer;
begin
  var ci := Column.Index ;
  FSelectedRow := Row;
  cnt := grd.RowCount ;
  //колонка checked
  if ci = Ord(TMyCols.mcChecked) then
  begin
    //
    grd.RowCount := 0;
    grd.RowCount := cnt;
    grd.SelectRow(FSelectedRow);
    //
    FRowsA[Row].Checked := not FRowsA[Row].Checked;
    //
    Log.d( Format('CellClick raised: row=%d; col=%d', [Row, ci]) );
  end;
end;

//grdSetValue
procedure TForm1.grdSetValue(Sender: TObject; const ACol, ARow: Integer; const Value: TValue);
var
  oldVal, newVal: boolean;
begin
  //значения в ячейках сохраняет во внешний массив FRowsA
  //
  var g := Sender as TGrid;
  if not Assigned(g) then Exit;
  if (ARow < 0) or (ARow >= g.RowCount) then Exit;
  //
  //номер колонки
  case ACol of
    //колонка id
    Ord(TMyCols.mcID):
      begin
        FRowsA[ARow].Checked := Value.AsBoolean;//id
      end;
    //колонка checked
    Ord(TMyCols.mcChecked):
      begin
        oldVal := FRowsA[ARow].Checked;

        Value.TryAsType<boolean>(newVal);
        FRowsA[ARow].Checked := newVal;//checked
        Log.d( Format('OnSetValue raised: row=%d; col=%d; oldValue=%s; newValue=%s', [ARow, ACol, oldVal.ToString(), newVal.ToString()]) );
      end;
    //
  end;
  //
end;

//grdGetValue
procedure TForm1.grdGetValue(Sender: TObject; const ACol, ARow: Integer; var Value: TValue);
var
  val: boolean;
begin
  //значения из внешнего массива FRowsA сохраняет в ячейки сетки
  //
  var g := Sender as TGrid;
  if not Assigned(g) then Exit;
  if (ARow < 0) or (ARow >= g.RowCount) then Exit;

  //номер колонки
  case ACol of
    //колонка id
    Ord(TMyCols.mcID)  :
    begin
      Value := FRowsA[ARow].ID;
    end;
    //колонка checked
    Ord(TMyCols.mcChecked):
    begin
      Value := FRowsA[ARow].Checked;
    end;
  end;
  Log.d( Format('OnGetValue raised: row=%d; col=%d', [ARow, ACol]) );
  //
end;

{$ENDREGION}

//
end.

 

 

 

Изменено 31 июля, 2022 пользователем dmitry2022
форматирование рисунка

[dmitry2022]

Возможное решение этой задачи: 

1) Подключить обработчик события OnMouseDownClick к гриду для отлова любых нажатий и отпусканий ЛКМ по области контрола грида.

2) Подключить обработчик события OnSelectCell и в его теле выставлять флаг CanSelect := false для колонки типа TCheckColumn.

3) Для определения нажатой ячейки использовать метод грида: CellByPoint

Если эти правки внести в код в моем вопросе, то получится так:

Спойлер

unit uMain;

interface

uses
  System.SysUtils,
  System.Types,
  System.UITypes,
  System.Classes,
  System.Variants,
  System.Rtti,
  //
  FMX.Types,
  FMX.Controls,
  FMX.Forms,
  FMX.Graphics,
  FMX.Dialogs,
  FMX.Grid.Style,
  FMX.Grid,
  FMX.Controls.Presentation,
  FMX.ScrollBox,
  FMX.StdCtrls, 
  FMX.ImgList;
  //

type

  //строка грида
  TRow = record
    ID:integer;
    Checked:boolean;
  end;

  //Test form
  TForm1 = class(TForm)
    grd: TGrid;
    CheckColumn2: TCheckColumn;
    Label2: TLabel;
    IntegerColumn1: TIntegerColumn;
    procedure FormCreate(Sender: TObject);
    procedure grdGetValue(Sender: TObject; const ACol, ARow: Integer; var Value: TValue);
    procedure grdSetValue(Sender: TObject; const ACol, ARow: Integer; const Value: TValue);
    procedure grdSelectCell(Sender: TObject; const ACol, ARow: Integer; var CanSelect: Boolean);
  private
    //контейнер значений ячеек грида
    FRowsA: array of TRow;
    FSelectedRow: integer;
    //
    procedure InitGrid;//заполняет Grid
    procedure Grd_OnMouseDownClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    //
  end;

  //столбцы сетки
  TMyCols = (mcID, mcChecked);

var
  Form1: TForm1;

implementation

{$R *.fmx}

//FormCreate
procedure TForm1.FormCreate(Sender: TObject);
begin
  InitGrid;
end;
    
{$REGION 'TGrid'}

//PopulateGrid
procedure TForm1.InitGrid;
const
  rows = 10;//число строк
begin
  Grd.RowCount := rows ;
  SetLength(FRowsA, rows);
  //по строкам
  for var r := 0 to rows-1 do
  begin
    FRowsA[r].ID := r;           //id
    FRowsA[r].Checked := false ; //check
  end;
  Grd.OnMouseDown := Grd_OnMouseDownClick;
end;

//grdSetValue
procedure TForm1.grdSetValue(Sender: TObject; const ACol, ARow: Integer; const Value: TValue);
var
  oldVal, newVal: boolean;
begin
  //значения в ячейках сохраняет во внешний массив FRowsA
  //
  var g := Sender as TGrid;
  if not Assigned(g) then Exit;
  if (ARow < 0) or (ARow >= g.RowCount) then Exit;
  //
  //номер колонки
  case ACol of
    //колонка id
    Ord(TMyCols.mcID):
      begin
        FRowsA[ARow].Checked := Value.AsBoolean;//id
      end;
    //колонка checked
    Ord(TMyCols.mcChecked):
      begin
        oldVal := FRowsA[ARow].Checked;

        Value.TryAsType<boolean>(newVal);
        FRowsA[ARow].Checked := newVal;//checked
        Log.d( Format('OnSetValue raised: row=%d; col=%d; oldValue=%s; newValue=%s', [ARow, ACol, oldVal.ToString(), newVal.ToString()]) );
      end;
    //
  end;
  //
end;

//grdGetValue
procedure TForm1.grdGetValue(Sender: TObject; const ACol, ARow: Integer; var Value: TValue);
var
  val: boolean;
begin
  //значения из внешнего массива FRowsA сохраняет в ячейки сетки
  //
  var g := Sender as TGrid;
  if not Assigned(g) then Exit;
  if (ARow < 0) or (ARow >= g.RowCount) then Exit;

  //номер колонки
  case ACol of
    //колонка id
    Ord(TMyCols.mcID)  :
    begin
      Value := FRowsA[ARow].ID;
    end;
    //колонка checked
    Ord(TMyCols.mcChecked):
    begin
      Value := FRowsA[ARow].Checked;
    end;
  end;
  Log.d( Format('OnGetValue raised: row=%d; col=%d', [ARow, ACol]) );
  //
end;

procedure TForm1.grdSelectCell(Sender: TObject; const ACol, ARow: Integer; var CanSelect: Boolean);
begin
  if (ACol = Ord(TMyCols.mcChecked)) then
    CanSelect := False
  else
    CanSelect := true;

  //Log.d( Format('OnSelectCell raised: row=%d; col=%d', [0, 0]) );
  CodeSite.Send( Format('OnSelectCell raised: row=%d; col=%d', [0, 0]) );
end;

procedure TForm1.Grd_OnMouseDownClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
var
  r,c: integer;
  s: string;
begin
  grd.CellByPoint(x, y, c, r);
  grd.BeginUpdate;
  //
  try
    if c = Ord(TMyCols.mcChecked) then FRowsA[r].Checked := not FRowsA[r].Checked;    
    grd.SelectRow(r);
  finally
    grd.EndUpdate;
  end;
  s := FRowsA[r].Checked.ToString();
  CodeSite.Send( Format('Grd OnMouseDownClick raised: value:%s; row=%d; col=%d', [s, r, c]) );
end;

{$ENDREGION}

//
end.

 

Изменено 4 августа, 2022 пользователем dmitry2022
форматирование спойлера