unit xStringGrig;
{ Проблема, которую решает данный модуль:

Перерисовка сетки (TStringGrig) происходит каждый раз при добавлении изменении и т.п. -
это происходит слишком часто и ведет к лишней нагрузке на систему.
  Реально перерисовка так часто не нужна, достаточно было бы 1 раз в
100-200 мс.

Решение:
  Данный модуль перхватывает все обращения к процедуре
     Invalidate;
определенной для TWinControl и заменяет их на 1 вызов в
100 мс. Вызов реального Invalidate (приводящий к перерисовке графика)
делается на базе MMTimer.

}

interface
  Uses Messages, classes, Grids, MMTimer;

type
  tFlag=(fInvalidated, fRepaint, fRepaintInProgress, fInvalidateOff);
  tFlags=set of tFlag;
  tEditAllowFlag=(eaDisallow, eaDisallowMsg);
  tEditAllowFlags=set of tEditAllowFlag;
  tEditAllowProc=function(ACol, ARow: Longint):tEditAllowFlags of object;

  tStringGrid=class(Grids.tStringGrid)
    private
      prTimer:tMMTimer;
      prCurCounter:integer;
      prDelayMultiplicator:word;
      prFlags:tFlags;
//      prEditRow,prEditCol:integer;
      prMsgShown:boolean;
//      prOldValue:string;
//      prEditable:tEditAllowFlags;
      prOnEditQuery:tEditAllowProc;

      procedure DoInvalidate(Sender:tObject);
      procedure SetDelayMultiplicator(n:word);
      procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
      procedure SetInvalidateOff(State:boolean);
      function GetInvalidateOff:boolean;
//      function SameCell(ACol, ARow: Longint):boolean;
    protected
      function GetEditText(ACol, ARow: Longint): string; override;
      procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
//      property  CellEditable:tEditAllowFlags read prEditable write prEditable;
      function GetEditable(ACol, ARow: Longint):tEditAllowFlags; virtual;
      procedure MsgEditingDisallowed;

    public
      constructor Create(Owner:tComponent); override;
      destructor Destroy; override;
      procedure Invalidate; override;
      property Timer:tMMTimer read prTimer;
      // Увеличение интервала перерисовки в указанное число раз
      property DelayMultiplicator:word read prDelayMultiplicator write SetDelayMultiplicator;
      property InvalidateOff:boolean read GetInvalidateOff write SetInvalidateOff;

      property Editable[ACol, ARow: Longint]:tEditAllowFlags read GetEditable;
      property OnEditQuery:tEditAllowProc read prOnEditQuery write prOnEditQuery;
  end;

implementation
  USES Windows;

(*function tStringGrid.SameCell(ACol, ARow: Longint):boolean;
begin
  Result:=(prEditRow=ARow) and (prEditCol=ACol);
end;*)

function tStringGrid.GetEditable(ACol, ARow: Longint):tEditAllowFlags;
  var eq:tEditAllowProc;
begin
  eq:=OnEditQuery;
  if Assigned(eq) then begin
    Result:=eq(ACol, ARow);
  end else begin
    Result:=[];
  end;
end;


function tStringGrid.GetEditText(ACol, ARow: Longint): string;
begin
//  prEditRow:=ARow;
//  prEditCol:=ACol;
//  prOldValue:=Cells[ACol, ARow];

  prMsgShown:=FALSE;
  Inherited GetEditText(ACol, ARow);
end;

procedure tStringGrid.SetEditText(ACol, ARow: Longint; const Value: string);
begin
  if eaDisallow in Editable[ACol, ARow] then begin
//    if SameCell(ACol, ARow) then begin
//      Inherited(ACol, ARow, prOldValue);
//    end;
    if (eaDisallowMsg in Editable[ACol, ARow]) and not prMsgShown then
      MsgEditingDisallowed;
  end else begin
    Inherited;
  end;
end;

procedure tStringGrid.MsgEditingDisallowed;
  resourcestring
    rsMsgEditingDisallowed='Редактирование ячейки невозможно.';
    rsMsgEditingDisallowedTitle='Сетка';
begin
  if prMsgShown then Exit;
  MessageBox(Handle,
    PChar(rsMsgEditingDisallowed),
    PChar(rsMsgEditingDisallowedTitle), MB_OK+MB_ICONINFORMATION);
  prMsgShown:=TRUE;
end;

procedure tStringGrid.SetInvalidateOff(State:boolean);
begin
  if State then
    Include(prFlags,fInvalidateOff)
  else
    Exclude(prFlags, fInvalidateOff);
end;

function tStringGrid.GetInvalidateOff:boolean;
begin
  Result:=fInvalidateOff in prFlags;
end;

constructor tStringGrid.Create(Owner:tComponent);
begin
  inherited;
  prTimer:=tMMTimer.Create;
  prTimer.Interval:=177;
  prTimer.Resolution:=100;
  prTimer.TimerType:=ttPeriodic;
  prTimer.OnTimer:=DoInvalidate;
  prTimer.Enabled:=TRUE;
end;

destructor tStringGrid.Destroy;
begin
  prTimer.Free;
  inherited;
end;

procedure tStringGrid.Invalidate;
begin
  if not (fInvalidateOff in prFlags) then begin
    Include(prFlags,fInvalidated);
  end;
end;

procedure tStringGrid.WMPaint(var Message: TWMPaint);
begin
  if fRepaint in prFlags then begin
    Include(prFlags,fRepaintInProgress);
    Exclude(prFlags,fRepaint);
    Exclude(prFlags,fInvalidated);
    Inherited;
    Exclude(prFlags,fRepaintInProgress);
  end else begin
    prCurCounter:=0;
    Invalidate;
  end;
end;

procedure tStringGrid.DoInvalidate(Sender:tObject);
begin
  if prCurCounter>0 then begin
    Dec(prCurCounter);
  end else begin
    if (fInvalidated in prFlags) and not (fRepaintInProgress in prFlags) then begin
      Include(prFlags,fRepaint);
      Inherited Invalidate;
      prCurCounter:=prDelayMultiplicator;
    end;
  end;
end;

procedure tStringGrid.SetDelayMultiplicator(n:word);
begin
  prDelayMultiplicator:=n;
  if prCurCounter>n then begin
    prCurCounter:=n;
  end;
end;

end.