fpspreadsheet: Fix navigation within worksheetgrid if in-place editor contains an erroroneous formula.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6514 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2018-06-20 16:57:20 +00:00
parent da23bd4405
commit 18395604ba
3 changed files with 119 additions and 61 deletions
--- a/components/fpspreadsheet/source/common/fpspreadsheet.pas
+++ b/components/fpspreadsheet/source/common/fpspreadsheet.pas
@@ -5655,7 +5655,9 @@ begin
      ACell.Flags := ACell.Flags - [cf3dFormula];

    formula^.Text := AFormula;
-    formula^.Parser := parser;   // parser will be destroyed by formula
+    formula^.Parser := parser;
+
+    // parser will be destroyed by formula
  end;

  // Set formula flags in cell
--- a/components/fpspreadsheet/source/visual/fpspreadsheetctrls.pas
+++ b/components/fpspreadsheet/source/visual/fpspreadsheetctrls.pas
@@ -243,6 +243,7 @@ type
  protected
    function CanEditCell(ACell: PCell): Boolean; overload;
    function CanEditCell(ARow, ACol: Cardinal): Boolean; overload;
+    procedure CheckFormula;
    procedure DoEnter; override;
    procedure KeyDown(var Key : Word; Shift : TShiftState); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
@@ -588,7 +589,7 @@ uses
  Types, Math, StrUtils, TypInfo, LCLType, LCLIntf, LCLProc,
  Dialogs, Forms, Clipbrd,
  fpsStrings, fpsCrypto, fpsReaderWriter, fpsUtils, fpsNumFormat, fpsImages,
-  fpsHTMLUtils, fpsCSV;
+  fpsHTMLUtils, fpsCSV, fpsExprParser;

 var
  cfBiff8Format: Integer = 0;
@@ -992,7 +993,8 @@ begin
  FreeAndNil(FWorkbook);
  FWorksheet := nil;
  if AWorkbook = nil then
-    FWorkbook := TsWorkbook.Create else
+    FWorkbook := TsWorkbook.Create
+  else
    FWorkbook := AWorkbook;
  FWorkbook.OnOpenWorkbook := @WorkbookOpenedHandler;
  FWorkbook.OnAddWorksheet := @WorksheetAddedHandler;
@@ -1880,11 +1882,25 @@ function TsCellEdit.CanEditCell(ARow, ACol: Cardinal): Boolean;
 var
  cell: PCell;
 begin
-//  cell := Worksheet.Findcell(Worksheet.ActiveCellRow, Worksheet.ActiveCellCol);
  cell := Worksheet.FindCell(ARow, ACol);
  Result := CanEditCell(cell);
 end;

+procedure TsCellEdit.CheckFormula;
+var
+  parser: TsSpreadsheetParser;
+begin
+  if Assigned(Worksheet) and (Text <> '') and (Text[1] = '=') then
+  begin
+    parser := TsSpreadsheetParser.Create(Worksheet);
+    try
+      parser.LocalizedExpression[Workbook.FormatSettings] := Text;
+    finally
+      parser.Free;
+    end;
+  end;
+end;
+
 procedure TsCellEdit.DoEnter;
 begin
  if Worksheet = nil then
@@ -1896,6 +1912,7 @@ begin
      'before continuing.', mtInformation, [mbOK], 0);
    Abort;
  end;
+
  inherited;
 end;

@@ -1913,6 +1930,16 @@ var
 begin
  if Worksheet = nil then
    exit;
+
+  try
+    Checkformula;
+  except
+    on E:Exception do begin
+      MessageDlg(E.Message, mtError, [mbOk], 0);
+      exit;
+    end;
+  end;
+
  cell := Worksheet.GetCell(Worksheet.ActiveCellRow, Worksheet.ActiveCellCol);
  if Worksheet.IsMerged(cell) then
    cell := Worksheet.FindMergeBase(cell);
--- a/components/fpspreadsheet/source/visual/fpspreadsheetgrid.pas
+++ b/components/fpspreadsheet/source/visual/fpspreadsheetgrid.pas
@@ -119,7 +119,7 @@ type
    FReadOnly: Boolean;
    FOnClickHyperlink: TsHyperlinkClickEvent;
    FOldEditorText: String;
-    FMultilineStringEditor: TMultilineStringCellEditor;
+    FMultiLineStringEditor: TMultilineStringCellEditor;
    FLineMode: TsEditorLineMode;
    FAllowDragAndDrop: Boolean;
    FDragStartCol, FDragStartRow: Integer;
@@ -246,7 +246,6 @@ type
    function CanEditShow: boolean; override;
    function CellOverflow(ACol, ARow: Integer; AState: TGridDrawState;
      out ACol1, ACol2: Integer; var ARect: TRect): Boolean;
-    procedure CheckFormula(ACol, ARow: Integer; AExpression: String);
    procedure ColRowMoved(IsColumn: Boolean; FromIndex,ToIndex: Integer); override;
    procedure CreateHandle; override;
    procedure CreateNewWorkbook;
