paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpspreadsheet: Support defined names in xlsx files. No formula support so far.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9397 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2024-07-24 13:20:11 +00:00
parent 00217483a3
commit 19e94158df
5 changed files with 215 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

120
components/fpspreadsheet/source/common/fpsclasses.pas
View File

@ -5,7 +5,7 @@ unit fpsClasses;
interface
uses
Classes, SysUtils, avglvltree,
Classes, SysUtils, contnrs, avglvltree,
fpstypes, fpsExprParser;
type
@ -222,6 +222,34 @@ type
property Items[AIndex: Integer]: PsCellFormat read GetItem write SetItem; default;
end;
{ TsDefinedName }
TsDefinedName = class
private
FName: String;
FRange: TsCellRange;
FSheet1, FSheet2: String;
public
procedure CopyFrom(AItem: TsDefinedName);
function RangeAsString: 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;
end;
{ TsDefinedNames }
TsDefinedNames = class(TFPObjectList)
private
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 DuplicateName(AName: String): Boolean;
function FindIndexOfName(AName: String): Integer;
property Items[AIndex: Integer]: TsDefinedName read GetItem write SetItem; default;
end;
{ TsIntegerStack }
TsIntegerStack = class
private
@ -1807,6 +1835,96 @@ begin
end;
{==============================================================================}
{ TsDefinedName }
{==============================================================================}
procedure TsDefinedName.CopyFrom(AItem: TsDefinedName);
begin
if AItem <> nil then
begin
FName := AItem.Name;
FSheet1 := AItem.SheetName1;
FSheet2 := AItem.SheetName2;
FRange := AItem.Range;
end;
end;
function TsDefinedName.RangeAsString: String;
begin
Result := GetCellRangeString(FSheet1, FSheet2, FRange.Row1, FRange.Col1, FRange.Row2, FRange.Col2, [], true);
end;
{==============================================================================}
{ TsDefinedNames }
{==============================================================================}
{ 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;
var
item: TsDefinedName;
begin
if DuplicateName(AName) then
Result := -1
else
begin
item := TsDefinedName.Create;
item.FName := AName;
item.FRange := Range(ARow, ACol);
item.FSheet1 := ASheetName;
item.FSheet2 := ASheetName;
Result := Add(item);
end;
end;
function TsDefinedNames.Add(AName: String; ASheetName1, ASheetName2: String;
ARow1, ACol1, ARow2, ACol2: Cardinal): Integer;
var
item: TsDefinedName;
begin
if DuplicateName(AName) then
Result := -1
else
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;
Result := Add(item);
end;
end;
function TsDefinedNames.DuplicateName(AName: String): Boolean;
begin
Result := FindIndexOfName(AName) <> -1;
end;
function TsDefinedNames.FindIndexOfName(AName: String): Integer;
begin
for Result := 0 to Count-1 do
if SameText(Items[Result].Name, AName) then
exit;
Result := -1;
end;
function TsDefinedNames.GetItem(AIndex: Integer): TsDefinedName;
begin
Result := TsDefinedName(inherited Items[AIndex]);
end;
procedure TsDefinedNames.SetItem(AIndex: Integer; AValue: TsDefinedName);
begin
TsDefinedName(inherited Items[AIndex]).CopyFrom(AValue);
end;
{==============================================================================}
{ TsIntegerStack }
{==============================================================================}

52
components/fpspreadsheet/source/common/fpsexprparser.pas
View File

@ -789,6 +789,7 @@ type
TsSpreadsheetParser = class(TsExpressionParser)
public
constructor Create(AWorksheet: TsBasicWorksheet); override;
procedure AddDefinedNames;
end;
@ -893,7 +894,7 @@ implementation
uses
typinfo, math, lazutf8, dateutils,
fpsutils, fpsfunc, fpsStrings, fpspreadsheet;
fpsutils, fpsfunc, fpsStrings, fpsClasses, fpspreadsheet;
const
cNull = #0;
@ -2413,6 +2414,55 @@ begin
BuiltIns := AllBuiltIns;
end;
procedure TsSpreadsheetParser.AddDefinedNames;
var
i: Integer;
book: TsWorkbook;
sheet, sheet1, sheet2: TsWorksheet;
cell: PCell;
r, c: Cardinal;
defName: TsDefinedName;
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);
if (sheet1 <> sheet2) then
begin
book.AddErrorMsg('3D ranges are not supported in defined names.');
exit;
end;
if (defName.Range.Row1 = defName.Range.Row2) then
begin
r := defName.Range.Row1;
if (defName.Range.Col2 = defName.Range.Col1+1) then
c := defName.Range.Col2
else if (defName.Range.Col2 = defName.Range.Col1) then
c := defName.Range.Col1
else
c := Cardinal(-1);
end else
r := Cardinal(-1);
if (r = cardinal(-1)) or (c = cardinal(-1)) then
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;
end;
}
end;
{------------------------------------------------------------------------------}
{ TsExprIdentifierDefs }

19
components/fpspreadsheet/source/common/fpspreadsheet.pas
View File

