Страница 1 из 1

Ошибка в TStringGrid.onGetEditText?

СообщениеДобавлено: 30.12.2009 10:30:54
Putnick
Уважаемые форумчане!
Наблюдаю странное поведение приведённого ниже кода:
Код: Выделить всё
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  Grids;

type

  { TForm1 }

  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    procedure StringGrid1GetEditText(Sender: TObject; ACol, ARow: Integer;
      var Value: string);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  GetCount:integer=0;

implementation

{ TForm1 }

procedure TForm1.StringGrid1GetEditText(Sender: TObject; ACol, ARow: Integer;
  var Value: string);
begin
  inc(GetCount);
  Caption:=IntTostr(GetCount)
end;

initialization
  {$I unit1.lrs}

end.

Если верить руководству по Delphi, при каждом редактировании ячейки счётчик GetCount должен увеличиваться на единицу. Однако, в Лазарусе (9.29 svn 23009)счётчик увеличивается на 1...4, причём четкой системы я найти не смог.
Собственно вопрос: это ошибка в классе, или я по глупости/невнимательности/незнанию что-то не включил/не выключил/в принципе не так делаю?
Суть проблемы в том, что мне нужно перед тем, как пользователь начнет редактировать ячейку, изменить её значение, вернее тот текст, который будет редактироваться. Т.е. скажем, когда пользователь смотрит на ячейку, он видит в ней "6", а захочет редактировать, ему "подсунут" "2+2*2".
Предполагалось, что примерно такой
Код: Выделить всё
procedure TForm1.StringGrid1GetEditText(Sender: TObject; ACol, ARow: Integer;
  var Value: string);
begin
  if Formulas[ACol, ARow]<>'' then Value:=Formulas[ACol, ARow]
end;

procedure TForm1.StringGrid1ValidateEntry(sender: TObject; aCol, aRow: Integer;
  const OldValue: string; var NewValue: String);
begin
  if <NewValue - допустимое> then begin
    if NewValue<>'' then begin
      if NewValue[1]='=' then Formulas[aCol, aRow]:=NewValue else Formulas[aCol, aRow]:=''
    end else Formulas[aCol, aRow]:=''
  end else NewValue:=OldValue
end;
код решит задачу, но не тут то было :( .
Попытался разобраться, упростил до предела — получил то, с чего начал свой пост.

Заранее благодарен, с уважением, Алексей.

Re: Ошибка в TStringGrid.onGetEditText?

СообщениеДобавлено: 30.12.2009 14:49:09
Sergei I. Gorelkin
Попробуй проверять свойство StringGrid1.EditorMode: по идее, событие OnGetEditText должно вызываться один раз с EditorMode=False (его обрабатываем), а потом много раз с EditorMode=True (их игнорируем).

Re: Ошибка в TStringGrid.onGetEditText?

СообщениеДобавлено: 30.12.2009 18:11:13
Putnick
Сергей, благодарю за совет.
Однако, возникла другая проблема: такое ощущение, что EditorMode — переключается "один раз в жизни". Т.е. такой код
Код: Выделить всё
procedure TForm1.StringGrid1GetEditText(Sender: TObject; ACol, ARow: Integer;
  var Value: string);
begin
  if not (StringGrid1.EditorMode) then begin
  inc(GetCount);
  Caption:=IntTostr(GetCount)
  end;
end;
даёт GetCount=1 и всё...
Попытка принудительно сбрасывать состояние
Код: Выделить всё
procedure TForm1.StringGrid1SelectCell(Sender: TObject; aCol, aRow: Integer;
  var CanSelect: Boolean);
begin
  StringGrid1.EditorMode:=False
end;
ничего не даёт :( .

Ещё раз благодарю, с уважением, Алексей.

Добавлено спустя 1 час 51 минуту 43 секунды:
Сергей, спасибо за идею!
Попробовал вот так:
Код: Выделить всё
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  Grids;

type

  { TForm1 }

  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    procedure StringGrid1BeforeSelection(Sender: TObject; aCol, aRow: Integer);
    procedure StringGrid1GetEditText(Sender: TObject; ACol, ARow: Integer;
      var Value: string);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  GetCount:integer=0;
  Editing:boolean=false;

implementation

{ TForm1 }

procedure TForm1.StringGrid1GetEditText(Sender: TObject; ACol, ARow: Integer;
  var Value: string);
begin
  if not (Editing) then begin
  Editing:=True;
  inc(GetCount);
  Caption:=IntTostr(GetCount)
  end;
end;

procedure TForm1.StringGrid1BeforeSelection(Sender: TObject; aCol, aRow: Integer
  );
begin
  Editing:=False
end;

initialization
  {$I unit1.lrs}

end.

С "внешним" флажком — стало лучше.
Хотя, если в начальный момент времени стрелками или мышкой выбрать ячейку (не редактируя её), GetEditText всё-равно вызывается. И наоборот, если после завершения редактирования позиция "активной" ячейки не меняется, то при повторном редактировании GetEditText не вызывается. EditingDone, похоже, вызывается дважды: перед редактированием и после него.

С уважением, Алексей.