@@ -254,6 +253,7 @@ type
    procedure DefineProperties(Filer: TFiler); override;
    procedure DoCopyToClipboard; override;
    procedure DoCutToClipboard; override;
+    procedure DoEditorHide; override;
    procedure DoEditorShow; override;
    procedure DoPasteFromClipboard; override;
    procedure DoOnResize; override;
@@ -314,8 +314,10 @@ type
    function ToPixels(AValue: Double): Integer;
    procedure TopLeftChanged; override;
    function TrimToCell(ACell: PCell): String;
-    procedure WMHScroll(var message : TLMHScroll); message LM_HSCROLL;
-    procedure WMVScroll(var message : TLMVScroll); message LM_VSCROLL;
+    function ValidFormula({ACol, ARow: Integer; }AExpression: String;
+      out AErrMsg: String): Boolean;
+    procedure WMHScroll(var message: TLMHScroll); message LM_HSCROLL;
+    procedure WMVScroll(var message: TLMVScroll); message LM_VSCROLL;

    {@@ Allow built-in drag and drop }
    property AllowDragAndDrop: Boolean read FAllowDragAndDrop
@@ -383,6 +385,7 @@ type
    function GetWorksheetRow(AGridRow: Integer): Cardinal; inline;
    procedure InsertCol(AGridCol: Integer);
    procedure InsertRow(AGridRow: Integer);
+
    procedure LoadFromSpreadsheetFile(AFileName: string;
      AFormat: TsSpreadsheetFormat; AWorksheetIndex: Integer = -1); overload;
    procedure LoadFromSpreadsheetFile(AFileName: string;
@@ -390,13 +393,16 @@ type
    procedure LoadSheetFromSpreadsheetFile(AFileName: String;
      AWorksheetIndex: Integer = -1; AFormatID: TsSpreadFormatID = sfidUnknown);
    procedure LoadFromWorkbook(AWorkbook: TsWorkbook; AWorksheetIndex: Integer = -1);
+
    procedure NewWorkbook(AColCount, ARowCount: Integer);
+
    procedure SaveToSpreadsheetFile(AFileName: string;
      AOverwriteExisting: Boolean = true); overload;
    procedure SaveToSpreadsheetFile(AFileName: string; AFormat: TsSpreadsheetFormat;
      AOverwriteExisting: Boolean = true); overload; deprecated;
    procedure SaveToSpreadsheetFile(AFileName: string; AFormatID: TsSpreadFormatID;
      AOverwriteExisting: Boolean = true); overload;
+
    procedure SelectSheetByIndex(AIndex: Integer);

    procedure MergeCells; overload;
@@ -1167,6 +1173,7 @@ procedure TMultilineStringCellEditor.KeyDown(var Key: Word; Shift: TShiftState);

 var
  IntSel: boolean;
+  msg: String;
 begin
  inherited KeyDown(Key,Shift);
  case Key of
@@ -1200,6 +1207,7 @@ begin
          FGrid.EditorHide;
        end;
      end;
+
    else
      doEditorKeyDown;
  end;
@@ -1906,23 +1914,6 @@ begin
  UpdateRowHeights(AGridRow);
 end;

-procedure TsCustomWorksheetGrid.CheckFormula(ACol, ARow: Integer;
-  AExpression: String);
-var
-  parser: TsSpreadsheetParser;
-begin
-  if Assigned(Worksheet) and
-    (AExpression <> '') and (AExpression[1] = '=') then
-  begin
-    parser := TsSpreadsheetParser.Create(Worksheet);
-    try
-      parser.Expression := AExpression;
-    finally
-      parser.Free;
-    end;
-  end;
-end;
-
 procedure TsCustomWorksheetGrid.ColRowMoved(IsColumn: Boolean;
  FromIndex,ToIndex: Integer);
 begin
@@ -2006,6 +1997,20 @@ begin
  WorkbookSource.PasteCellsFromClipboard(coCopyCell);
 end;

+procedure TsCustomWorksheetGrid.DoEditorHide;
+var
+  msg: String;
+begin
+  inherited;
+  // The following code is reached when an error is found in the cell formula
+  // being edited and another control is selected.
+  if (FEditText <> '') then
+    if not ValidFormula(FEditText, msg) then begin
+      MessageDlg(msg, mtError, [mbOK], 0);
+    FEditText := '';
+  end;
+end;
+
 { Make the cell editor the same size as the edited cell, in particular for
  even for merged cells; otherwise the merge base content would be seen during
  editing at several places. }
@@ -3260,28 +3265,25 @@ end;
 -------------------------------------------------------------------------------}
 procedure TsCustomWorksheetGrid.EditingDone;
 var
-  //oldText: String;
  cell: PCell;
+  msg: String;
 begin
  if (not EditorShowing) and FEditing then
  begin