@ -767,6 +767,7 @@ type
FBuiltinFontCount: Integer;
FReadWriteFlag: TsReadWriteFlag;
FCalculationLock: Integer;
FDefinedNames: TsDefinedNames;
FDeleteFormulaLock: Integer;
FNotificationLock: Integer;
FRebuildFormulaLock: Integer;
@ -961,6 +962,9 @@ type
property CryptoInfo: TsCryptoInfo read FCryptoInfo write FCryptoInfo;
{property RevisionsCrypto: TsCryptoInfo read FRevisionsCrypto write FRevisionsCrypto;}
{ Globally defined names }
property DefinedNames: TsDefinedNames read FDefinedNames write FDefinedNames;
{@@ Workbook metadata}
property MetaData: TsMetaData read FMetaData write FMetaData;
@ -1340,10 +1344,12 @@ end;
procedure TsWorksheet.CalcFormula(AFormula: PsFormula);
var
lCell, lCellRef: PCell;
parser: TsExpressionParser = nil;
parser: TsSpreadsheetParser = nil;
res: TsExpressionResult;
p: Integer;
link, txt: String;
i: Integer;
defName: TsDefinedName;
begin
if (boIgnoreFormulas in Workbook.Options) or (AFormula = nil) then
exit;
@ -1355,6 +1361,7 @@ begin
if AFormula^.Parser = nil then begin
parser := TsSpreadsheetParser.Create(self);
try
parser.AddDefinedNames;
parser.Expression[fdExcelA1] := AFormula^.Text;
AFormula^.Parser := parser;
except
@ -5074,7 +5081,7 @@ end;
procedure TsWorksheet.WriteFormula(ACell: PCell; AFormula: String;
ALocalized: Boolean = false; R1C1Mode: Boolean = false);
var
parser: TsExpressionParser = nil;
parser: TsSpreadsheetParser = nil;
formula: PsFormula;
begin
if ACell = nil then
@ -5096,6 +5103,7 @@ begin
begin
parser := TsSpreadsheetParser.Create(self);
try
parser.AddDefinedNames;
if ALocalized then
parser.Expression[fdLocalized] := AFormula
else
@ -6615,6 +6623,9 @@ begin
InitFormatRecord(fmt);
AddCellFormat(fmt);
// Globally defined names
FDefinedNames := TsDefinedNames.Create;
// Protection
InitCryptoInfo(FCryptoInfo);
@ -6632,6 +6643,7 @@ begin
EnableNotifications;
FWorksheets.Free;
FDefinedNames.Free;
FMetaData.Free;
FConditionalFormatList.Free;
FCellFormatList.Free;
@ -6669,6 +6681,9 @@ begin
// Remove embedded images
RemoveAllEmbeddedObj;
// Remove defined names
FDefinedNames.Clear;
// Reset cryptoinfo
InitCryptoInfo(FCryptoInfo);

1
components/fpspreadsheet/source/common/fpsutils.pas
View File

@ -2960,6 +2960,7 @@ end;
{@@ ----------------------------------------------------------------------------
Creates a @link(TsCellRange) record from the coordinates of a single cell.
The second corner coordinates are set equal to the first corner coordinates.
-------------------------------------------------------------------------------}
function Range(ARow, ACol: Cardinal): TsCellRange;
begin

31
components/fpspreadsheet/source/common/xlsxooxml.pas
View File

@ -2369,15 +2369,20 @@ var
node: TDOMNode;
nodeName: String;
r1,c1,r2,c2: Cardinal;
flags: TsRelFlags;
id, j, p: Integer;
book: TsWorkbook;
sheet: TsWorksheet;
localSheetID: String;
namestr: String;
s, sheetname: String;
s, sheetname1, sheetName2: String;
L: TStringList;
begin
if ANode = nil then
exit;
book := TsWorkbook(FWorkbook);
node := ANode.FirstChild;
while node <> nil do begin
nodename := node.NodeName;
@ -2417,8 +2422,8 @@ begin
FWorkbook.AddErrorMsg('invalid cell range reference in "definedName" node');
break;
end;
ParseSheetCellString(Copy(s, 1, p-1), sheetname, r1, c1);
ParseSheetCellString(Copy(s, p+1, MaxInt), sheetname, r2, c2);
ParseSheetCellString(Copy(s, 1, p-1), sheetname1, r1, c1);
ParseSheetCellString(Copy(s, p+1, MaxInt), sheetname2, r2, c2);
sheet.PageLayout.AddPrintRange(r1, c1, r2, c2);
end;
finally
@ -2460,6 +2465,11 @@ begin
L.Free;
end;
end;
// "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);
end;
node := node.NextSibling;
end;
@ -7527,14 +7537,27 @@ end;
procedure TsSpreadOOXMLWriter.WriteDefinedNames(AStream: TStream);
var
book: TsWorkbook;
sheet: TsWorksheet;
stotal, srng, sheetname: String;
i, j: Integer;
prng: TsCellRange;
firstIndex, lastIndex: Integer;
defName: TsDefinedName;
begin
stotal := '';
// Write global defined names
book := TsWorkbook(FWorkbook);
for i := 0 to book.DefinedNames.Count-1 do
begin
defName := book.DefinedNames[i];
sTotal := sTotal + Format('<definedName name="%s">%s</definedName>',
[ defName.Name, defName.RangeAsString ]
);
end;
// Write print ranges and repeatedly printed rows and columns
for i := 0 to (Workbook as TsWorkbook).GetWorksheetCount-1 do
begin
@ -7587,7 +7610,7 @@ begin
// Write to stream if any defined names exist
if stotal <> '' then
AppendtoStream(AStream,
AppendToStream(AStream,
'<definedNames>' + stotal + '</definedNames>');
end;