From a7620227c6d1e427b6003ea35a38a4401e5ae251 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Wed, 24 Jul 2024 22:29:17 +0000 Subject: [PATCH] fpspreadsheet: Formula support for defined names. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9399 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../source/common/fpsclasses.pas | 67 +++++++++------- .../source/common/fpsexprparser.pas | 79 +++++++++++++++---- .../source/common/fpsopendocument.pas | 22 +++++- .../fpspreadsheet/source/common/fpsutils.pas | 20 ++++- .../fpspreadsheet/source/common/xlsxooxml.pas | 13 ++- 5 files changed, 149 insertions(+), 52 deletions(-) diff --git a/components/fpspreadsheet/source/common/fpsclasses.pas b/components/fpspreadsheet/source/common/fpsclasses.pas index aa435bfc2..fa6f31332 100644 --- a/components/fpspreadsheet/source/common/fpsclasses.pas +++ b/components/fpspreadsheet/source/common/fpsclasses.pas @@ -6,7 +6,7 @@ interface uses Classes, SysUtils, contnrs, avglvltree, - fpstypes, fpsExprParser; + fpsTypes, fpsExprParser; type { forward declarations } @@ -226,16 +226,13 @@ type TsDefinedName = class private FName: String; - FRange: TsCellRange; - FSheet1, FSheet2: String; + FRange: TsCellRange3D; public procedure CopyFrom(AItem: TsDefinedName); - function RangeAsString: String; - function RangeAsString_ODS: String; + function RangeAsString(AWorkbook: TsBasicWorkbook): String; + function RangeAsString_ODS(AWorkbook: TsBasicWorkbook): String; property Name: String read FName; - property Range: TsCellRange read FRange write FRange; - property SheetName1: String read FSheet1 write FSheet1; - property SheetName2: String read FSheet2 write FSheet2; + property Range: TsCellRange3D read FRange write FRange; end; { TsDefinedNames } @@ -244,8 +241,8 @@ type function GetItem(AIndex: Integer): TsDefinedName; procedure SetItem(AIndex: Integer; AValue: TsDefinedName); public - function Add(AName: String; ASheetName: String; ARow, ACol: Cardinal): Integer; overload; - function Add(AName: String; ASheetName1, ASheetName2: String; ARow1, ACol1, ARow2, ACol2: Cardinal): Integer; overload; + function Add(AName: String; ASheetIndex: Integer; ARow, ACol: Cardinal): Integer; overload; + function Add(AName: String; ASheetIndex1, ASheetIndex2: Integer; ARow1, ACol1, ARow2, ACol2: Cardinal): Integer; overload; function DuplicateName(AName: String): Boolean; function FindIndexOfName(AName: String): Integer; property Items[AIndex: Integer]: TsDefinedName read GetItem write SetItem; default; @@ -268,7 +265,7 @@ implementation uses Math, - fpsUtils; + fpsUtils, fpSpreadsheet; { Helper function for sorting } @@ -1845,24 +1842,42 @@ begin if AItem <> nil then begin FName := AItem.Name; - FSheet1 := AItem.SheetName1; - FSheet2 := AItem.SheetName2; FRange := AItem.Range; end; end; // Test!$C$3 -function TsDefinedName.RangeAsString: String; +function TsDefinedName.RangeAsString(AWorkbook: TsBasicWorkbook): String; +var + book: TsWorkbook; + sh1, sh2: TsWorksheet; begin - Result := GetCellRangeString(FSheet1, FSheet2, FRange.Row1, FRange.Col1, FRange.Row2, FRange.Col2, [], true); + book := TsWorkbook(AWorkbook); + with FRange do + begin + sh1 := book.GetWorksheetByIndex(Sheet1); + sh2 := book.GetWorksheetByIndex(Sheet2); + Result := GetCellRangeString(sh1.Name, sh2.Name, Row1, Col1, Row2, Col2, [], true); + end; end; // $Test.$C$3 -function TsDefinedName.RangeAsString_ODS: String; +function TsDefinedName.RangeAsString_ODS(AWorkBook: TsBasicWorkbook): String; +var + book: TsWorkbook; + sh1, sh2: TsWorksheet; begin - Result := Format('$%s.%s', [FSheet1, GetCellString(FRange.Row1, FRange.Col1, [])]); - if (FSheet1 <> FSheet2) or (FRange.Row1 <> FRange.Row2) or (FRange.Col1 <> FRange.Col2) then - Result := Format('%s:$%s.%s', [Result, FSheet2, GetCellString(FRange.Row2, FRange.Col2, [])]); + book := TsWorkbook(AWorkbook); + with FRange do + begin + sh1 := book.GetWorksheetByIndex(Sheet1); + Result := Format('$%s.%s', [sh1.Name, GetCellString(Row1, Col1, [])]); + if (Sheet1 <> Sheet2) or (Row1 <> Row2) or (Col1 <> Col2) then + begin + sh2 := book.GetWorksheetByIndex(Sheet2); + Result := Format('%s:$%s.%s', [Result, sh2.Name, GetCellString(Row2, Col2, [])]); + end; + end; end; {==============================================================================} @@ -1871,8 +1886,7 @@ end; { Adds the named cell to the list and returns the list index. AName must be unique; if not, the return value is -1. } -function TsDefinedNames.Add(AName: String; ASheetName: String; - ARow, ACol: Cardinal): Integer; +function TsDefinedNames.Add(AName: String; ASheetIndex: Integer; ARow, ACol: Cardinal): Integer; var item: TsDefinedName; begin @@ -1882,14 +1896,12 @@ begin begin item := TsDefinedName.Create; item.FName := AName; - item.FRange := Range(ARow, ACol); - item.FSheet1 := ASheetName; - item.FSheet2 := ASheetName; + item.FRange := Range3D(ASheetIndex, ASheetIndex, ARow, ACol, ARow, ACol); Result := Add(item); end; end; -function TsDefinedNames.Add(AName: String; ASheetName1, ASheetName2: String; +function TsDefinedNames.Add(AName: String; ASheetIndex1, ASheetIndex2: Integer; ARow1, ACol1, ARow2, ACol2: Cardinal): Integer; var item: TsDefinedName; @@ -1900,12 +1912,9 @@ begin begin if ARow2 = Cardinal(-1) then ARow2 := ARow1; if ACol2 = Cardinal(-1) then ACol2 := ACol1; - if ASheetName2 = '' then ASheetName2 := ASheetName1; item := TsDefinedName.Create; item.FName := AName; - item.FRange := Range(ARow1, ACol1, ARow2, ACol2); - item.FSheet1 := ASheetName1; - item.FSheet2 := ASheetName2; + item.FRange := Range3D(ASheetIndex1, ASheetIndex2, ARow1, ACol1, ARow2, ACol2); Result := Add(item); end; end; diff --git a/components/fpspreadsheet/source/common/fpsexprparser.pas b/components/fpspreadsheet/source/common/fpsexprparser.pas index 6b37f1c76..35af59b02 100644 --- a/components/fpspreadsheet/source/common/fpsexprparser.pas +++ b/components/fpspreadsheet/source/common/fpsexprparser.pas @@ -395,6 +395,7 @@ type FOnGetValue: TsExprFunctionEvent; FOnGetValueCB: TsExprFunctionCallBack; function GetAsBoolean: Boolean; + function GetAsCellRange: TsCellRange3D; function GetAsDateTime: TDateTime; function GetAsFloat: TsExprFloat; function GetAsInteger: Int64; @@ -403,6 +404,7 @@ type function GetValue: String; procedure SetArgumentTypes(const AValue: String); procedure SetAsBoolean(const AValue: Boolean); + procedure SetAsCellRange(const AValue: TsCellRange3D); procedure SetAsDateTime(const AValue: TDateTime); procedure SetAsFloat(const AValue: TsExprFloat); procedure SetAsInteger(const AValue: Int64); @@ -470,6 +472,8 @@ type AValue: String): TsExprIdentifierDef; function AddBooleanVariable(const AName: ShortString; AValue: Boolean): TsExprIdentifierDef; + function AddCellRangeVariable(const AName: ShortString; + AValue: TsCellRange3D): TsExprIdentifierDef; function AddIntegerVariable(const AName: ShortString; AValue: Integer): TsExprIdentifierDef; function AddFloatVariable(const AName: ShortString; @@ -2419,18 +2423,17 @@ var i: Integer; book: TsWorkbook; sheet, sheet1, sheet2: TsWorksheet; - cell: PCell; r, c: Cardinal; defName: TsDefinedName; + rng: TsCellRange3D; begin - { sheet := TsWorksheet(FWorksheet); book := TsWorkbook(sheet.Workbook); for i := 0 to book.DefinedNames.Count-1 do begin defName := book.DefinedNames[i]; - sheet1 := book.GetWorksheetByName(defName.SheetName1); - sheet2 := book.GetWorksheetByName(defName.SheetName2); + sheet1 := book.GetWorksheetByIndex(defName.Range.Sheet1); + sheet2 := book.GetWorksheetByIndex(defName.Range.Sheet2); if (sheet1 <> sheet2) then begin book.AddErrorMsg('3D ranges are not supported in defined names.'); @@ -2452,16 +2455,9 @@ begin book.AddErrorMsg('Defined name "' + defName.Name + '" too complex.'); exit; end; - cell := sheet1.FindCell(r, c); - case cell^.ContentType of - cctNumber: Identifiers.AddFloatVariable(defName.Name, cell^.NumberValue); - cctDateTime: Identifiers.AddDateTimeVariable(defName.Name, cell^.DateTimeValue); - cctUTF8String: Identifiers.AddStringVariable(defName.Name, cell^.UTF8StringValue); - cctBool: Identifiers.AddBooleanVariable(defName.Name, cell^.BoolValue); - cctError: ; - end; + rng := Range3D(defName.Range.Sheet1, defName.Range.Sheet2, r, c, r, c); + Identifiers.AddCellRangeVariable(defName.Name, rng); end; - } end; {------------------------------------------------------------------------------} @@ -2478,6 +2474,17 @@ begin Result.FValue.ResBoolean := AValue; end; +// Needed for defined names. +function TsExprIdentifierDefs.AddCellRangeVariable(const AName: ShortString; + AValue: TsCellRange3D): TsExprIdentifierDef; +begin + Result := Add as TsExprIdentifierDef; + Result.IdentifierType := itVariable; + Result.Name := AName; + Result.ResultType := rtCellRange; + Result.FValue.ResCellRange := AValue; +end; + function TsExprIdentifierDefs.AddDateTimeVariable(const AName: ShortString; AValue: TDateTime): TsExprIdentifierDef; begin @@ -2686,6 +2693,13 @@ begin Result := FValue.ResBoolean; end; +function TsExprIdentifierDef.GetAsCellRange: TsCellRange3D; +begin + CheckResultType(rtCellRange); + CheckVariable; + Result := FValue.ResCellRange; +end; + function TsExprIdentifierDef.GetAsDateTime: TDateTime; begin CheckResultType(rtDateTime); @@ -2783,6 +2797,13 @@ begin FValue.ResBoolean := AValue; end; +procedure TsExprIdentifierDef.SetAsCellRange(const AValue: TsCellRange3D); +begin + CheckVariable; + CheckResultType(rtCellRange); + FValue.ResCellRange := AValue; +end; + procedure TsExprIdentifierDef.SetAsDateTime(const AValue: TDateTime); begin CheckVariable; @@ -3988,9 +4009,37 @@ begin end; procedure TsIdentifierExprNode.GetNodeValue(out AResult: TsExpressionResult); +var + book: TsWorkbook; + sheet: TsWorksheet; + cell: PCell; begin - AResult := PResult^; - AResult.ResultType := FResultType; + if PResult^.ResultType = rtCellRange then + begin + with PResult^.ResCellRange do + if (Row1 = Row2) and (Col1 = Col2) and (Sheet1 = Sheet2) then + begin + book := TsWorkbook(TsWorksheet(Parser.Worksheet).Workbook); + sheet := book.GetWorksheetByIndex(Sheet1); + cell := sheet.FindCell(Row1, Col1); + if cell <> nil then + case cell^.ContentType of + cctNumber: AResult := FloatResult(cell^.NumberValue); + cctDateTime: AResult := DateTimeResult(cell^.DateTimeValue); + cctUTF8String: AResult := StringResult(cell^.UTF8StringValue); + cctBool: AResult := BooleanResult(cell^.BoolValue); + cctError: AResult := ErrorResult(cell^.ErrorValue); + cctEmpty: AResult := EmptyResult; + end + else + AResult := ErrorResult(errIllegalRef); + end else + AResult := CellRangeResult(PResult^.Worksheet, Sheet1, Sheet2, Row1, Col1, Row2, Col2); + end else + begin + AResult := PResult^; + AResult.ResultType := FResultType; + end; end; diff --git a/components/fpspreadsheet/source/common/fpsopendocument.pas b/components/fpspreadsheet/source/common/fpsopendocument.pas index 95e2cd10b..97ce7fc7a 100644 --- a/components/fpspreadsheet/source/common/fpsopendocument.pas +++ b/components/fpspreadsheet/source/common/fpsopendocument.pas @@ -2638,7 +2638,8 @@ var defName: String; defAddr: String; r1, c1, r2, c2: Cardinal; - sheet1, sheet2: String; + sheetName1, sheetName2: String; + sheetIdx1, sheetIdx2: Integer; flags: TsRelFlags; begin if ANode = nil then @@ -2657,8 +2658,14 @@ begin begin defName := GetAttrValue(ANode, 'table:name'); defAddr := GetAttrValue(ANode, 'table:cell-range-address'); - if TryStrToCellRange_ODS(defAddr, sheet1, sheet2, r1, c1, r2, c2, flags) then - book.DefinedNames.Add(defName, sheet1, sheet2, r1, c1, r2, c2); + if TryStrToCellRange_ODS(defAddr, sheetName1, sheetName2, r1, c1, r2, c2, flags) then + begin + if (sheetName1 <> '') and (sheetName1[1] = '$') then Delete(sheetName1, 1,1); + if (sheetName2 <> '') and (sheetName2[1] = '$') then Delete(sheetName2, 1,1); + sheetIdx1 := book.GetWorksheetIndex(sheetName1); + sheetIdx2 := book.GetWorksheetIndex(sheetName2); + book.DefinedNames.Add(defName, sheetIdx1, sheetIdx2, r1, c1, r2, c2); + end; end; ANode := ANode.NextSibling; end; @@ -8748,13 +8755,20 @@ begin end; function TsSpreadOpenDocWriter.WriteDefinedNameXMLAsString(ADefinedName: TsDefinedName): String; +var + book: TsWorkbook; + sheet1, sheet2: TsWorksheet; begin + book := TsWorkbook(FWorkbook); + sheet1 := book.GetWorksheetByIndex(ADefinedName.Range.Sheet1); + sheet2 := book.GetWorksheetByIndex(ADefinedName.Range.Sheet2); + Result := Format( '', - [ ADefinedName.Name, ADefinedName.SheetName1, ADefinedName.RangeAsString_ODS ] + [ ADefinedName.Name, sheet1.Name, ADefinedName.RangeAsString_ODS(FWorkbook) ] ); end; diff --git a/components/fpspreadsheet/source/common/fpsutils.pas b/components/fpspreadsheet/source/common/fpsutils.pas index bfb3c1744..e6de40ed0 100644 --- a/components/fpspreadsheet/source/common/fpsutils.pas +++ b/components/fpspreadsheet/source/common/fpsutils.pas @@ -250,6 +250,7 @@ function SameFont(AFont: TsFont; AFontName: String; AFontSize: Single; function Range(ARow, ACol: Cardinal): TsCellRange; overload; function Range(ARow1, ACol1, ARow2, ACol2: Cardinal): TsCellRange; overload; +function Range3D(ASheetIdx1, ASheetIdx2: Integer; ARow1, ACol1, ARow2, ACol2: Cardinal): TsCellRange3D; function CellBorderStyle(const AColor: TsColor = scBlack; const ALineStyle: TsLineStyle = lsThin): TsCellBorderStyle; @@ -1370,6 +1371,7 @@ begin else begin ASheet1 := Copy(cell1Str, 1, p-1); + if ASheet1[1] = '$' then Delete(ASheet1, 1, 1); cell1Str := Copy(cell1Str, p+1, MaxInt); end; Result := ParseCellString(cell1Str, ARow1, ACol1, AFlags); @@ -1385,6 +1387,7 @@ begin else begin ASheet2 := Copy(cell2Str, 1, p-1); + if ASheet2[1] = '$' then Delete(ASheet2, 1, 1); cell2Str := Copy(cell2Str, p+1, MaxInt); end; Result := ParseCellString(cell2Str, ARow2, ACol2, f); @@ -1394,7 +1397,7 @@ begin begin ASheet2 := ASheet1; ARow2 := ARow1; - ACol2 := ACol2; + ACol2 := ACol1; if (rfRelRow in AFlags) then Include(AFlags, rfRelRow2); if (rfRelCol in AFlags) then Include(AFlags, rfRelCol2); end; @@ -2997,6 +3000,21 @@ begin end; end; +function Range3D(ASheetIdx1, ASheetIdx2: Integer; + ARow1, ACol1, ARow2, ACol2: Cardinal): TsCellRange3D; +var + rng: TsCellRange; +begin + rng := Range(ARow1, ACol1, ARow2, ACol2); + Result.Row1 := rng.Row1; + Result.Col1 := rng.Col1; + Result.Row2 := rng.Row2; + Result.Col2 := rng.Col2; + Result.Sheet1 := ASheetIdx1; + Result.Sheet2 := ASheetIdx2; +end; + + {@@ ---------------------------------------------------------------------------- Combines the relevant font properties into a string -------------------------------------------------------------------------------} diff --git a/components/fpspreadsheet/source/common/xlsxooxml.pas b/components/fpspreadsheet/source/common/xlsxooxml.pas index 171af3115..a820e5f3b 100644 --- a/components/fpspreadsheet/source/common/xlsxooxml.pas +++ b/components/fpspreadsheet/source/common/xlsxooxml.pas @@ -2376,6 +2376,7 @@ var localSheetID: String; namestr: String; s, sheetname1, sheetName2: String; + sheetIdx1, sheetIdx2: Integer; L: TStringList; begin if ANode = nil then @@ -2469,7 +2470,14 @@ begin // "Normal" defined names s := GetNodeValue(node); if ParseCellRangeString(s, sheetName1, sheetName2, r1, c1, r2, c2, flags) then - book.DefinedNames.Add(nameStr, sheetName1, sheetName2, r1, c1, r2, c2); + begin + if (r2 = UNASSIGNED_ROW_COL_INDEX) then r2 := r1; + if (c2 = UNASSIGNED_ROW_COL_INDEX) then c2 := c1; + if sheetName2 = '' then sheetName2 := sheetName1; + sheetIdx1 := book.GetWorksheetIndex(sheetName1); + sheetIdx2 := book.GetWorksheetIndex(sheetName2); + book.DefinedNames.Add(nameStr, sheetIdx1, sheetIdx2, r1, c1, r2, c2); + end; end; node := node.NextSibling; end; @@ -7553,11 +7561,10 @@ begin begin defName := book.DefinedNames[i]; sTotal := sTotal + Format('%s', - [ defName.Name, defName.RangeAsString ] + [ defName.Name, defName.RangeAsString(FWorkbook) ] ); end; - // Write print ranges and repeatedly printed rows and columns for i := 0 to (Workbook as TsWorkbook).GetWorksheetCount-1 do begin