-    {
-    oldText := GetCellText(Col, Row);
-    if oldText <> FEditText then
-    }
+    if not ValidFormula(FEditText, msg) then
+    begin
+      FEditing := false;
+      exit;
+    end;
+
    if FOldEditorText <> FEditText then
    begin
      cell := Worksheet.GetCell(GetWorksheetRow(Row), GetWorksheetCol(Col));
      if Worksheet.IsMerged(cell) then
        cell := Worksheet.FindMergeBase(cell);
-      if (FEditText <> '') and (FEditText[1] = '=') then begin
-//        try
-          Worksheet.WriteFormula(cell, Copy(FEditText, 2, Length(FEditText)), true)
-//        except
-//          on E: Exception do
-//            cell := nil;
-//        end;
-      end else
+      if (FEditText <> '') and (FEditText[1] = '=') then
+        Worksheet.WriteFormula(cell, Copy(FEditText, 2, Length(FEditText)), true)
+      else
        Worksheet.WriteCellValueAsString(cell, FEditText);
      FEditText := '';
      FOldEditorText := '';
@@ -3295,7 +3297,7 @@ end;
 function TsCustomWorksheetGrid.EditorByStyle(Style: TColumnButtonStyle): TWinControl;
 begin
  if (Style = cbsAuto) and (FLineMode = elmMultiLine) then
-    Result := FMultilineStringEditor
+    Result := FMultiLineStringEditor
  else
    Result := inherited;
 end;
@@ -4659,11 +4661,20 @@ end;
 procedure TsCustomWorksheetGrid.KeyDown(var Key : Word; Shift : TShiftState);
 var
  R: TRect;
+  msg: String;
 begin
  // Check validity for formula before navigating to another cell.
  case Key of
-    VK_TAB, VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT, VK_END, VK_HOME:
-      if EditorMode then CheckFormula(Col, Row, FEditText);
+    VK_RETURN,
+    VK_TAB,
+    VK_LEFT, VK_RIGHT,
+    VK_UP, VK_DOWN,
+    VK_PRIOR, VK_NEXT,
+    VK_END, VK_HOME:
+      if not ValidFormula(FEditText, msg) then begin
+        MessageDlg(msg, mtError, [mbOK], 0);
+        Key := 0;
+      end;
  end;

  case Key of
@@ -5041,13 +5052,17 @@ var
  mouseCell: TPoint;
  cell: PCell;
  r, c: Cardinal;
+  err: String;
 begin
  if Worksheet = nil then
    exit;

-  mouseCell := MouseToCell(Point(X, Y));
-  if EditorMode then CheckFormula(mouseCell.X, mouseCell.Y, FEditText);
+  if not ValidFormula(FEditText, err) then begin
+    MessageDlg(err, mtError, [mbOK], 0);
+    exit;
+  end;

+  mouseCell := MouseToCell(Point(X, Y));
  if FAllowDragAndDrop and
     (not Assigned(DragManager) or not DragManager.IsDragging) and
     (ssLeft in Shift) and
@@ -5367,27 +5382,16 @@ end;
 function TsCustomWorksheetGrid.SelectCell(ACol, ARow: Integer): Boolean;
 var
  cell: PCell;
-  cp: TsCellprotections;
-  parser: TsSpreadsheetParser;
+  cp: TsCellProtections;
+  err: String;
 begin
  // Checking validity of formula in current cell
  if Assigned(Worksheet) and EditorMode then begin
-    if (FEditText <> '') and (FEditText[1] = '=') then begin
-      parser := TsSpreadsheetParser.Create(Worksheet);
-      try
-        try
-          parser.LocalizedExpression[Workbook.FormatSettings] := FEditText;
-        except
-          on E:Exception do begin
-            FGridState := gsNormal;
-            MessageDlg(E.Message, mtError, [mbOK], 0);
-            Result := false;
-            exit;
-          end;
-        end;
-      finally
-        parser.Free;
-      end;
+    if not ValidFormula(FEditText, err) then begin
+      FGridState := gsNormal;
+      MessageDlg(err, mtError, [mbOK], 0);
+      Result := false;
+      exit;
    end;
  end;

@@ -7056,6 +7060,31 @@ begin
  end;
 end;

+function TsCustomWorksheetGrid.ValidFormula(//ACol, ARow: Integer;
+  AExpression: String; out AErrMsg: String): Boolean;
+var
+  parser: TsSpreadsheetParser;
+begin
+  Result := true;
+  if Assigned(Worksheet) and (AExpression <> '') and (AExpression[1] = '=') then
+  begin
+    parser := TsSpreadsheetParser.Create(Worksheet);
+    try
+      try
+        parser.Expression := AExpression;
+      except
+        on E: Exception do begin
+          AErrMsg := E.Message;
+          Result := false;
+        end;
+      end;
+    finally
+      parser.Free;
+    end;
+  end;
+end;
+
+

 initialization
  {$I ../../resource/fpsvisual.lrs}  // contains the DragCopy cursor