pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Rearrange units to better avoid circular unit references. General idea: no unit of the package must "use" fpspreadsheet.pas in the interface section.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6444 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-05-22 22:21:15 +00:00
parent 3c79851a8c
commit d5e5df7485
21 changed files with 2276 additions and 1831 deletions
Download Patch File Download Diff File Expand all files Collapse all files

89
components/fpspreadsheet/source/common/fpscell.pas
View File

@ -6,7 +6,7 @@ unit fpsCell;
interface interface
uses uses
Classes, SysUtils, fpstypes, fpspreadsheet; Classes, SysUtils, fpstypes;
type type
TCellHelper = record helper for TCell TCellHelper = record helper for TCell
@ -46,8 +46,7 @@ type
procedure SetWordwrap(const AValue: Boolean); procedure SetWordwrap(const AValue: Boolean);
protected protected
function GetWorkbook: TsWorkbook; inline; function GetWorkbook: TsBasicWorkbook; inline;
function GetWorksheet: TsWorksheet; inline;
public public
property BackgroundColor: TsColor property BackgroundColor: TsColor
@ -83,74 +82,77 @@ type
read GetVertAlignment write SetVertAlignment; read GetVertAlignment write SetVertAlignment;
property Wordwrap: Boolean property Wordwrap: Boolean
read GetWordwrap write SetWordwrap; read GetWordwrap write SetWordwrap;
property Workbook: TsWorkbook read GetWorkbook; property Workbook: TsBasicWorkbook read GetWorkbook;
end; end;
implementation implementation
uses
fpspreadsheet;
function TCellHelper.GetBackgroundColor: TsColor; function TCellHelper.GetBackgroundColor: TsColor;
begin begin
Result := GetWorksheet.ReadBackgroundColor(@self); Result := (Worksheet as TsWorksheet).ReadBackgroundColor(@self);
end; end;
function TCellHelper.GetBiDiMode: TsBiDiMode; function TCellHelper.GetBiDiMode: TsBiDiMode;
begin begin
Result := GetWorksheet.ReadBiDiMode(@self); Result := (Worksheet as TsWorksheet).ReadBiDiMode(@self);
end; end;
function TCellHelper.GetBorder: TsCellBorders; function TCellHelper.GetBorder: TsCellBorders;
begin begin
Result := GetWorksheet.ReadCellBorders(@self); Result := (Worksheet as TsWorksheet).ReadCellBorders(@self);
end; end;
function TCellHelper.GetBorderStyle(const ABorder: TsCellBorder): TsCellBorderStyle; function TCellHelper.GetBorderStyle(const ABorder: TsCellBorder): TsCellBorderStyle;
begin begin
Result := GetWorksheet.ReadCellBorderStyle(@self, ABorder); Result := (Worksheet as TsWorksheet).ReadCellBorderStyle(@self, ABorder);
end; end;
function TCellHelper.GetBorderStyles: TsCellBorderStyles; function TCellHelper.GetBorderStyles: TsCellBorderStyles;
begin begin
Result := GetWorksheet.ReadCellBorderStyles(@self); Result := (Worksheet as TsWorksheet).ReadCellBorderStyles(@self);
end; end;
function TCellHelper.GetCellFormat: TsCellFormat; function TCellHelper.GetCellFormat: TsCellFormat;
begin begin
Result := GetWorkbook.GetCellFormat(FormatIndex); Result := (GetWorkbook as TsWorkbook).GetCellFormat(FormatIndex);
end; end;
function TCellHelper.GetComment: String; function TCellHelper.GetComment: String;
begin begin
Result := GetWorksheet.ReadComment(@self); Result := (Worksheet as TsWorksheet).ReadComment(@self);
end; end;
function TCellHelper.GetFont: TsFont; function TCellHelper.GetFont: TsFont;
begin begin
Result := GetWorksheet.ReadCellFont(@self); Result := (Worksheet as TsWorksheet).ReadCellFont(@self);
end; end;
function TCellHelper.GetFontIndex: Integer; function TCellHelper.GetFontIndex: Integer;
var var
fmt: PsCellFormat; fmt: PsCellFormat;
begin begin
fmt := Workbook.GetPointerToCellFormat(FormatIndex); fmt := (Workbook as TsWorkbook).GetPointerToCellFormat(FormatIndex);
Result := fmt^.FontIndex; Result := fmt^.FontIndex;
end; end;
function TCellHelper.GetHorAlignment: TsHorAlignment; function TCellHelper.GetHorAlignment: TsHorAlignment;
begin begin
Result := GetWorksheet.ReadHorAlignment(@Self); Result := (Worksheet as TsWorksheet).ReadHorAlignment(@Self);
end; end;
function TCellHelper.GetHyperlink: TsHyperlink; function TCellHelper.GetHyperlink: TsHyperlink;
begin begin
Result := GetWorksheet.ReadHyperlink(@self); Result := (Worksheet as TsWorksheet).ReadHyperlink(@self);
end; end;
function TCellHelper.GetNumberFormat: TsNumberFormat; function TCellHelper.GetNumberFormat: TsNumberFormat;
var var
fmt: PsCellFormat; fmt: PsCellFormat;
begin begin
fmt := Workbook.GetPointerToCellFormat(FormatIndex); fmt := (Workbook as TsWorkbook).GetPointerToCellFormat(FormatIndex);
Result := fmt^.NumberFormat; Result := fmt^.NumberFormat;
end; end;
@ -158,127 +160,122 @@ function TCellHelper.GetNumberFormatStr: String;
var var
fmt: PsCellFormat; fmt: PsCellFormat;
begin begin
fmt := Workbook.GetPointerToCellFormat(FormatIndex); fmt := (Workbook as TsWorkbook).GetPointerToCellFormat(FormatIndex);
Result := fmt^.NumberFormatStr; Result := fmt^.NumberFormatStr;
end; end;
function TCellHelper.GetTextRotation: TsTextRotation; function TCellHelper.GetTextRotation: TsTextRotation;
begin begin
Result := GetWorksheet.ReadTextRotation(@Self); Result := (Worksheet as TsWorksheet).ReadTextRotation(@Self);
end; end;
function TCellHelper.GetUsedFormattingFields: TsUsedFormattingFields; function TCellHelper.GetUsedFormattingFields: TsUsedFormattingFields;
begin begin
Result := GetWorksheet.ReadUsedFormatting(@Self); Result := (Worksheet as TsWorksheet).ReadUsedFormatting(@Self);
end; end;
function TCellHelper.GetVertAlignment: TsVertAlignment; function TCellHelper.GetVertAlignment: TsVertAlignment;
begin begin
Result := GetWorksheet.ReadVertAlignment(@self); Result := (Worksheet as TsWorksheet).ReadVertAlignment(@self);
end; end;
function TCellHelper.GetWordwrap: Boolean; function TCellHelper.GetWordwrap: Boolean;
begin begin
Result := GetWorksheet.ReadWordwrap(@self); Result := (Worksheet as TsWorksheet).ReadWordwrap(@self);
end; end;
function TCellHelper.GetWorkbook: TsWorkbook; function TCellHelper.GetWorkbook: TsBasicWorkbook;
begin begin
Result := GetWorksheet.Workbook; Result := (Worksheet as TsWorksheet).Workbook;
end;
function TCellHelper.GetWorksheet: TsWorksheet;
begin
Result := TsWorksheet(Worksheet);
end; end;
procedure TCellHelper.SetBackgroundColor(const AValue: TsColor); procedure TCellHelper.SetBackgroundColor(const AValue: TsColor);
begin begin
GetWorksheet.WriteBackgroundColor(@self, AValue); (Worksheet as TsWorksheet).WriteBackgroundColor(@self, AValue);
end; end;
procedure TCellHelper.SetBiDiMode(const AValue: TsBiDiMode); procedure TCellHelper.SetBiDiMode(const AValue: TsBiDiMode);
begin begin
GetWorksheet.WriteBiDiMode(@self, AValue); (Worksheet as TsWorksheet).WriteBiDiMode(@self, AValue);
end; end;
procedure TCellHelper.SetBorder(const AValue: TsCellBorders); procedure TCellHelper.SetBorder(const AValue: TsCellBorders);
begin begin
GetWorksheet.WriteBorders(@self, AValue); (Worksheet as TsWorksheet).WriteBorders(@self, AValue);
end; end;
procedure TCellHelper.SetBorderStyle(const ABorder: TsCellBorder; procedure TCellHelper.SetBorderStyle(const ABorder: TsCellBorder;
const AValue: TsCellBorderStyle); const AValue: TsCellBorderStyle);
begin begin
GetWorksheet.WriteBorderStyle(@self, ABorder, AValue); (Worksheet as TsWorksheet).WriteBorderStyle(@self, ABorder, AValue);
end; end;
procedure TCellHelper.SetBorderStyles(const AValue: TsCellBorderStyles); procedure TCellHelper.SetBorderStyles(const AValue: TsCellBorderStyles);
begin begin
GetWorksheet.WriteBorderStyles(@self, AValue); (Worksheet as TsWorksheet).WriteBorderStyles(@self, AValue);
end; end;
procedure TCellHelper.SetCellFormat(const AValue: TsCellFormat); procedure TCellHelper.SetCellFormat(const AValue: TsCellFormat);
begin begin
GetWorksheet.WriteCellFormat(@self, AValue); (Worksheet as TsWorksheet).WriteCellFormat(@self, AValue);
end; end;
procedure TCellHelper.SetComment(const AValue: String); procedure TCellHelper.SetComment(const AValue: String);
begin begin
GetWorksheet.WriteComment(@self, AValue); (Worksheet as TsWorksheet).WriteComment(@self, AValue);
end; end;
procedure TCellHelper.SetFontIndex(const AValue: Integer); procedure TCellHelper.SetFontIndex(const AValue: Integer);
begin begin
GetWorksheet.WriteFont(@self, AValue); (Worksheet as TsWorksheet).WriteFont(@self, AValue);
end; end;
procedure TCellHelper.SetHorAlignment(const AValue: TsHorAlignment); procedure TCellHelper.SetHorAlignment(const AValue: TsHorAlignment);
begin begin
GetWorksheet.WriteHorAlignment(@self, AValue); (Worksheet as TsWorksheet).WriteHorAlignment(@self, AValue);
end; end;
procedure TCellHelper.SetHyperlink(const AValue: TsHyperlink); procedure TCellHelper.SetHyperlink(const AValue: TsHyperlink);
begin begin
GetWorksheet.WriteHyperlink(@self, AValue.Target, AValue.Tooltip); (Worksheet as TsWorksheet).WriteHyperlink(@self, AValue.Target, AValue.Tooltip);
end; end;
procedure TCellHelper.SetNumberFormat(const AValue: TsNumberFormat); procedure TCellHelper.SetNumberFormat(const AValue: TsNumberFormat);
var var
fmt: TsCellFormat; fmt: TsCellFormat;
begin begin
fmt := Workbook.GetCellFormat(FormatIndex); fmt := (Workbook as TsWorkbook).GetCellFormat(FormatIndex);
fmt.NumberFormat := AValue; fmt.NumberFormat := AValue;
GetWorksheet.WriteCellFormat(@self, fmt); (Worksheet as TsWorksheet).WriteCellFormat(@self, fmt);
end; end;
procedure TCellHelper.SetNumberFormatStr(const AValue: String); procedure TCellHelper.SetNumberFormatStr(const AValue: String);
var var
fmt: TsCellFormat; fmt: TsCellFormat;
begin begin
fmt := Workbook.GetCellFormat(FormatIndex); fmt := (Workbook as TsWorkbook).GetCellFormat(FormatIndex);
fmt.NumberFormatStr := AValue; fmt.NumberFormatStr := AValue;
GetWorksheet.WriteCellFormat(@self, fmt); (Worksheet as TsWorksheet).WriteCellFormat(@self, fmt);
end; end;
procedure TCellHelper.SetTextRotation(const AValue: TsTextRotation); procedure TCellHelper.SetTextRotation(const AValue: TsTextRotation);
begin begin
GetWorksheet.WriteTextRotation(@self, AValue); (Worksheet as TsWorksheet).WriteTextRotation(@self, AValue);
end; end;
procedure TCellHelper.SetUsedFormattingFields(const AValue: TsUsedFormattingFields); procedure TCellHelper.SetUsedFormattingFields(const AValue: TsUsedFormattingFields);
begin begin
GetWorksheet.WriteUsedFormatting(@self, AValue); (Worksheet as TsWorksheet).WriteUsedFormatting(@self, AValue);
end; end;
procedure TCellHelper.SetVertAlignment(const AValue: TsVertAlignment); procedure TCellHelper.SetVertAlignment(const AValue: TsVertAlignment);
begin begin
GetWorksheet.WriteVertAlignment(@self, AValue); (Worksheet as TsWorksheet).WriteVertAlignment(@self, AValue);
end; end;
procedure TCellHelper.SetWordwrap(const AValue: Boolean); procedure TCellHelper.SetWordwrap(const AValue: Boolean);
begin begin
GetWorksheet.WriteWordwrap(@self, AValue); (Worksheet as TsWorksheet).WriteWordwrap(@self, AValue);
end; end;

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

@ -76,12 +76,12 @@ type
TsCells = class(TsRowColAVLTree) TsCells = class(TsRowColAVLTree)
private private
FWorksheet: Pointer; // Must be cast to TsWorksheet FWorksheet: TsBasicWorksheet; // Must be cast to TsWorksheet
protected protected
procedure DisposeData(var AData: Pointer); override; procedure DisposeData(var AData: Pointer); override;
function NewData: Pointer; override; function NewData: Pointer; override;
public public
constructor Create(AWorksheet: Pointer; AOwnsData: Boolean = true); constructor Create(AWorksheet: TsBasicWorksheet; AOwnsData: Boolean = true);
function AddCell(ARow, ACol: Cardinal): PCell; function AddCell(ARow, ACol: Cardinal): PCell;
procedure DeleteCell(ARow, ACol: Cardinal); procedure DeleteCell(ARow, ACol: Cardinal);
function FindCell(ARow, ACol: Cardinal): PCell; function FindCell(ARow, ACol: Cardinal): PCell;
@ -689,7 +689,8 @@ end;
{ TsCells: an AVLTree to store spreadsheet cells } { TsCells: an AVLTree to store spreadsheet cells }
{==============================================================================} {==============================================================================}
constructor TsCells.Create(AWorksheet: Pointer; AOwnsData: Boolean = true); constructor TsCells.Create(AWorksheet: TsBasicWorksheet;
AOwnsData: Boolean = true);
begin begin
inherited Create(AOwnsData); inherited Create(AOwnsData);
FWorksheet := AWorksheet; FWorksheet := AWorksheet;

56
components/fpspreadsheet/source/common/fpscsv.pas
View File

@ -6,7 +6,7 @@ interface
uses uses
Classes, SysUtils, Classes, SysUtils,
fpstypes, fpspreadsheet, fpsReaderWriter, fpsCsvDocument; fpstypes, fpsReaderWriter, fpsCsvDocument;
type type
TsCSVReader = class(TsCustomSpreadReader) TsCSVReader = class(TsCustomSpreadReader)
@ -21,7 +21,7 @@ type
procedure ReadLabel(AStream: TStream); override; procedure ReadLabel(AStream: TStream); override;
procedure ReadNumber(AStream: TStream); override; procedure ReadNumber(AStream: TStream); override;
public public
constructor Create(AWorkbook: TsWorkbook); override; constructor Create(AWorkbook: TsBasicWorkbook); override;
procedure ReadFromFile(AFileName: String; APassword: String = ''; procedure ReadFromFile(AFileName: String; APassword: String = '';
AParams: TsStreamParams = []); override; AParams: TsStreamParams = []); override;
procedure ReadFromStream(AStream: TStream; APassword: String = ''; procedure ReadFromStream(AStream: TStream; APassword: String = '';
@ -48,10 +48,10 @@ type
const AValue: string; ACell: PCell); override; const AValue: string; ACell: PCell); override;
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: double; ACell: PCell); override; const AValue: double; ACell: PCell); override;
procedure WriteSheet(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteSheet(AStream: TStream; AWorksheet: TsBasicWorksheet);
public public
constructor Create(AWorkbook: TsWorkbook); override; constructor Create(AWorkbook: TsBasicWorkbook); override;
procedure WriteToStream(AStream: TStream; AParams: TsStreamParams = []); override; procedure WriteToStream(AStream: TStream; AParams: TsStreamParams = []); override;
procedure WriteToStrings(AStrings: TStrings; AParams: TsStreamParams = []); override; procedure WriteToStrings(AStrings: TStrings; AParams: TsStreamParams = []); override;
end; end;
@ -95,7 +95,7 @@ implementation
uses uses
DateUtils, LConvEncoding, Math, DateUtils, LConvEncoding, Math,
fpsUtils, fpsNumFormat; fpsUtils, fpspreadsheet, fpsNumFormat;
const const
DEFAULT_ENCODING = 'utf8'; //'utf8bom'; DEFAULT_ENCODING = 'utf8'; //'utf8bom';
@ -115,7 +115,7 @@ end;
{ TsCSVReader } { TsCSVReader }
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
constructor TsCSVReader.Create(AWorkbook: TsWorkbook); constructor TsCSVReader.Create(AWorkbook: TsBasicWorkbook);
begin begin
inherited Create(AWorkbook); inherited Create(AWorkbook);
FWorksheetName := 'Sheet1'; // will be replaced by filename FWorksheetName := 'Sheet1'; // will be replaced by filename
@ -148,29 +148,32 @@ procedure TsCSVReader.ReadCellValue(ARow, ACol: Cardinal; AText: String);
var var
cell: PCell; cell: PCell;
boolValue: Boolean; boolValue: Boolean;
sheet: TsWorksheet;
begin begin
// Empty strings are blank cells -- nothing to do // Empty strings are blank cells -- nothing to do
if AText = '' then if AText = '' then
exit; exit;
cell := FWorksheet.AddCell(ARow, ACol); sheet := FWorksheet as TsWorksheet;
cell := sheet.AddCell(ARow, ACol);
// Do not try to interpret the strings. --> everything is a LABEL cell. // Do not try to interpret the strings. --> everything is a LABEL cell.
if not CSVParams.DetectContentType then if not CSVParams.DetectContentType then
begin begin
FWorksheet.WriteText(cell, AText); sheet.WriteText(cell, AText);
exit; exit;
end; end;
// Check for a BOOLEAN cell // Check for a BOOLEAN cell
if IsBoolValue(AText, CSVParams.TrueText, CSVParams.FalseText, boolValue) then if IsBoolValue(AText, CSVParams.TrueText, CSVParams.FalseText, boolValue) then
begin begin
FWorksheet.WriteBoolValue(cell, boolValue); sheet.WriteBoolValue(cell, boolValue);
exit; exit;
end; end;
// All other cases are handled by WriteCellValusAsString // All other cases are handled by WriteCellValusAsString
FWorksheet.WriteCellValueAsString(cell, AText, FFormatSettings); sheet.WriteCellValueAsString(cell, AText, FFormatSettings);
end; end;
procedure TsCSVReader.ReadFormula(AStream: TStream); procedure TsCSVReader.ReadFormula(AStream: TStream);
@ -205,7 +208,7 @@ begin
encoding := DEFAULT_ENCODING; encoding := DEFAULT_ENCODING;
// Create worksheet // Create worksheet
FWorksheet := FWorkbook.AddWorksheet(FWorksheetName, true); FWorksheet := (FWorkbook as TsWorkbook).AddWorksheet(FWorksheetName, true);
// Create csv parser, read file and store in worksheet // Create csv parser, read file and store in worksheet
Parser := TCSVParser.Create; Parser := TCSVParser.Create;
@ -255,7 +258,7 @@ end;
{ TsCSVWriter } { TsCSVWriter }
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
constructor TsCSVWriter.Create(AWorkbook: TsWorkbook); constructor TsCSVWriter.Create(AWorkbook: TsBasicWorkbook);
begin begin
inherited Create(AWorkbook); inherited Create(AWorkbook);
FFormatSettings := CSVParams.FormatSettings; FFormatSettings := CSVParams.FormatSettings;
@ -298,7 +301,7 @@ var
begin begin
Unused(AStream); Unused(AStream);
Unused(ARow, ACol, AValue); Unused(ARow, ACol, AValue);
s := FWorksheet.ReadAsText(ACell); s := (FWorksheet as TsWorksheet).ReadAsText(ACell);
s := ConvertEncoding(s, EncodingUTF8, FEncoding); s := ConvertEncoding(s, EncodingUTF8, FEncoding);
FCSVBuilder.AppendCell(s); FCSVBuilder.AppendCell(s);
end; end;
@ -349,20 +352,22 @@ begin
if CSVParams.NumberFormat <> '' then if CSVParams.NumberFormat <> '' then
s := Format(CSVParams.NumberFormat, [AValue], FFormatSettings) s := Format(CSVParams.NumberFormat, [AValue], FFormatSettings)
else else
s := FWorksheet.ReadAsText(ACell, FFormatSettings); s := (FWorksheet as TsWorksheet).ReadAsText(ACell, FFormatSettings);
s := ConvertEncoding(s, EncodingUTF8, FEncoding); s := ConvertEncoding(s, EncodingUTF8, FEncoding);
FCSVBuilder.AppendCell(s); FCSVBuilder.AppendCell(s);
end; end;
procedure TsCSVWriter.WriteSheet(AStream: TStream; AWorksheet: TsWorksheet); procedure TsCSVWriter.WriteSheet(AStream: TStream; AWorksheet: TsBasicWorksheet);
var var
r, c: Cardinal; r, c: Cardinal;
firstRow, lastRow: Cardinal; firstRow, lastRow: Cardinal;
firstCol, lastCol: Cardinal; firstCol, lastCol: Cardinal;
cell: PCell; cell: PCell;
n: Integer; n: Integer;
sheet: TsWorksheet;
begin begin
FWorksheet := AWorksheet; FWorksheet := AWorksheet;
sheet := FWorksheet as TsWorksheet;
FCSVBuilder := TCSVBuilder.Create; FCSVBuilder := TCSVBuilder.Create;
try try
@ -371,29 +376,29 @@ begin
FCSVBuilder.QuoteChar := CSVParams.QuoteChar; FCSVBuilder.QuoteChar := CSVParams.QuoteChar;
FCSVBuilder.SetOutput(AStream); FCSVBuilder.SetOutput(AStream);
n := FWorksheet.GetCellCount; n := sheet.GetCellCount;
if FClipboardMode and (n = 1) then if FClipboardMode and (n = 1) then
begin begin
cell := FWorksheet.Cells.GetFirstCell; cell := sheet.Cells.GetFirstCell;
WriteCellToStream(AStream, cell); WriteCellToStream(AStream, cell);
end else end else
begin begin
if FClipboardMode then if FClipboardMode then
begin begin
firstRow := FWorksheet.GetFirstRowIndex; firstRow := sheet.GetFirstRowIndex;
firstCol := FWorksheet.GetFirstColIndex; firstCol := sheet.GetFirstColIndex;
end else end else
begin begin
firstRow := 0; firstRow := 0;
firstCol := 0; firstCol := 0;
end; end;
lastRow := FWorksheet.GetLastOccupiedRowIndex; lastRow := sheet.GetLastOccupiedRowIndex;
lastCol := FWorksheet.GetLastOccupiedColIndex; lastCol := sheet.GetLastOccupiedColIndex;
for r := firstRow to lastRow do for r := firstRow to lastRow do
begin begin
for c := firstCol to lastCol do for c := firstCol to lastCol do
begin begin
cell := FWorksheet.FindCell(r, c); cell := sheet.FindCell(r, c);
if cell = nil then if cell = nil then
FCSVBuilder.AppendCell('') FCSVBuilder.AppendCell('')
else else
@ -411,12 +416,15 @@ procedure TsCSVWriter.WriteToStream(AStream: TStream;
AParams: TsStreamParams = []); AParams: TsStreamParams = []);
var var
n: Integer; n: Integer;
book: TsWorkbook;
begin begin
book := FWorkbook as TsWorkbook;
FClipboardMode := (spClipboard in AParams); FClipboardMode := (spClipboard in AParams);
if (CSVParams.SheetIndex >= 0) and (CSVParams.SheetIndex < FWorkbook.GetWorksheetCount) if (CSVParams.SheetIndex >= 0) and (CSVParams.SheetIndex < book.GetWorksheetCount)
then n := CSVParams.SheetIndex then n := CSVParams.SheetIndex
else n := 0; else n := 0;
WriteSheet(AStream, FWorkbook.GetWorksheetByIndex(n)); WriteSheet(AStream, book.GetWorksheetByIndex(n));
end; end;
procedure TsCSVWriter.WriteToStrings(AStrings: TStrings; procedure TsCSVWriter.WriteToStrings(AStrings: TStrings;

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

@ -51,7 +51,7 @@ unit fpsExprParser;
interface interface
uses uses
Classes, SysUtils, contnrs, fpstypes, fpspreadsheet, fpsrpn; Classes, SysUtils, contnrs, fpstypes, fpsrpn;
type type
{ Tokens } { Tokens }
@ -86,7 +86,7 @@ type
TsResultTypes = set of TsResultType; TsResultTypes = set of TsResultType;
TsExpressionResult = record TsExpressionResult = record
Worksheet : TsWorksheet; // Worksheet containing the calculated cell Worksheet : TsBasicWorksheet; // Worksheet containing the calculated cell
ResString : String; ResString : String;
case ResultType : TsResultType of case ResultType : TsResultType of
rtEmpty : (); rtEmpty : ();
@ -586,7 +586,7 @@ type
{ TsCellExprNode } { TsCellExprNode }
TsCellExprNode = class(TsExprNode) TsCellExprNode = class(TsExprNode)
private private
FWorksheet: TsWorksheet; FWorksheet: TsBasicWorksheet;
FRow, FCol: Cardinal; FRow, FCol: Cardinal;
FFlags: TsRelFlags; FFlags: TsRelFlags;
FCell: PCell; FCell: PCell;
@ -595,20 +595,20 @@ type
protected protected
function GetCol: Cardinal; function GetCol: Cardinal;
function GetRow: Cardinal; function GetRow: Cardinal;
function GetSheet: TsWorksheet; function GetSheet: TsBasicWorksheet;
function GetSheetIndex: Integer; function GetSheetIndex: Integer;
function GetSheetName: String; function GetSheetName: String;
function GetWorkbook: TsWorkbook; function GetWorkbook: TsBasicWorkbook;
procedure GetNodeValue(out AResult: TsExpressionResult); override; procedure GetNodeValue(out AResult: TsExpressionResult); override;
public public
constructor Create(AParser: TsExpressionParser; AWorksheet: TsWorksheet; constructor Create(AParser: TsExpressionParser; AWorksheet: TsBasicWorksheet;
ASheetName: String; ARow, ACol: Cardinal; AFlags: TsRelFlags); ASheetName: String; ARow, ACol: Cardinal; AFlags: TsRelFlags);
function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: string; override; function AsString: string; override;
procedure Check; override; procedure Check; override;
function Has3DLink: Boolean; override; function Has3DLink: Boolean; override;
function NodeType: TsResultType; override; function NodeType: TsResultType; override;
property Worksheet: TsWorksheet read FWorksheet; property Worksheet: TsBasicWorksheet read FWorksheet;
end; end;
{ TsCellRangeExprNode } { TsCellRangeExprNode }
@ -616,7 +616,7 @@ type
TsCellRangeExprNode = class(TsExprNode) TsCellRangeExprNode = class(TsExprNode)
private private
FWorksheet: TsWorksheet; FWorksheet: TsBasicWorksheet;
FRow: array[TsCellRangeIndex] of Cardinal; FRow: array[TsCellRangeIndex] of Cardinal;
FCol: array[TsCellRangeIndex] of Cardinal; FCol: array[TsCellRangeIndex] of Cardinal;
FSheetIndex: array[TsCellRangeIndex] of Integer; FSheetIndex: array[TsCellRangeIndex] of Integer;
@ -626,17 +626,17 @@ type
function GetCol(AIndex: TsCellRangeIndex): Cardinal; function GetCol(AIndex: TsCellRangeIndex): Cardinal;
function GetRow(AIndex: TsCellRangeIndex): Cardinal; function GetRow(AIndex: TsCellRangeIndex): Cardinal;
procedure GetNodeValue(out Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
function GetWorkbook: TsWorkbook; function GetWorkbook: TsBasicWorkbook;
public public
constructor Create(AParser: TsExpressionParser; AWorksheet: TsWorksheet; constructor Create(AParser: TsExpressionParser; AWorksheet: TsBasicWorksheet;
ASheet1, ASheet2: String; ARange: TsCellRange; AFlags: TsRelFlags); ASheet1, ASheet2: String; ARange: TsCellRange; AFlags: TsRelFlags);
function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: String; override; function AsString: String; override;
procedure Check; override; procedure Check; override;
function Has3DLink: Boolean; override; function Has3DLink: Boolean; override;
function NodeType: TsResultType; override; function NodeType: TsResultType; override;
property Workbook: TsWorkbook read GetWorkbook; property Workbook: TsBasicWorkbook read GetWorkbook;
property Worksheet: TsWorksheet read FWorksheet; property Worksheet: TsBasicWorksheet read FWorksheet;
end; end;
{ TsExpressionScanner } { TsExpressionScanner }
@ -700,7 +700,7 @@ type
FIdentifiers: TsExprIdentifierDefs; FIdentifiers: TsExprIdentifierDefs;
FHashList: TFPHashObjectlist; FHashList: TFPHashObjectlist;
FDirty: Boolean; FDirty: Boolean;
FWorksheet: TsWorksheet; FWorksheet: TsBasicWorksheet;
FDialect: TsFormulaDialect; FDialect: TsFormulaDialect;
FSourceCell: PCell; FSourceCell: PCell;
FDestCell: PCell; FDestCell: PCell;
@ -748,7 +748,7 @@ type
property Dirty: Boolean read FDirty; property Dirty: Boolean read FDirty;
public public
constructor Create(AWorksheet: TsWorksheet); virtual; constructor Create(AWorksheet: TsBasicWorksheet); virtual;
destructor Destroy; override; destructor Destroy; override;
function IdentifierByName(AName: ShortString): TsExprIdentifierDef; virtual; function IdentifierByName(AName: ShortString): TsExprIdentifierDef; virtual;
procedure Clear; procedure Clear;
@ -771,7 +771,7 @@ type
property RPNFormula: TsRPNFormula read GetRPNFormula write SetRPNFormula; property RPNFormula: TsRPNFormula read GetRPNFormula write SetRPNFormula;
property Identifiers: TsExprIdentifierDefs read FIdentifiers write SetIdentifiers; property Identifiers: TsExprIdentifierDefs read FIdentifiers write SetIdentifiers;
property BuiltIns: TsBuiltInExprCategories read FBuiltIns write SetBuiltIns; property BuiltIns: TsBuiltInExprCategories read FBuiltIns write SetBuiltIns;
property Worksheet: TsWorksheet read FWorksheet; property Worksheet: TsBasicWorksheet read FWorksheet;
property Dialect: TsFormulaDialect read FDialect write SetDialect; property Dialect: TsFormulaDialect read FDialect write SetDialect;
property Contains3DRef: boolean read FContains3DRef; property Contains3DRef: boolean read FContains3DRef;
@ -779,7 +779,7 @@ type
TsSpreadsheetParser = class(TsExpressionParser) TsSpreadsheetParser = class(TsExpressionParser)
public public
constructor Create(AWorksheet: TsWorksheet); override; constructor Create(AWorksheet: TsBasicWorksheet); override;
end; end;
@ -865,7 +865,8 @@ const
implementation implementation
uses uses
typinfo, math, lazutf8, dateutils, fpsutils, fpsfunc, fpsStrings; typinfo, math, lazutf8, dateutils,
fpsutils, fpsfunc, fpsStrings, fpspreadsheet;
const const
cNull = #0; cNull = #0;
@ -1372,7 +1373,7 @@ end;
{ TsExpressionParser } { TsExpressionParser }
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
constructor TsExpressionParser.Create(AWorksheet: TsWorksheet); constructor TsExpressionParser.Create(AWorksheet: TsBasicWorksheet);
begin begin
inherited Create; inherited Create;
FDialect := fdExcelA1; FDialect := fdExcelA1;
@ -2038,7 +2039,7 @@ procedure TsExpressionParser.SetRPNFormula(const AFormula: TsRPNFormula);
else else
begin begin
flags := AFormula[AIndex].RelFlags; flags := AFormula[AIndex].RelFlags;
sn := FWorksheet.Workbook.GetWorksheetByIndex(idx).Name; sn := (FWorksheet as TsWorksheet).Workbook.GetWorksheetByIndex(idx).Name;
ANode := TsCellExprNode.Create(Self, FWorksheet, sn, r, c, flags); ANode := TsCellExprNode.Create(Self, FWorksheet, sn, r, c, flags);
end; end;
dec(AIndex); dec(AIndex);
@ -2053,9 +2054,9 @@ procedure TsExpressionParser.SetRPNFormula(const AFormula: TsRPNFormula);
if fek = fekCellRange then if fek = fekCellRange then
ANode := TsCellRangeExprNode.Create(self, FWorksheet, '', '', rng, flags) ANode := TsCellRangeExprNode.Create(self, FWorksheet, '', '', rng, flags)
else begin else begin
sn := FWorksheet.Workbook.GetWorksheetByIndex(AFormula[AIndex].Sheet).Name; sn := (FWorksheet as TsWorksheet).Workbook.GetWorksheetByIndex(AFormula[AIndex].Sheet).Name;
if AFormula[AIndex].Sheet2 <> -1 then if AFormula[AIndex].Sheet2 <> -1 then
sn2 := FWorksheet.Workbook.GetWorksheetByIndex(AFormula[AIndex].Sheet2).Name sn2 := (FWorksheet as TsWorksheet).Workbook.GetWorksheetByIndex(AFormula[AIndex].Sheet2).Name
else else
sn2 := ''; sn2 := '';
ANode := TsCellRangeExprNode.Create(self, FWorksheet, sn,sn2, rng, flags); ANode := TsCellRangeExprNode.Create(self, FWorksheet, sn,sn2, rng, flags);
@ -2185,7 +2186,7 @@ end;
{ TsSpreadsheetParser } { TsSpreadsheetParser }
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
constructor TsSpreadsheetParser.Create(AWorksheet: TsWorksheet); constructor TsSpreadsheetParser.Create(AWorksheet: TsBasicWorksheet);
begin begin
inherited Create(AWorksheet); inherited Create(AWorksheet);
BuiltIns := AllBuiltIns; BuiltIns := AllBuiltIns;
@ -3763,7 +3764,7 @@ end;
{ TsCellExprNode } { TsCellExprNode }
constructor TsCellExprNode.Create(AParser: TsExpressionParser; constructor TsCellExprNode.Create(AParser: TsExpressionParser;
AWorksheet: TsWorksheet; ASheetName: String; ARow, ACol: Cardinal; AWorksheet: TsBasicWorksheet; ASheetName: String; ARow, ACol: Cardinal;
AFlags: TsRelFlags); AFlags: TsRelFlags);
begin begin
FParser := AParser; FParser := AParser;
@ -3772,7 +3773,7 @@ begin
FRow := ARow; FRow := ARow;
FCol := ACol; FCol := ACol;
FFlags := AFlags; FFlags := AFlags;
FCell := GetSheet.FindCell(FRow, FCol); FCell := (GetSheet as TsWorksheet).FindCell(FRow, FCol);
if Has3DLink then FParser.FContains3DRef := true; if Has3DLink then FParser.FContains3DRef := true;
end; end;
@ -3847,14 +3848,14 @@ var
cell: PCell; cell: PCell;
begin begin
if Parser.CopyMode then if Parser.CopyMode then
cell := FWorksheet.FindCell(GetRow, GetCol) cell := (FWorksheet as TsWorksheet).FindCell(GetRow, GetCol)
else else
cell := FCell; cell := FCell;
if (cell <> nil) and HasFormula(cell) then if (cell <> nil) and HasFormula(cell) then
case FWorksheet.GetCalcState(cell) of case (FWorksheet as TsWorksheet).GetCalcState(cell) of
csNotCalculated: csNotCalculated:
FWorksheet.CalcFormula(cell); (FWorksheet as TsWorksheet).CalcFormula(cell);
csCalculating: csCalculating:
raise ECalcEngine.CreateFmt(rsCircularReference, [GetCellString(cell^.Row, cell^.Col)]); raise ECalcEngine.CreateFmt(rsCircularReference, [GetCellString(cell^.Row, cell^.Col)]);
end; end;
@ -3873,20 +3874,23 @@ begin
Result := FRow - FParser.FSourceCell^.Row + FParser.FDestCell^.Row; Result := FRow - FParser.FSourceCell^.Row + FParser.FDestCell^.Row;
end; end;
function TsCellExprNode.GetSheet: TsWorksheet; function TsCellExprNode.GetSheet: TsBasicWorksheet;
begin begin
if FSheetName = '' then if FSheetName = '' then
Result := FWorksheet Result := FWorksheet
else else
Result := GetWorkbook.GetWorksheetByName(FSheetName); Result := (GetWorkbook as TsWorkbook).GetWorksheetByName(FSheetName);
end; end;
function TsCellExprNode.GetSheetIndex: Integer; function TsCellExprNode.GetSheetIndex: Integer;
var
book: TsWorkbook;
begin begin
book := GetWorkbook as TsWorkbook;
if FSheetName = '' then if FSheetName = '' then
Result := GetWorkbook.GetWorksheetIndex(FWorksheet) Result := book.GetWorksheetIndex(FWorksheet)
else else
Result := GetWorkbook.GetWorksheetIndex(FSheetName); Result := book.GetWorksheetIndex(FSheetName);
end; end;
function TsCellExprNode.GetSheetName: String; function TsCellExprNode.GetSheetName: String;
@ -3897,9 +3901,9 @@ begin
Result := FSheetName; Result := FSheetName;
end; end;
function TsCellExprNode.GetWorkbook: TsWorkbook; function TsCellExprNode.GetWorkbook: TsBasicWorkbook;
begin begin
Result := FWorksheet.Workbook; Result := (FWorksheet as TsWorksheet).Workbook;
end; end;
function TsCellExprNode.Has3DLink: Boolean; function TsCellExprNode.Has3DLink: Boolean;
@ -3917,8 +3921,10 @@ end;
{ TsCellRangeExprNode } { TsCellRangeExprNode }
constructor TsCellRangeExprNode.Create(AParser: TsExpressionParser; constructor TsCellRangeExprNode.Create(AParser: TsExpressionParser;
AWorksheet: TsWorksheet; ASheet1, ASheet2: String; ARange: TsCellRange; AWorksheet: TsBasicWorksheet; ASheet1, ASheet2: String; ARange: TsCellRange;
AFlags: TsRelFlags); AFlags: TsRelFlags);
var
book: TsWorkbook;
begin begin
if (ASheet1 = '') and (ASheet2 <> '') then if (ASheet1 = '') and (ASheet2 <> '') then
raise Exception.Create('Invalid parameters in cell range'); raise Exception.Create('Invalid parameters in cell range');
@ -3926,13 +3932,14 @@ begin
FParser := AParser; FParser := AParser;
FWorksheet := AWorksheet; FWorksheet := AWorksheet;
FFlags := []; FFlags := [];
book := TsWorkbook(GetWorkbook);
F3dRange := ((ASheet1 <> '') and (ASheet2 <> '') { and (ASheet1 <> ASheet2)}) or F3dRange := ((ASheet1 <> '') and (ASheet2 <> '') { and (ASheet1 <> ASheet2)}) or
((ASheet1 <> '') and (ASheet2 = '')); ((ASheet1 <> '') and (ASheet2 = ''));
FSheetIndex[1] := GetWorkbook.GetWorksheetIndex(ASheet1); FSheetIndex[1] := book.GetWorksheetIndex(ASheet1);
if ASheet2 <> '' then if ASheet2 <> '' then
FSheetIndex[2] := GetWorkbook.GetWorksheetIndex(ASheet2) FSheetIndex[2] := book.GetWorksheetIndex(ASheet2)
else else
FSheetIndex[2] := FSheetIndex[1]; FSheetIndex[2] := FSheetIndex[1];
EnsureOrder(FSheetIndex[1], FSheetIndex[2]); EnsureOrder(FSheetIndex[1], FSheetIndex[2]);
@ -3997,11 +4004,11 @@ begin
if FSheetIndex[1] = -1 then if FSheetIndex[1] = -1 then
s1 := FWorksheet.Name s1 := FWorksheet.Name
else else
s1 := Workbook.GetWorksheetByIndex(FSheetIndex[1]).Name; s1 := (Workbook as TsWorkbook).GetWorksheetByIndex(FSheetIndex[1]).Name;
if FSheetIndex[2] = -1 then if FSheetIndex[2] = -1 then
s2 := FWorksheet.Name s2 := FWorksheet.Name
else else
s2 := Workbook.GetWorksheetByIndex(FSheetIndex[2]).Name; s2 := (Workbook as TsWorkbook).GetWorksheetByIndex(FSheetIndex[2]).Name;
r1 := GetRow(1); r1 := GetRow(1);
c1 := GetCol(1); c1 := GetCol(1);
r2 := GetRow(2); r2 := GetRow(2);
@ -4068,12 +4075,12 @@ begin
end; end;
if not F3dRange then begin if not F3dRange then begin
s[1] := Workbook.GetWorksheetIndex(FWorksheet); s[1] := (Workbook as TsWorkbook).GetWorksheetIndex(FWorksheet);
s[2] := s[1]; s[2] := s[1];
end; end;
for ss := s[1] to s[2] do begin for ss := s[1] to s[2] do begin
sheet := Workbook.GetWorksheetByIndex(ss); sheet := (Workbook as TsWorkbook).GetWorksheetByIndex(ss);
for rr := r[1] to r[2] do for rr := r[1] to r[2] do
for cc := c[1] to c[2] do for cc := c[1] to c[2] do
begin begin
@ -4106,9 +4113,9 @@ begin
Result := FRow[AIndex] - FParser.FSourceCell^.Row + FParser.FDestCell^.Row; Result := FRow[AIndex] - FParser.FSourceCell^.Row + FParser.FDestCell^.Row;
end; end;
function TsCellRangeExprNode.GetWorkbook: TsWorkbook; function TsCellRangeExprNode.GetWorkbook: TsBasicWorkbook;
begin begin
Result := FWorksheet.Workbook; Result := (FWorksheet as TsWorksheet).Workbook;
end; end;
function TsCellRangeExprNode.Has3DLink: Boolean; function TsCellRangeExprNode.Has3DLink: Boolean;
@ -4144,7 +4151,7 @@ end;
function ArgToCell(Arg: TsExpressionResult): PCell; function ArgToCell(Arg: TsExpressionResult): PCell;
begin begin
if Arg.ResultType = rtCell then if Arg.ResultType = rtCell then
Result := Arg.Worksheet.FindCell(Arg.ResRow, Arg.ResCol) Result := (Arg.Worksheet as TsWorksheet).FindCell(Arg.ResRow, Arg.ResCol)
else else
Result := nil; Result := nil;
end; end;
@ -4196,14 +4203,18 @@ begin
cell := ArgToCell(Arg); cell := ArgToCell(Arg);
if Assigned(cell) then if Assigned(cell) then
case cell^.ContentType of case cell^.ContentType of
cctNumber : Result := cell^.NumberValue; cctNumber:
cctDateTime : Result := cell^.DateTimeValue; Result := cell^.NumberValue;
cctBool : if cell^.BoolValue then result := 1.0; cctDateTime:
cctUTF8String: begin Result := cell^.DateTimeValue;
fs := Arg.Worksheet.Workbook.FormatSettings; cctBool:
s := cell^.UTF8StringValue; if cell^.BoolValue then result := 1.0;
TryStrToFloat(s, result, fs); cctUTF8String:
end; begin
fs := (Arg.Worksheet as TsWorksheet).Workbook.FormatSettings;
s := cell^.UTF8StringValue;
TryStrToFloat(s, result, fs);
end;
end; end;
end; end;
end; end;
@ -4222,7 +4233,7 @@ begin
rtBoolean : if Arg.ResBoolean then Result := 1.0; rtBoolean : if Arg.ResBoolean then Result := 1.0;
rtString, rtString,
rtHyperlink : begin rtHyperlink : begin
fs := Arg.Worksheet.Workbook.FormatSettings; fs := (Arg.Worksheet as TsWorksheet).Workbook.FormatSettings;
TryStrToDateTime(ArgToString(Arg), Result, fs); TryStrToDateTime(ArgToString(Arg), Result, fs);
end; end;
rtCell : begin rtCell : begin
@ -4265,7 +4276,7 @@ begin
cctNumber : Result := Format('%g', [cell^.NumberValue]); cctNumber : Result := Format('%g', [cell^.NumberValue]);
cctBool : if cell^.BoolValue then Result := '1' else Result := '0'; cctBool : if cell^.BoolValue then Result := '1' else Result := '0';
cctDateTime : begin cctDateTime : begin
fs := Arg.Worksheet.Workbook.FormatSettings; fs := (Arg.Worksheet as TsWorksheet).Workbook.FormatSettings;
dt := cell^.DateTimeValue; dt := cell^.DateTimeValue;
if frac(dt) = 0.0 then if frac(dt) = 0.0 then
Result := FormatDateTime(fs.LongTimeFormat, dt, fs) Result := FormatDateTime(fs.LongTimeFormat, dt, fs)
@ -4301,7 +4312,7 @@ begin
idx2 := arg.ResCellRange.Sheet2; idx2 := arg.ResCellRange.Sheet2;
for idx := idx1 to idx2 do for idx := idx1 to idx2 do
begin begin
sheet := arg.Worksheet.Workbook.GetWorksheetByIndex(idx); sheet := (arg.Worksheet as TsWorksheet).Workbook.GetWorksheetByIndex(idx);
for r := arg.ResCellRange.Row1 to arg.ResCellRange.Row2 do for r := arg.ResCellRange.Row1 to arg.ResCellRange.Row2 do
for c := arg.ResCellRange.Col1 to arg.ResCellRange.Col2 do for c := arg.ResCellRange.Col1 to arg.ResCellRange.Col2 do
begin begin
@ -4393,7 +4404,7 @@ begin
rtFloat : Result := (frac(AValue.ResFloat) = 0); rtFloat : Result := (frac(AValue.ResFloat) = 0);
rtEmpty : Result := true; rtEmpty : Result := true;
rtCell : begin rtCell : begin
cell := AValue.Worksheet.FindCell(AValue.ResRow, AValue.ResCol); cell := (AValue.Worksheet as TsWorksheet).FindCell(AValue.ResRow, AValue.ResCol);
if Assigned(cell) then if Assigned(cell) then
case cell^.ContentType of case cell^.ContentType of
cctNumber: cctNumber:
@ -4415,7 +4426,7 @@ begin
case AValue.ResultType of case AValue.ResultType of
rtString: Result := true; rtString: Result := true;
rtCell : begin rtCell : begin
cell := AValue.Worksheet.FindCell(AValue.ResRow, AValue.ResCol); cell := (AValue.Worksheet as TsWorksheet).FindCell(AValue.ResRow, AValue.ResCol);
Result := (cell <> nil) and (cell^.ContentType = cctUTF8String); Result := (cell <> nil) and (cell^.ContentType = cctUTF8String);
end; end;
end; end;

24
components/fpspreadsheet/source/common/fpsfunc.pas
View File

@ -9,7 +9,7 @@ unit fpsfunc;
interface interface
uses uses
Classes, SysUtils, fpstypes, fpspreadsheet; Classes, SysUtils, fpstypes;
procedure RegisterStdBuiltins(AManager: TComponent); procedure RegisterStdBuiltins(AManager: TComponent);
@ -18,7 +18,7 @@ implementation
uses uses
Math, lazutf8, StrUtils, DateUtils, Math, lazutf8, StrUtils, DateUtils,
xlsconst, {%H-}fpsPatches, fpsUtils, fpsnumformat, fpsexprparser; xlsconst, {%H-}fpsPatches, fpsUtils, fpsnumformat, fpsexprparser, fpspreadsheet;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
@ -1035,7 +1035,7 @@ begin
for r := arg.ResCellRange.Row1 to arg.ResCellRange.Row2 do for r := arg.ResCellRange.Row1 to arg.ResCellRange.Row2 do
for c := arg.ResCellRange.Col1 to arg.ResCellRange.Col2 do for c := arg.ResCellRange.Col1 to arg.ResCellRange.Col2 do
begin begin
cell := arg.Worksheet.FindCell(r, c); cell := (arg.Worksheet as TsWorksheet).FindCell(r, c);
if (cell <> nil) then if (cell <> nil) then
case cell^.ContentType of case cell^.ContentType of
cctNumber, cctDateTime, cctBool : inc(n); cctNumber, cctDateTime, cctBool : inc(n);
@ -1076,7 +1076,7 @@ begin
rtCellRange: rtCellRange:
for r := Args[0].ResCellRange.Row1 to Args[0].ResCellRange.Row2 do for r := Args[0].ResCellRange.Row1 to Args[0].ResCellRange.Row2 do
for c := Args[0].ResCellRange.Col1 to Args[0].ResCellRange.Col2 do begin for c := Args[0].ResCellRange.Col1 to Args[0].ResCellRange.Col2 do begin
cell := Args[0].Worksheet.FindCell(r, c); cell := (Args[0].Worksheet as TsWorksheet).FindCell(r, c);
if cell = nil then if cell = nil then
inc(n) inc(n)
else else
@ -1185,7 +1185,7 @@ begin
// Get format settings for string-to-float or -to-datetime conversion // Get format settings for string-to-float or -to-datetime conversion
if (Args[0].ResultType in [rtCell, rtCellRange]) then if (Args[0].ResultType in [rtCell, rtCellRange]) then
fs := Args[0].Worksheet.FormatSettings fs := (Args[0].Worksheet as TsWorksheet).FormatSettings
else else
begin begin
Result := ErrorResult(errArgError); Result := ErrorResult(errArgError);
@ -1325,8 +1325,8 @@ begin
if AFlag > 0 then if AFlag > 0 then
begin begin
if Length(Args) = 2 then if Length(Args) = 2 then
addcell := Args[0].Worksheet.FindCell(r + dr, c + dc) else addcell := (Args[0].Worksheet as TsWorksheet).FindCell(r + dr, c + dc) else
addCell := Args[2].Worksheet.FindCell(r + dr, c + dc); addCell := (Args[2].Worksheet as TsWorksheet).FindCell(r + dr, c + dc);
if addcell <> nil then if addcell <> nil then
case addcell^.Contenttype of case addcell^.Contenttype of
cctNumber : addnumber := addcell^.NumberValue; cctNumber : addnumber := addcell^.NumberValue;
@ -1335,7 +1335,7 @@ begin
end; end;
end; end;
cell := Args[0].Worksheet.FindCell(r, c); cell := (Args[0].Worksheet as TsWorksheet).FindCell(r, c);
case compareType of case compareType of
ctNumber: ctNumber:
if cell <> nil then if cell <> nil then
@ -1610,7 +1610,7 @@ begin
begin begin
r1 := Args[1].ResCellRange.Row1; r1 := Args[1].ResCellRange.Row1;
c1 := Args[1].ResCellRange.Col1; c1 := Args[1].ResCellRange.Col1;
cell := Args[1].Worksheet.FindCell(r1, c1); cell := (Args[1].Worksheet as TsWorksheet).FindCell(r1, c1);
end; end;
else else
Result := ErrorResult(errWrongType); Result := ErrorResult(errWrongType);
@ -1652,8 +1652,8 @@ begin
end else end else
if stype = 'filename' then if stype = 'filename' then
Result := Stringresult( Result := Stringresult(
ExtractFilePath(Args[1].Worksheet.Workbook.FileName) + '[' + ExtractFilePath((Args[1].Worksheet as TsWorksheet).Workbook.FileName) + '[' +
ExtractFileName(Args[1].Worksheet.Workbook.FileName) + ']' + ExtractFileName((Args[1].Worksheet as TsWorksheet).Workbook.FileName) + ']' +
Args[1].Worksheet.Name Args[1].Worksheet.Name
) )
else else
@ -1710,7 +1710,7 @@ begin
Result := StringResult('v'); Result := StringResult('v');
end else end else
if stype = 'width' then if stype = 'width' then
Result := FloatResult(Args[1].Worksheet.GetColWidth(c1, suChars)) Result := FloatResult((Args[1].Worksheet as TsWorksheet).GetColWidth(c1, suChars))
else else
Result := ErrorResult(errWrongType); Result := ErrorResult(errWrongType);
end; end;

153
components/fpspreadsheet/source/common/fpshtml.pas
View File

@ -6,7 +6,7 @@ interface
uses uses
Classes, SysUtils, fasthtmlparser, Classes, SysUtils, fasthtmlparser,
fpstypes, fpspreadsheet, fpsClasses, fpsReaderWriter, fpsHTMLUtils; fpstypes, fpsClasses, fpsReaderWriter, fpsHTMLUtils;
type type
TsHTMLReader = class(TsCustomSpreadReader) TsHTMLReader = class(TsCustomSpreadReader)
@ -55,7 +55,7 @@ type
procedure AddRichTextParam(AFont: TsFont; AHyperlinkIndex: Integer = -1); procedure AddRichTextParam(AFont: TsFont; AHyperlinkIndex: Integer = -1);
procedure FixRichTextParams(var AParams: TsRichTextParams); procedure FixRichTextParams(var AParams: TsRichTextParams);
public public
constructor Create(AWorkbook: TsWorkbook); override; constructor Create(AWorkbook: TsBasicWorkbook); override;
destructor Destroy; override; destructor Destroy; override;
procedure ReadFromStream(AStream: TStream; APassword: String = ''; procedure ReadFromStream(AStream: TStream; APassword: String = '';
AParams: TsStreamParams = []); override; AParams: TsStreamParams = []); override;
@ -86,7 +86,7 @@ type
function IsHyperlinkTarget(ACell: PCell; out ABookmark: String): Boolean; function IsHyperlinkTarget(ACell: PCell; out ABookmark: String): Boolean;
procedure WriteBody(AStream: TStream); procedure WriteBody(AStream: TStream);
procedure WriteStyles(AStream: TStream); procedure WriteStyles(AStream: TStream);
procedure WriteWorksheet(AStream: TStream; ASheet: TsWorksheet); procedure WriteWorksheet(AStream: TStream; ASheet: TsBasicWorksheet);
protected protected
procedure InternalWriteToStream(AStream: TStream); procedure InternalWriteToStream(AStream: TStream);
@ -106,7 +106,7 @@ type
const AValue: double; ACell: PCell); override; const AValue: double; ACell: PCell); override;
public public
constructor Create(AWorkbook: TsWorkbook); override; constructor Create(AWorkbook: TsBasicWorkbook); override;
destructor Destroy; override; destructor Destroy; override;
procedure WriteToStream(AStream: TStream; AParams: TsStreamParams = []); override; procedure WriteToStream(AStream: TStream; AParams: TsStreamParams = []); override;
procedure WriteToStrings(AStrings: TStrings; AParams: TsStreamParams = []); override; procedure WriteToStrings(AStrings: TStrings; AParams: TsStreamParams = []); override;
@ -143,7 +143,7 @@ implementation
uses uses
LConvEncoding, LazUTF8, URIParser, StrUtils, Math, LConvEncoding, LazUTF8, URIParser, StrUtils, Math,
fpsUtils, fpsXMLCommon, fpsNumFormat; fpsUtils, fpspreadsheet, fpsXMLCommon, fpsNumFormat;
const const
MIN_FONTSIZE = 6; MIN_FONTSIZE = 6;
@ -162,7 +162,7 @@ const
{ TsHTMLReader } { TsHTMLReader }
{==============================================================================} {==============================================================================}
constructor TsHTMLReader.Create(AWorkbook: TsWorkbook); constructor TsHTMLReader.Create(AWorkbook: TsBasicWorkbook);
begin begin
inherited Create(AWorkbook); inherited Create(AWorkbook);
FEncoding := EncodingUTF8; FEncoding := EncodingUTF8;
@ -203,13 +203,16 @@ var
currSym: String; currSym: String;
warning: String; warning: String;
fntIndex: Integer; fntIndex: Integer;
sheet: TsWorksheet;
begin begin
// Empty strings are blank cells -- nothing to do // Empty strings are blank cells -- nothing to do
if (AText = '') then if (AText = '') then
exit; exit;
sheet := FWorksheet as TsWorksheet;
// Create cell // Create cell
cell := FWorksheet.AddCell(ARow, ACol); cell := sheet.AddCell(ARow, ACol);
// Format, rich-text formatting parameters // Format, rich-text formatting parameters
// Reject non-used runs; adapt font index to the workbook. // Reject non-used runs; adapt font index to the workbook.
@ -223,10 +226,10 @@ begin
end else end else
begin begin
// Get cell font and use it in the cell format // Get cell font and use it in the cell format
fntIndex := FWorkbook.FindFont(FCellFont.FontName, FCellFont.Size, fntIndex := (FWorkbook as TsWorkbook).FindFont(FCellFont.FontName, FCellFont.Size,
FCellFont.Style, FCellFont.Color, FCellFont.Position); FCellFont.Style, FCellFont.Color, FCellFont.Position);
if fntIndex = -1 then if fntIndex = -1 then
fntIndex := FWorkbook.AddFont(FCellFont.FontName, FCellFont.Size, fntIndex := (FWorkbook as TsWorkbook).AddFont(FCellFont.FontName, FCellFont.Size,
FCellFont.Style, FCellFont.Color, FCellFont.Position); FCellFont.Style, FCellFont.Color, FCellFont.Position);
FCurrCellFormat.FontIndex := fntIndex; FCurrCellFormat.FontIndex := fntIndex;
end; end;
@ -234,25 +237,25 @@ begin
Include(FCurrCellFormat.UsedFormattingFields, uffFont) else Include(FCurrCellFormat.UsedFormattingFields, uffFont) else
Exclude(FCurrCellFormat.UsedFormattingFields, uffFont); Exclude(FCurrCellFormat.UsedFormattingFields, uffFont);
// Store the cell format in the workbook // Store the cell format in the workbook
cell^.FormatIndex := FWorkbook.AddCellFormat(FCurrCellFormat); cell^.FormatIndex := (FWorkbook as TsWorkbook).AddCellFormat(FCurrCellFormat);
// Merged cells // Merged cells
if (FColSpan > 0) or (FRowSpan > 0) then begin if (FColSpan > 0) or (FRowSpan > 0) then begin
FWorksheet.MergeCells(ARow, ACol, ARow + FRowSpan, ACol + FColSpan); sheet.MergeCells(ARow, ACol, ARow + FRowSpan, ACol + FColSpan);
FRowSpan := 0; FRowSpan := 0;
FColSpan := 0; FColSpan := 0;
end; end;
// Hyperlink // Hyperlink
if FHRef <> '' then begin if FHRef <> '' then begin
FWorksheet.WriteHyperlink(cell, FHRef); sheet.WriteHyperlink(cell, FHRef);
FHRef := ''; FHRef := '';
end; end;
// Case: Do not try to interpret the strings. --> everything is a LABEL cell. // Case: Do not try to interpret the strings. --> everything is a LABEL cell.
if not HTMLParams.DetectContentType then if not HTMLParams.DetectContentType then
begin begin
FWorksheet.WriteText(cell, AText, FCurrRichTextParams); sheet.WriteText(cell, AText, FCurrRichTextParams);
exit; exit;
end; end;
@ -261,9 +264,9 @@ begin
dblValue, nf, decs, currSym, warning) then dblValue, nf, decs, currSym, warning) then
begin begin
if currSym <> '' then if currSym <> '' then
FWorksheet.WriteCurrency(cell, dblValue, nfCurrency, decs, currSym) sheet.WriteCurrency(cell, dblValue, nfCurrency, decs, currSym)
else else
FWorksheet.WriteNumber(cell, dblValue, nf, decs); sheet.WriteNumber(cell, dblValue, nf, decs);
if warning <> '' then if warning <> '' then
FWorkbook.AddErrorMsg('Cell %s: %s', [GetCellString(ARow, ACol), warning]); FWorkbook.AddErrorMsg('Cell %s: %s', [GetCellString(ARow, ACol), warning]);
exit; exit;
@ -273,19 +276,19 @@ begin
// No idea how to apply the date/time formatsettings here... // No idea how to apply the date/time formatsettings here...
if IsDateTimevalue(AText, FFormatSettings, dtValue, nf) then if IsDateTimevalue(AText, FFormatSettings, dtValue, nf) then
begin begin
FWorksheet.WriteDateTime(cell, dtValue, nf); sheet.WriteDateTime(cell, dtValue, nf);
exit; exit;
end; end;
// Check for a BOOLEAN cell // Check for a BOOLEAN cell
if IsBoolValue(AText, HTMLParams.TrueText, HTMLParams.FalseText, boolValue) then if IsBoolValue(AText, HTMLParams.TrueText, HTMLParams.FalseText, boolValue) then
begin begin
FWorksheet.WriteBoolValue(cell, boolValue); sheet.WriteBoolValue(cell, boolValue);
exit; exit;
end; end;
// What is left is handled as a TEXT cell // What is left is handled as a TEXT cell
FWorksheet.WriteText(cell, AText, FCurrRichTextParams); sheet.WriteText(cell, AText, FCurrRichTextParams);
end; end;
{ Stores a font in the internal font list. Does not allow duplicates. } { Stores a font in the internal font list. Does not allow duplicates. }
@ -378,9 +381,9 @@ begin
for i:=0 to High(FCurrRichTextParams) do for i:=0 to High(FCurrRichTextParams) do
begin begin
fnt := TsFont(FFontList[FCurrRichTextParams[i].FontIndex]); fnt := TsFont(FFontList[FCurrRichTextParams[i].FontIndex]);
fntIndex := FWorkbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position); fntIndex := (FWorkbook as TsWorkbook).FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position);
if fntIndex = -1 then if fntIndex = -1 then
fntIndex := FWorkbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position); fntIndex := (FWorkbook as TsWorkbook).AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position);
FCurrRichTextParams[i].FontIndex := fntIndex; FCurrRichTextParams[i].FontIndex := fntIndex;
end; end;
end; end;
@ -485,6 +488,7 @@ end;
procedure TsHTMLReader.ProcessEndTags(NoCaseTag, ActualTag: String); procedure TsHTMLReader.ProcessEndTags(NoCaseTag, ActualTag: String);
var var
fntIndex: Integer; fntIndex: Integer;
sheet: TsWorksheet;
begin begin
Unused(ActualTag); Unused(ActualTag);
if not FInTable then exit; if not FInTable then exit;
@ -501,9 +505,11 @@ begin
if not FInCell then exit; if not FInCell then exit;
sheet := FWorksheet as TsWorksheet;
if (NoCaseTag = '</TD>') or (NoCaseTag = '</TH>') then if (NoCaseTag = '</TD>') or (NoCaseTag = '</TH>') then
begin begin
while FWorksheet.IsMerged(FWorksheet.FindCell(FCurrRow, FCurrCol)) do while sheet.IsMerged(sheet.FindCell(FCurrRow, FCurrCol)) do
inc(FCurrCol); inc(FCurrCol);
AddCell(FCurrRow, FCurrCol, FCellText); AddCell(FCurrRow, FCurrCol, FCellText);
FInCell := false; FInCell := false;
@ -807,7 +813,7 @@ begin
if idx = -1 then if idx = -1 then
idx := FAttrList.IndexOfName('size'); idx := FAttrList.IndexOfName('size');
if idx > -1 then begin if idx > -1 then begin
defFntSize := FWorkbook.GetDefaultFont.Size; defFntSize := (FWorkbook as TsWorkbook).GetDefaultFont.Size;
s := FAttrList[idx].Value; s := FAttrList[idx].Value;
case s of case s of
'medium', '3' : AFont.Size := defFntSize; 'medium', '3' : AFont.Size := defFntSize;
@ -1022,7 +1028,7 @@ procedure TsHTMLReader.InitFont(AFont: TsFont);
var var
fnt: TsFont; fnt: TsFont;
begin begin
fnt := FWorkbook.GetDefaultFont; fnt := (FWorkbook as TsWorkbook).GetDefaultFont;
AFont.FontName := fnt.FontName; AFont.FontName := fnt.FontName;
AFont.Size := fnt.Size; AFont.Size := fnt.Size;
AFont.Style := fnt.Style; AFont.Style := fnt.Style;
@ -1056,10 +1062,10 @@ begin
try try
list.LoadFromStream(AStream); list.LoadFromStream(AStream);
ReadFromStrings(list, AParams); ReadFromStrings(list, AParams);
if FWorkbook.GetWorksheetCount = 0 then if (FWorkbook as TsWorkbook).GetWorksheetCount = 0 then
begin begin
FWorkbook.AddErrorMsg('Requested table not found, or no tables in html file'); FWorkbook.AddErrorMsg('Requested table not found, or no tables in html file');
FWorkbook.AddWorksheet('Dummy'); TsWorkbook(FWorkbook).AddWorksheet('Dummy');
end; end;
finally finally
list.Free; list.Free;
@ -1106,14 +1112,14 @@ begin
inc(FTableCounter); inc(FTableCounter);
if (HTMLParams.TableIndex >= 0) and (FTableCounter <> HTMLParams.TableIndex) then if (HTMLParams.TableIndex >= 0) and (FTableCounter <> HTMLParams.TableIndex) then
exit; exit;
FWorksheet := FWorkbook.AddWorksheet(Format('Table #%d', [FTableCounter+1])); FWorksheet := TsWorkbook(FWorkbook).AddWorksheet(Format('Table #%d', [FTableCounter+1]));
FInTable := true; FInTable := true;
FCurrRow := -1; FCurrRow := -1;
FCurrCol := -1; FCurrCol := -1;
FFontStack.Push(AddFont(FCurrFont)); FFontStack.Push(AddFont(FCurrFont));
FAttrList.Parse(ActualTag); FAttrList.Parse(ActualTag);
ReadFont(FCurrFont); ReadFont(FCurrFont);
FWorkbook.ReplaceFont(DEFAULT_FONTINDEX, FCurrFont.FontName, FCurrFont.Size, TsWorkbook(FWorkbook).ReplaceFont(DEFAULT_FONTINDEX, FCurrFont.FontName, FCurrFont.Size,
FCurrFont.Style, FCurrFont.Color, FCurrFont.Position); FCurrFont.Style, FCurrFont.Color, FCurrFont.Position);
FCellFont.CopyOf(FCurrFont); FCellFont.CopyOf(FCurrFont);
exit; exit;
@ -1179,7 +1185,7 @@ end;
{==============================================================================} {==============================================================================}
{ TsHTMLWriter } { TsHTMLWriter }
{==============================================================================} {==============================================================================}
constructor TsHTMLWriter.Create(AWorkbook: TsWorkbook); constructor TsHTMLWriter.Create(AWorkbook: TsBasicWorkbook);
begin begin
inherited Create(AWorkbook); inherited Create(AWorkbook);
FPointSeparatorSettings := DefaultFormatSettings; FPointSeparatorSettings := DefaultFormatSettings;
@ -1311,17 +1317,20 @@ var
col: PCol; col: PCol;
w: Single; w: Single;
rLast: Cardinal; rLast: Cardinal;
sheet: TsWorksheet;
begin begin
sheet := FWorksheet as TsWorksheet;
if AColIndex < 0 then // Row header column if AColIndex < 0 then // Row header column
begin begin
rLast := FWorksheet.GetLastRowIndex; rLast := sheet.GetLastRowIndex;
w := FWorkbook.ConvertUnits(Length(IntToStr(rLast)) + 2, suChars, suPoints); w := (FWorkbook as TsWorkbook).ConvertUnits(Length(IntToStr(rLast)) + 2, suChars, suPoints);
end else end else
begin begin
w := FWorksheet.ReadDefaultColWidth(suPoints); w := sheet.ReadDefaultColWidth(suPoints);
col := FWorksheet.FindCol(AColIndex); col := sheet.FindCol(AColIndex);
if (col <> nil) and (col^.Width > 0) then if (col <> nil) and (col^.Width > 0) then
w := FWorkbook.ConvertUnits(col^.Width, FWorkbook.Units, suPoints); w := (FWorkbook as TsWorkbook).ConvertUnits(col^.Width, FWorkbook.Units, suPoints);
end; end;
Result:= Format(' width="%.1fpt"', [w], FPointSeparatorSettings); Result:= Format(' width="%.1fpt"', [w], FPointSeparatorSettings);
end; end;
@ -1342,7 +1351,7 @@ function TsHTMLWriter.GetFontAsStyle(AFontIndex: Integer): String;
var var
font: TsFont; font: TsFont;
begin begin
font := FWorkbook.GetFont(AFontIndex); font := (FWorkbook as TsWorkbook).GetFont(AFontIndex);
Result := Format('font-family:''%s'';font-size:%.1fpt;color:%s;', [ Result := Format('font-family:''%s'';font-size:%.1fpt;color:%s;', [
font.FontName, font.Size, ColorToHTMLColorStr(font.Color)], FPointSeparatorSettings); font.FontName, font.Size, ColorToHTMLColorStr(font.Color)], FPointSeparatorSettings);
if fssBold in font.Style then if fssBold in font.Style then
@ -1381,7 +1390,7 @@ var
r1, r2, c1, c2: Cardinal; r1, r2, c1, c2: Cardinal;
begin begin
Result := ''; Result := '';
FWorksheet.FindMergedRange(AMergeBase, r1, c1, r2, c2); (FWorksheet as TsWorksheet).FindMergedRange(AMergeBase, r1, c1, r2, c2);
if c1 <> c2 then if c1 <> c2 then
Result := Result + ' colspan="' + IntToStr(c2-c1+1) + '"'; Result := Result + ' colspan="' + IntToStr(c2-c1+1) + '"';
if r1 <> r2 then if r1 <> r2 then
@ -1393,11 +1402,11 @@ var
h: Single; h: Single;
row: PRow; row: PRow;
begin begin
h := FWorksheet.ReadDefaultRowHeight(suPoints); h := (FWorksheet as TsWorksheet).ReadDefaultRowHeight(suPoints);
row := FWorksheet.FindRow(ARowIndex); row := (FWorksheet as TsWorksheet).FindRow(ARowIndex);
if row <> nil then begin if row <> nil then begin
if row^.RowHeightType = rhtCustom then if row^.RowHeightType = rhtCustom then
h := abs(FWorkbook.ConvertUnits(row^.Height, FWorkbook.Units, suPoints)); h := abs((FWorkbook as TsWorkbook).ConvertUnits(row^.Height, FWorkbook.Units, suPoints));
end; end;
Result := Format(' height="%.1fpt"', [h], FPointSeparatorSettings); Result := Format(' height="%.1fpt"', [h], FPointSeparatorSettings);
end; end;
@ -1441,7 +1450,7 @@ end;
procedure TsHTMLWriter.InternalWriteToStream(AStream: TStream); procedure TsHTMLWriter.InternalWriteToStream(AStream: TStream);
begin begin
FWorkbook.UpdateCaches; (FWorkbook as TsWorkbook).UpdateCaches;
AppendToStream(AStream, AppendToStream(AStream,
'<!DOCTYPE html>'); '<!DOCTYPE html>');
@ -1472,9 +1481,9 @@ begin
if ACell = nil then if ACell = nil then
exit; exit;
for i:=0 to FWorkbook.GetWorksheetCount-1 do for i:=0 to (FWorkbook as TsWorkbook).GetWorksheetCount-1 do
begin begin
sheet := FWorkbook.GetWorksheetByIndex(i); sheet := (FWorkbook as TsWorkbook).GetWorksheetByIndex(i);
for hyperlink in sheet.Hyperlinks do for hyperlink in sheet.Hyperlinks do
begin begin
SplitHyperlink(hyperlink^.Target, target, ABookmark); SplitHyperlink(hyperlink^.Target, target, ABookmark);
@ -1503,20 +1512,23 @@ end;
procedure TsHTMLWriter.WriteBody(AStream: TStream); procedure TsHTMLWriter.WriteBody(AStream: TStream);
var var
i: Integer; i: Integer;
book: TsWorkbook;
begin begin
book := FWorkbook as TsWorkbook;
AppendToStream(AStream, AppendToStream(AStream,
'<body>'); '<body>');
if FWindowsClipboardMode or (HTMLParams.SheetIndex < 0) then // active sheet if FWindowsClipboardMode or (HTMLParams.SheetIndex < 0) then // active sheet
begin begin
if FWorkbook.ActiveWorksheet = nil then if book.ActiveWorksheet = nil then
FWorkbook.SelectWorksheet(FWorkbook.GetWorksheetByIndex(0)); book.SelectWorksheet(book.GetWorksheetByIndex(0));
WriteWorksheet(AStream, FWorkbook.ActiveWorksheet) WriteWorksheet(AStream, book.ActiveWorksheet)
end else end else
if HTMLParams.SheetIndex = MaxInt then // all sheets if HTMLParams.SheetIndex = MaxInt then // all sheets
for i:=0 to FWorkbook.GetWorksheetCount-1 do for i:=0 to book.GetWorksheetCount-1 do
WriteWorksheet(AStream, FWorkbook.GetWorksheetByIndex(i)) WriteWorksheet(AStream, book.GetWorksheetByIndex(i))
else // specific sheet else // specific sheet
WriteWorksheet(AStream, FWorkbook.GetWorksheetbyIndex(HTMLParams.SheetIndex)); WriteWorksheet(AStream, book.GetWorksheetbyIndex(HTMLParams.SheetIndex));
AppendToStream(AStream, AppendToStream(AStream,
'</body>'); '</body>');
end; end;
@ -1538,7 +1550,7 @@ var
s: String; s: String;
begin begin
Unused(AValue, ACol, ARow); Unused(AValue, ACol, ARow);
s := FWorksheet.ReadAsText(ACell); s := (FWorksheet as TsWorksheet).ReadAsText(ACell);
AppendToStream(AStream, AppendToStream(AStream,
'<div>' + s + '</div>'); '<div>' + s + '</div>');
end; end;
@ -1549,7 +1561,7 @@ var
s: String; s: String;
begin begin
Unused(AValue, ACol, ARow); Unused(AValue, ACol, ARow);
s := FWOrksheet.ReadAsText(ACell); s := (FWorksheet as TsWorksheet).ReadAsText(ACell);
AppendToStream(AStream, AppendToStream(AStream,
'<div>' + s + '</div>'); '<div>' + s + '</div>');
end; end;
@ -1593,13 +1605,13 @@ begin
exit; exit;
style := ''; style := '';
cellfnt := FWorksheet.ReadCellFont(ACell); cellfnt := (FWorksheet as TsWorksheet).ReadCellFont(ACell);
// Hyperlink // Hyperlink
target := ''; target := '';
if FWorksheet.HasHyperlink(ACell) then if FWorksheet.HasHyperlink(ACell) then
begin begin
hyperlink := FWorksheet.FindHyperlink(ACell); hyperlink := (FWorksheet as TsWorksheet).FindHyperlink(ACell);
SplitHyperlink(hyperlink^.Target, target, bookmark); SplitHyperlink(hyperlink^.Target, target, bookmark);
n := Length(hyperlink^.Target); n := Length(hyperlink^.Target);
@ -1657,7 +1669,7 @@ begin
begin begin
// formatted section // formatted section
rtParam := ACell^.RichTextParams[i]; rtParam := ACell^.RichTextParams[i];
fnt := FWorkbook.GetFont(rtParam.FontIndex); fnt := (FWorkbook as TsWorkbook).GetFont(rtParam.FontIndex);
style := GetFontAsStyle(rtParam.FontIndex); style := GetFontAsStyle(rtParam.FontIndex);
if style <> '' then if style <> '' then
style := ' style="' + style +'"'; style := ' style="' + style +'"';
@ -1684,7 +1696,7 @@ var
s: String; s: String;
begin begin
Unused(ARow, ACol, AValue); Unused(ARow, ACol, AValue);
s := FWorksheet.ReadAsText(ACell, FWorkbook.FormatSettings); s := (FWorksheet as TsWorksheet).ReadAsText(ACell, FWorkbook.FormatSettings);
AppendToStream(AStream, AppendToStream(AStream,
'<div>' + s + '</div>'); '<div>' + s + '</div>');
end; end;
@ -1697,8 +1709,8 @@ var
begin begin
AppendToStream(AStream, AppendToStream(AStream,
'<style>' + LineEnding); '<style>' + LineEnding);
for i:=0 to FWorkbook.GetNumCellFormats-1 do begin for i:=0 to (FWorkbook as TsWorkbook).GetNumCellFormats-1 do begin
fmt := FWorkbook.GetPointerToCellFormat(i); fmt := (FWorkbook as TsWorkbook).GetPointerToCellFormat(i);
fmtStr := CellFormatAsString(fmt); fmtStr := CellFormatAsString(fmt);
if fmtStr <> '' then if fmtStr <> '' then
fmtStr := Format(' td.style%d {%s}' + LineEnding, [i+1, fmtStr]); fmtStr := Format(' td.style%d {%s}' + LineEnding, [i+1, fmtStr]);
@ -1741,7 +1753,7 @@ begin
end; end;
end; end;
procedure TsHTMLWriter.WriteWorksheet(AStream: TStream; ASheet: TsWorksheet); procedure TsHTMLWriter.WriteWorksheet(AStream: TStream; ASheet: TsBasicWorksheet);
var var
r, rFirst, rLast: LongInt; r, rFirst, rLast: LongInt;
c, cFirst, cLast: LongInt; c, cFirst, cLast: LongInt;
@ -1751,18 +1763,19 @@ var
style, s: String; style, s: String;
fixedLayout: Boolean; fixedLayout: Boolean;
fmt: PsCellFormat; fmt: PsCellFormat;
sheet: TsWorksheet absolute ASheet;
begin begin
FWorksheet := ASheet; FWorksheet := ASheet;
rFirst := FWorksheet.GetFirstRowIndex; rFirst := sheet.GetFirstRowIndex;
cFirst := FWorksheet.GetFirstColIndex; cFirst := sheet.GetFirstColIndex;
rLast := FWorksheet.GetLastOccupiedRowIndex; rLast := sheet.GetLastOccupiedRowIndex;
cLast := FWorksheet.GetLastOccupiedColIndex; cLast := sheet.GetLastOccupiedColIndex;
fixedLayout := false; fixedLayout := false;
for c:=cFirst to cLast do for c:=cFirst to cLast do
begin begin
col := FWorksheet.GetCol(c); col := sheet.GetCol(c);
if col <> nil then if col <> nil then
begin begin
fixedLayout := true; fixedLayout := true;
@ -1812,7 +1825,7 @@ begin
style := ' style="' + style + '"'; style := ' style="' + style + '"';
if fixedLayout then if fixedLayout then
style := style + GetColWidthAsAttr(c); style := style + GetColWidthAsAttr(c);
col := FWorksheet.FindCol(c); col := sheet.FindCol(c);
if (col <> nil) and (col^.FormatIndex > 0) then if (col <> nil) and (col^.FormatIndex > 0) then
style := style + Format(' class="style%d"', [col^.FormatIndex+1]); style := style + Format(' class="style%d"', [col^.FormatIndex+1]);
@ -1822,7 +1835,7 @@ begin
end; end;
for r := rFirst to rLast do begin for r := rFirst to rLast do begin
row := FWorksheet.FindRow(r); row := sheet.FindRow(r);
AppendToStream(AStream, AppendToStream(AStream,
'<tr>' + LineEnding); '<tr>' + LineEnding);
@ -1840,8 +1853,8 @@ begin
for c := cFirst to cLast do begin for c := cFirst to cLast do begin
// Pointer to current cell in loop // Pointer to current cell in loop
cell := FWorksheet.FindCell(r, c); cell := sheet.FindCell(r, c);
col := FWorksheet.FindCol(c); col := sheet.FindCol(c);
// Cell formatting via predefined styles ("class") // Cell formatting via predefined styles ("class")
style := ''; style := '';
@ -1849,17 +1862,17 @@ begin
if cell <> nil then if cell <> nil then
begin begin
style := Format(' class="style%d"', [cell^.FormatIndex+1]); style := Format(' class="style%d"', [cell^.FormatIndex+1]);
fmt := FWorkbook.GetPointerToCellFormat(cell^.FormatIndex); fmt := (FWorkbook as TsWorkbook).GetPointerToCellFormat(cell^.FormatIndex);
end else end else
if (row <> nil) and (row^.FormatIndex > 0) then if (row <> nil) and (row^.FormatIndex > 0) then
begin begin
style := Format(' class="style%d"', [row^.FormatIndex+1]); style := Format(' class="style%d"', [row^.FormatIndex+1]);
fmt := FWorkbook.GetPointerToCellFormat(row^.FormatIndex); fmt := (FWorkbook as TsWorkbook).GetPointerToCellFormat(row^.FormatIndex);
end else end else
if (col <> nil) and (col^.FormatIndex > 0) then if (col <> nil) and (col^.FormatIndex > 0) then
begin begin
style := Format(' class="style%d"', [col^.FormatIndex+1]); style := Format(' class="style%d"', [col^.FormatIndex+1]);
fmt := FWorkbook.GetPointerToCellFormat(col^.FormatIndex); fmt := (FWorkbook as TsWorkbook).GetPointerToCellFormat(col^.FormatIndex);
end; end;
// Overriding differences between html and fps formatting // Overriding differences between html and fps formatting
@ -1888,9 +1901,9 @@ begin
end; end;
// Merged cells // Merged cells
if FWorksheet.IsMerged(cell) then if sheet.IsMerged(cell) then
begin begin
if FWorksheet.IsMergeBase(cell) then if sheet.IsMergeBase(cell) then
style := style + GetMergedRangeAsStyle(cell) style := style + GetMergedRangeAsStyle(cell)
else else
Continue; Continue;

16
components/fpspreadsheet/source/common/fpshtmlutils.pas
View File

@ -5,7 +5,7 @@ unit fpsHTMLUtils;
interface interface
uses uses
Classes, SysUtils, contnrs, fpstypes, fpspreadsheet; Classes, SysUtils, contnrs, fpstypes;
type type
TsHTMLEntity = record TsHTMLEntity = record
@ -39,11 +39,11 @@ type
TsTagCase = (tcLowercase, tcUppercase, tcProperCase); TsTagCase = (tcLowercase, tcUppercase, tcProperCase);
procedure HTMLToRichText(AWorkbook: TsWorkbook; AFont: TsFont; procedure HTMLToRichText(AWorkbook: TsBasicWorkbook; AFont: TsFont;
const AHTMLText: String; out APlainText: String; const AHTMLText: String; out APlainText: String;
out ARichTextParams: TsRichTextParams); out ARichTextParams: TsRichTextParams);
procedure RichTextToHTML(AWorkbook: TsWorkbook; AFont: TsFont; procedure RichTextToHTML(AWorkbook: TsBasicWorkbook; AFont: TsFont;
const APlainText: String; const ARichTextParams: TsRichTextParams; const APlainText: String; const ARichTextParams: TsRichTextParams;
out AHTMLText: String; APrefix:String = ''; ATagCase: TsTagCase = tcLowercase); out AHTMLText: String; APrefix:String = ''; ATagCase: TsTagCase = tcLowercase);
@ -52,7 +52,7 @@ implementation
uses uses
math, lazUtf8, fasthtmlparser, math, lazUtf8, fasthtmlparser,
fpsUtils, fpsClasses; fpsUtils, fpsClasses, fpspreadsheet;
const const
// http://unicode.e-workers.de/entities.php // http://unicode.e-workers.de/entities.php
@ -940,7 +940,7 @@ end;
@@param ARichtTextParams Rich-text parameters corresponding to the embedded @@param ARichtTextParams Rich-text parameters corresponding to the embedded
html tags html tags
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure HTMLToRichText(AWorkbook: TsWorkbook; AFont: TsFont; procedure HTMLToRichText(AWorkbook: TsBasicWorkbook; AFont: TsFont;
const AHTMLText: String; out APlainText: String; const AHTMLText: String; out APlainText: String;
out ARichTextParams: TsRichTextParams); out ARichTextParams: TsRichTextParams);
var var
@ -949,7 +949,7 @@ var
len: Integer; len: Integer;
nrtp: Integer; nrtp: Integer;
begin begin
analyzer := TsHTMLAnalyzer.Create(AWorkbook, AFont, AHTMLText + '<end>'); analyzer := TsHTMLAnalyzer.Create(AWorkbook as TsWorkbook, AFont, AHTMLText + '<end>');
try try
analyzer.PreserveSpaces := true; analyzer.PreserveSpaces := true;
analyzer.Exec; analyzer.Exec;
@ -1187,7 +1187,7 @@ end;
Constructs a html-coded string from a plain text string and Constructs a html-coded string from a plain text string and
rich-text parameters rich-text parameters
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure RichTextToHTML(AWorkbook: TsWorkbook; AFont: TsFont; procedure RichTextToHTML(AWorkbook: TsBasicWorkbook; AFont: TsFont;
const APlainText: String; const ARichTextParams: TsRichTextParams; const APlainText: String; const ARichTextParams: TsRichTextParams;
out AHTMLText: String; APrefix: String = ''; ATagCase: TsTagCase = tcLowercase); out AHTMLText: String; APrefix: String = ''; ATagCase: TsTagCase = tcLowercase);
var var
@ -1197,7 +1197,7 @@ begin
AHTMLText := APlainText AHTMLText := APlainText
else else
begin begin
composer := TsHTMLComposer.Create(AWorkbook, AFont, APrefix, ATagCase); composer := TsHTMLComposer.Create(AWorkbook as TsWorkbook, AFont, APrefix, ATagCase);
try try
AHTMLText := composer.Exec(APlainText, ARichTextParams); AHTMLText := composer.Exec(APlainText, ARichTextParams);
finally finally

645
components/fpspreadsheet/source/common/fpsopendocument.pas
View File

File diff suppressed because it is too large Load Diff

28
components/fpspreadsheet/source/common/fpspalette.pas
View File

@ -16,7 +16,7 @@ unit fpsPalette;
interface interface
uses uses
Classes, SysUtils, fpstypes, fpspreadsheet; Classes, SysUtils, fpstypes;
type type
@ -34,8 +34,8 @@ type
procedure AddExcelColors; procedure AddExcelColors;
function AddUniqueColor(AColor: TsColor; ABigEndian: Boolean = false): Integer; function AddUniqueColor(AColor: TsColor; ABigEndian: Boolean = false): Integer;
procedure Clear; procedure Clear;
procedure CollectFromWorkbook(AWorkbook: TsWorkbook); procedure CollectFromWorkbook(AWorkbook: TsBasicWorkbook);
function ColorUsedInWorkbook(APaletteIndex: Integer; AWorkbook: TsWorkbook): Boolean; function ColorUsedInWorkbook(APaletteIndex: Integer; AWorkbook: TsBasicWorkbook): Boolean;
function FindClosestColorIndex(AColor: TsColor; AMaxPaletteCount: Integer = -1): Integer; function FindClosestColorIndex(AColor: TsColor; AMaxPaletteCount: Integer = -1): Integer;
function FindColor(AColor: TsColor; AMaxPaletteCount: Integer = -1; function FindColor(AColor: TsColor; AMaxPaletteCount: Integer = -1;
AStartIndex: Integer = 0): Integer; AStartIndex: Integer = 0): Integer;
@ -51,7 +51,7 @@ type
implementation implementation
uses uses
fpsutils; fpsutils, fpspreadsheet;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
If a palette is coded as big-endian (e.g. by copying the rgb values from If a palette is coded as big-endian (e.g. by copying the rgb values from
@ -223,18 +223,19 @@ end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Collects the colors used in the specified workbook Collects the colors used in the specified workbook
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsPalette.CollectFromWorkbook(AWorkbook: TsWorkbook); procedure TsPalette.CollectFromWorkbook(AWorkbook: TsBasicWorkbook);
var var
i: Integer; i: Integer;
book: TsWorkbook absolute AWorkbook;
sheet: TsWorksheet; sheet: TsWorksheet;
cell: PCell; cell: PCell;
fmt: TsCellFormat; fmt: TsCellFormat;
fnt: TsFont; fnt: TsFont;
cb: TsCellBorder; cb: TsCellBorder;
begin begin
for i:=0 to AWorkbook.GetWorksheetCount-1 do for i:=0 to book.GetWorksheetCount-1 do
begin begin
sheet := AWorkbook.GetWorksheetByIndex(i); sheet := book.GetWorksheetByIndex(i);
for cell in sheet.Cells do begin for cell in sheet.Cells do begin
fmt := sheet.ReadCellFormat(cell); fmt := sheet.ReadCellFormat(cell);
if (uffBackground in fmt.UsedFormattingFields) then if (uffBackground in fmt.UsedFormattingFields) then
@ -244,7 +245,7 @@ begin
end; end;
if (uffFont in fmt.UsedFormattingFields) then if (uffFont in fmt.UsedFormattingFields) then
begin begin
fnt := AWorkbook.GetFont(fmt.FontIndex); fnt := book.GetFont(fmt.FontIndex);
AddUniqueColor(fnt.Color); AddUniqueColor(fnt.Color);
end; end;
if (uffBorder in fmt.UsedFormattingFields) then if (uffBorder in fmt.UsedFormattingFields) then
@ -264,8 +265,9 @@ end;
@result True if the color is used by at least one cell, false if not. @result True if the color is used by at least one cell, false if not.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsPalette.ColorUsedInWorkbook(APaletteIndex: Integer; function TsPalette.ColorUsedInWorkbook(APaletteIndex: Integer;
AWorkbook: TsWorkbook): Boolean; AWorkbook: TsBasicWorkbook): Boolean;
var var
book: TsWorkbook absolute AWorkbook;
sheet: TsWorksheet; sheet: TsWorksheet;
cell: PCell; cell: PCell;
i: Integer; i: Integer;
@ -279,12 +281,12 @@ begin
exit(false); exit(false);
Result := true; Result := true;
for i:=0 to AWorkbook.GetWorksheetCount-1 do for i:=0 to book.GetWorksheetCount-1 do
begin begin
sheet := AWorkbook.GetWorksheetByIndex(i); sheet := book.GetWorksheetByIndex(i);
for cell in sheet.Cells do for cell in sheet.Cells do
begin begin
fmt := AWorkbook.GetPointerToCellFormat(cell^.FormatIndex); fmt := book.GetPointerToCellFormat(cell^.FormatIndex);
if (uffBackground in fmt^.UsedFormattingFields) then if (uffBackground in fmt^.UsedFormattingFields) then
begin begin
if fmt^.Background.BgColor = color then exit; if fmt^.Background.BgColor = color then exit;
@ -296,7 +298,7 @@ begin
exit; exit;
if (uffFont in fmt^.UsedFormattingFields) then if (uffFont in fmt^.UsedFormattingFields) then
begin begin
fnt := AWorkbook.GetFont(fmt^.FontIndex); fnt := book.GetFont(fmt^.FontIndex);
if fnt.Color = color then if fnt.Color = color then
exit; exit;
end; end;

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

@ -30,23 +30,6 @@ type
TsWorksheet = class; TsWorksheet = class;
TsWorkbook = class; TsWorkbook = class;
{@@ Worksheet user interface options:
@param soShowGridLines Show or hide the grid lines in the spreadsheet
@param soShowHeaders Show or hide the column or row headers of the
spreadsheet
@param soHasFrozenPanes If set a number of rows and columns of the
spreadsheet is fixed and does not scroll. The number
is defined by LeftPaneWidth and TopPaneHeight.
@param soHidden Worksheet is hidden.
@param soProtected Worksheet is protected
@param soPanesProtection Panes are locked due to workbook protection }
TsSheetOption = (soShowGridLines, soShowHeaders, soHasFrozenPanes, soHidden,
soProtected, soPanesProtection);
{@@ Set of user interface options
@ see TsSheetOption }
TsSheetOptions = set of TsSheetOption;
{ TsWorksheet } { TsWorksheet }
@ -77,10 +60,9 @@ type
{@@ The worksheet contains a list of cells and provides a variety of methods {@@ The worksheet contains a list of cells and provides a variety of methods
to read or write data to the cells, or to change their formatting. } to read or write data to the cells, or to change their formatting. }
TsWorksheet = class TsWorksheet = class(TsBasicWorksheet)
private private
FWorkbook: TsWorkbook; FWorkbook: TsWorkbook;
FName: String; // Name of the worksheet (displayed at the tab)
FCells: TsCells; FCells: TsCells;
FComments: TsComments; FComments: TsComments;
FMergedCells: TsMergedCells; FMergedCells: TsMergedCells;
@ -94,7 +76,6 @@ type
FSelection: TsCellRangeArray; FSelection: TsCellRangeArray;
FLeftPaneWidth: Integer; FLeftPaneWidth: Integer;
FTopPaneHeight: Integer; FTopPaneHeight: Integer;
FOptions: TsSheetOptions;
FFirstRowIndex: Cardinal; FFirstRowIndex: Cardinal;
FFirstColIndex: Cardinal; FFirstColIndex: Cardinal;
FLastRowIndex: Cardinal; FLastRowIndex: Cardinal;
@ -105,7 +86,6 @@ type
FBiDiMode: TsBiDiMode; FBiDiMode: TsBiDiMode;
FCryptoInfo: TsCryptoInfo; FCryptoInfo: TsCryptoInfo;
FPageLayout: TsPageLayout; FPageLayout: TsPageLayout;
FProtection: TsWorksheetProtections;
FVirtualColCount: Cardinal; FVirtualColCount: Cardinal;
FVirtualRowCount: Cardinal; FVirtualRowCount: Cardinal;
FZoomFactor: Double; FZoomFactor: Double;
@ -125,7 +105,6 @@ type
procedure SetBiDiMode(AValue: TsBiDiMode); procedure SetBiDiMode(AValue: TsBiDiMode);
procedure SetDefaultColWidth(AValue: Single); procedure SetDefaultColWidth(AValue: Single);
procedure SetDefaultRowHeight(AValue: Single); procedure SetDefaultRowHeight(AValue: Single);
procedure SetName(const AName: String);
procedure SetVirtualColCount(AValue: Cardinal); procedure SetVirtualColCount(AValue: Cardinal);
procedure SetVirtualRowCount(AValue: Cardinal); procedure SetVirtualRowCount(AValue: Cardinal);
procedure SetZoomFactor(AValue: Double); procedure SetZoomFactor(AValue: Double);
@ -152,6 +131,9 @@ type
AFromIndex, AToIndex: Cardinal); AFromIndex, AToIndex: Cardinal);
procedure ExchangeCells(ARow1, ACol1, ARow2, ACol2: Cardinal); procedure ExchangeCells(ARow1, ACol1, ARow2, ACol2: Cardinal);
// inherited setters/getters
procedure SetName(const AName: String); override;
public public
{ Base methods } { Base methods }
constructor Create; constructor Create;
@ -523,7 +505,6 @@ type
// Hyperlinks // Hyperlinks
function FindHyperlink(ACell: PCell): PsHyperlink; function FindHyperlink(ACell: PCell): PsHyperlink;
function HasHyperlink(ACell: PCell): Boolean;
function ReadHyperlink(ACell: PCell): TsHyperlink; function ReadHyperlink(ACell: PCell): TsHyperlink;
procedure RemoveHyperlink(ACell: PCell); procedure RemoveHyperlink(ACell: PCell);
function ValidHyperlink(AValue: String; out AErrMsg: String): Boolean; function ValidHyperlink(AValue: String; out AErrMsg: String): Boolean;
@ -567,7 +548,6 @@ type
{ Protection } { Protection }
procedure Protect(AEnable: Boolean); procedure Protect(AEnable: Boolean);
function IsProtected: Boolean;
{ Notification of changed cells, rows or columns } { Notification of changed cells, rows or columns }
procedure ChangedCell(ARow, ACol: Cardinal); procedure ChangedCell(ARow, ACol: Cardinal);
@ -592,13 +572,8 @@ type
property Hyperlinks: TsHyperlinks read FHyperlinks; property Hyperlinks: TsHyperlinks read FHyperlinks;
{@@ FormatSettings for localization of some formatting strings } {@@ FormatSettings for localization of some formatting strings }
property FormatSettings: TFormatSettings read GetFormatSettings; property FormatSettings: TFormatSettings read GetFormatSettings;
{@@ Name of the sheet. In the popular spreadsheet applications this is
displayed at the tab of the sheet. }
property Name: string read FName write SetName;
{@@ Parameters to be used for printing by the Office applications } {@@ Parameters to be used for printing by the Office applications }
property PageLayout: TsPageLayout read FPageLayout write FPageLayout; property PageLayout: TsPageLayout read FPageLayout write FPageLayout;
{@@ Worksheet protection options }
property Protection: TsWorksheetProtections read FProtection write FProtection;
{@@ List of all row records of the worksheet having a non-standard row height } {@@ List of all row records of the worksheet having a non-standard row height }
property Rows: TIndexedAVLTree read FRows; property Rows: TIndexedAVLTree read FRows;
{@@ Workbook to which the worksheet belongs } {@@ Workbook to which the worksheet belongs }
@ -619,9 +594,6 @@ type
// These are properties to interface to TsWorksheetGrid // These are properties to interface to TsWorksheetGrid
property BiDiMode: TsBiDiMode read FBiDiMode write SetBiDiMode; property BiDiMode: TsBiDiMode read FBiDiMode write SetBiDiMode;
{@@ Parameters controlling visibility of grid lines and row/column headers,
usage of frozen panes etc. }
property Options: TsSheetOptions read FOptions write FOptions;
{@@ Column index of the selected cell of this worksheet } {@@ Column index of the selected cell of this worksheet }
property ActiveCellCol: Cardinal read FActiveCellCol; property ActiveCellCol: Cardinal read FActiveCellCol;
{@@ Row index of the selected cell of this worksheet } {@@ Row index of the selected cell of this worksheet }
@ -656,43 +628,6 @@ type
property OnZoom: TsNotifyEvent read FOnZoom write FOnZoom; property OnZoom: TsNotifyEvent read FOnZoom write FOnZoom;
end; end;
{@@
Option flags for the workbook
@param boVirtualMode If in virtual mode date are not taken from cells
when a spreadsheet is written to file, but are
provided by means of the event OnWriteCellData.
Similarly, when data are read they are not added
as cells but passed the the event OnReadCellData;
@param boBufStream When this option is set a buffered stream is used
for writing (a memory stream swapping to disk) or
reading (a file stream pre-reading chunks of data
to memory)
@param boFileStream Uses file streams and temporary files during
reading and writing. Lowest memory consumptions,
but slow.
@param boAutoCalc Automatically recalculate formulas whenever a
cell value changes.
@param boCalcBeforeSaving Calculates formulas before saving the file.
Otherwise there are no results when the file is
loaded back by fpspreadsheet.
@param boReadFormulas Allows to turn off reading of rpn formulas; this
is a precaution since formulas not correctly
implemented by fpspreadsheet could crash the
reading operation.
@param boWriteZoomfactor Instructs the writer to write the current zoom
factors of the worksheets to file.
@param boAbortReadOnFormulaError Aborts reading if a formula error is
encountered
@param boIgnoreFormulas Formulas are not checked and not calculated.
Cannot be used for biff formats. }
TsWorkbookOption = (boVirtualMode, boBufStream, boFileStream,
boAutoCalc, boCalcBeforeSaving, boReadFormulas, boWriteZoomFactor,
boAbortReadOnFormulaError, boIgnoreFormulas);
{@@ Set of option flags for the workbook }
TsWorkbookOptions = set of TsWorkbookOption;
{@@ Event fired when reading a file in virtual mode. Read data are provided in {@@ Event fired when reading a file in virtual mode. Read data are provided in
the "ADataCell" (which is not added to the worksheet in virtual mode). } the "ADataCell" (which is not added to the worksheet in virtual mode). }
TsWorkbookReadCellDataEvent = procedure(Sender: TObject; ARow, ACol: Cardinal; TsWorkbookReadCellDataEvent = procedure(Sender: TObject; ARow, ACol: Cardinal;
@ -707,40 +642,32 @@ type
{@@ FSome action has an effect on existing formulas which must be corrected. } {@@ FSome action has an effect on existing formulas which must be corrected. }
TsFormulaCorrection = (fcWorksheetRenamed); TsFormulaCorrection = (fcWorksheetRenamed);
{ TsWorkbook }
{ TsWorkbook }
{@@ The workbook contains the worksheets and provides methods for reading from {@@ The workbook contains the worksheets and provides methods for reading from
and writing to file. } and writing to file. }
TsWorkbook = class TsWorkbook = class(TsBasicWorkbook)
private private
{ Internal data } { Internal data }
FWorksheets: TFPList; FWorksheets: TFPList;
FFormatID: TsSpreadFormatID;
FBuiltinFontCount: Integer; FBuiltinFontCount: Integer;
FReadWriteFlag: TsReadWriteFlag; FReadWriteFlag: TsReadWriteFlag;
FCalculationLock: Integer; FCalculationLock: Integer;
FOptions: TsWorkbookOptions;
FActiveWorksheet: TsWorksheet; FActiveWorksheet: TsWorksheet;
FOnOpenWorkbook: TNotifyEvent; FOnOpenWorkbook: TNotifyEvent;
FOnReadCellData: TsWorkbookReadCellDataEvent;
FOnChangeWorksheet: TsWorksheetEvent; FOnChangeWorksheet: TsWorksheetEvent;
FOnRenameWorksheet: TsWorksheetEvent; FOnRenameWorksheet: TsWorksheetEvent;
FOnAddWorksheet: TsWorksheetEvent; FOnAddWorksheet: TsWorksheetEvent;
FOnRemoveWorksheet: TsRemoveWorksheetEvent; FOnRemoveWorksheet: TsRemoveWorksheetEvent;
FOnRemovingWorksheet: TsWorksheetEvent; FOnRemovingWorksheet: TsWorksheetEvent;
FOnSelectWorksheet: TsWorksheetEvent; FOnSelectWorksheet: TsWorksheetEvent;
FFileName: String; FOnReadCellData: TsWorkbookReadCellDataEvent;
FLockCount: Integer; FLockCount: Integer;
FLog: TStringList;
FSearchEngine: TObject; FSearchEngine: TObject;
FUnits: TsSizeUnits;
FProtection: TsWorkbookProtections;
FCryptoInfo: TsCryptoInfo; FCryptoInfo: TsCryptoInfo;
{FrevisionsCrypto: TsCryptoInfo;} // Commented out because it needs revision handling {FrevisionsCrypto: TsCryptoInfo;} // Commented out because it needs revision handling
{ Setter/Getter }
function GetErrorMsg: String;
{ Callback procedures } { Callback procedures }
procedure RemoveWorksheetsCallback(data, arg: pointer); procedure RemoveWorksheetsCallback(data, arg: pointer);
@ -764,11 +691,6 @@ type
// procedure ReCalc; // procedure ReCalc;
public public
{@@ A copy of SysUtil's DefaultFormatSettings (converted to UTF8) to provide
some kind of localization to some formatting strings.
Can be modified before loading/writing files }
FormatSettings: TFormatSettings;
{ Base methods } { Base methods }
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
@ -809,7 +731,7 @@ type
function GetWorksheetByIndex(AIndex: Integer): TsWorksheet; function GetWorksheetByIndex(AIndex: Integer): TsWorksheet;
function GetWorksheetByName(AName: String): TsWorksheet; function GetWorksheetByName(AName: String): TsWorksheet;
function GetWorksheetCount: Integer; function GetWorksheetCount: Integer;
function GetWorksheetIndex(AWorksheet: TsWorksheet): Integer; overload; function GetWorksheetIndex(AWorksheet: TsBasicWorksheet): Integer; overload;
function GetWorksheetIndex(const AWorksheetName: String): Integer; overload; function GetWorksheetIndex(const AWorksheetName: String): Integer; overload;
procedure RemoveAllWorksheets; procedure RemoveAllWorksheets;
procedure RemoveAllEmptyWorksheets; procedure RemoveAllEmptyWorksheets;
@ -886,33 +808,16 @@ type
procedure UpdateCaches; procedure UpdateCaches;
procedure GetLastRowColIndex(out ALastRow, ALastCol: Cardinal); procedure GetLastRowColIndex(out ALastRow, ALastCol: Cardinal);
{ Protection }
function IsProtected: Boolean;
{ Notification } { Notification }
procedure ChangedWorksheet(AWorksheet: TsWorksheet); procedure ChangedWorksheet(AWorksheet: TsWorksheet);
procedure DisableNotifications; procedure DisableNotifications;
procedure EnableNotifications; procedure EnableNotifications;
function NotificationsEnabled: Boolean; function NotificationsEnabled: Boolean;
{ Error messages }
procedure AddErrorMsg(const AMsg: String); overload;
procedure AddErrorMsg(const AMsg: String; const Args: array of const); overload;
procedure ClearErrorList;
{@@ Identifies the "active" worksheet (only for visual controls)} {@@ Identifies the "active" worksheet (only for visual controls)}
property ActiveWorksheet: TsWorksheet read FActiveWorksheet write SelectWorksheet; property ActiveWorksheet: TsWorksheet read FActiveWorksheet write SelectWorksheet;
property CryptoInfo: TsCryptoInfo read FCryptoInfo write FCryptoInfo; property CryptoInfo: TsCryptoInfo read FCryptoInfo write FCryptoInfo;
{@@ Retrieves error messages collected during reading/writing }
property ErrorMsg: String read GetErrorMsg;
{@@ Filename of the saved workbook }
property FileName: String read FFileName;
{@@ Identifies the file format which was detected when reading the file }
property FileFormatID: TsSpreadFormatID read FFormatID;
property Options: TsWorkbookOptions read FOptions write FOptions;
{property RevisionsCrypto: TsCryptoInfo read FRevisionsCrypto write FRevisionsCrypto;} {property RevisionsCrypto: TsCryptoInfo read FRevisionsCrypto write FRevisionsCrypto;}
property Protection: TsWorkbookProtections read FProtection write FProtection;
property Units: TsSizeUnits read FUnits;
{@@ This event fires whenever a new worksheet is added } {@@ This event fires whenever a new worksheet is added }
property OnAddWorksheet: TsWorksheetEvent read FOnAddWorksheet write FOnAddWorksheet; property OnAddWorksheet: TsWorksheetEvent read FOnAddWorksheet write FOnAddWorksheet;
@ -1217,7 +1122,6 @@ begin
FActiveCellRow := UNASSIGNED_ROW_COL_INDEX; FActiveCellRow := UNASSIGNED_ROW_COL_INDEX;
FActiveCellCol := UNASSIGNED_ROW_COL_INDEX; FActiveCellCol := UNASSIGNED_ROW_COL_INDEX;
FProtection := DEFAULT_SHEET_PROTECTION;
InitCryptoInfo(FCryptoInfo); InitCryptoInfo(FCryptoInfo);
FOptions := [soShowGridLines, soShowHeaders]; FOptions := [soShowGridLines, soShowHeaders];
@ -1336,8 +1240,7 @@ begin
end; end;
rtBoolean : WriteBoolValue(ACell, res.ResBoolean); rtBoolean : WriteBoolValue(ACell, res.ResBoolean);
rtCell : begin rtCell : begin
// cell := GetCell(res.ResRow, res.ResCol); cell := (res.Worksheet as TsWorksheet).FindCell(res.ResRow, res.ResCol);
cell := res.Worksheet.FindCell(res.ResRow, res.ResCol);
if cell <> nil then if cell <> nil then
case cell^.ContentType of case cell^.ContentType of
cctNumber : WriteNumber(ACell, cell^.NumberValue); cctNumber : WriteNumber(ACell, cell^.NumberValue);
@ -1603,14 +1506,6 @@ begin
Result := nil; Result := nil;
end; end;
{@@ ----------------------------------------------------------------------------
Checks whether the specified cell contains a hyperlink
-------------------------------------------------------------------------------}
function TsWorksheet.HasHyperlink(ACell: PCell): Boolean;
begin
Result := (ACell <> nil) and (cfHyperlink in ACell^.Flags);
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Reads the hyperlink information of a specified cell. Reads the hyperlink information of a specified cell.
@ -4201,14 +4096,6 @@ begin
FWorkbook.ChangedWorksheet(self); FWorkbook.ChangedWorksheet(self);
end; end;
{@@ ----------------------------------------------------------------------------
Returns whether the worksheet is protected
-------------------------------------------------------------------------------}
function TsWorksheet.IsProtected: Boolean;
begin
Result := soProtected in FOptions;
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Setter for the worksheet name property. Checks if the name is valid, and Setter for the worksheet name property. Checks if the name is valid, and
@ -4221,9 +4108,11 @@ begin
if (FWorkbook <> nil) then //and FWorkbook.ValidWorksheetName(AName) then if (FWorkbook <> nil) then //and FWorkbook.ValidWorksheetName(AName) then
begin begin
FName := AName; FName := AName;
FWorkbook.FixFormulas(fcWorksheetRenamed, self, 0); if FWorkbook.FReadWriteFlag = rwfNormal then begin
if (FWorkbook.FLockCount = 0) and Assigned(FWorkbook.FOnRenameWorksheet) then FWorkbook.FixFormulas(fcWorksheetRenamed, self, 0);
FWorkbook.FOnRenameWorksheet(FWorkbook, self); if (FWorkbook.FLockCount = 0) and Assigned(FWorkbook.FOnRenameWorksheet) then
FWorkbook.FOnRenameWorksheet(FWorkbook, self);
end;
end; end;
end; end;
@ -8111,10 +8000,10 @@ begin
InitFonts; InitFonts;
// Clear error log // Clear error log
FLog.Clear; ClearErrorList;
// Abort if virtual mode is active without an event handler // Abort if virtual mode is active without an event handler
if (boVirtualMode in FOptions) and not Assigned(FOnReadCellData) then if (boVirtualMode in FOptions) and not Assigned(OnReadCellData) then
raise EFPSpreadsheet.Create('[TsWorkbook.PrepareBeforeReading] Event handler "OnReadCellData" required for virtual mode.'); raise EFPSpreadsheet.Create('[TsWorkbook.PrepareBeforeReading] Event handler "OnReadCellData" required for virtual mode.');
end; end;
@ -8129,7 +8018,7 @@ var
virtModeOK: Boolean; virtModeOK: Boolean;
begin begin
// Clear error log // Clear error log
FLog.Clear; ClearErrorList;
// Updates fist/last column/row index // Updates fist/last column/row index
UpdateCaches; UpdateCaches;
@ -8280,13 +8169,6 @@ var
begin begin
inherited Create; inherited Create;
FWorksheets := TFPList.Create; FWorksheets := TFPList.Create;
FLog := TStringList.Create;
FFormatID := sfidUnknown;
FUnits := suMillimeters; // Units for column width and row height
FormatSettings := UTF8FormatSettings;
// FormatSettings.ShortDateFormat := MakeShortDateFormat(FormatSettings.ShortDateFormat);
// FormatSettings.LongDateFormat := MakeLongDateFormat(FormatSettings.ShortDateFormat);
FFontList := TFPList.Create; FFontList := TFPList.Create;
SetDefaultFont(DEFAULT_FONTNAME, DEFAULT_FONTSIZE); SetDefaultFont(DEFAULT_FONTNAME, DEFAULT_FONTSIZE);
@ -8302,7 +8184,6 @@ begin
// Protection // Protection
InitCryptoInfo(FCryptoInfo); InitCryptoInfo(FCryptoInfo);
FProtection := [];
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -8324,7 +8205,6 @@ begin
RemoveAllEmbeddedObj; RemoveAllEmbeddedObj;
FEmbeddedObjList.Free; FEmbeddedObjList.Free;
FLog.Free;
FreeAndNil(FSearchEngine); FreeAndNil(FSearchEngine);
inherited Destroy; inherited Destroy;
@ -8454,14 +8334,6 @@ begin
end; end;
end; end;
{@@ ----------------------------------------------------------------------------
Returns whether the workbook is protected
-------------------------------------------------------------------------------}
function TsWorkbook.IsProtected: Boolean;
begin
Result := (FProtection <> []);
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Reads the document from a file. It is assumed to have the given file format. Reads the document from a file. It is assumed to have the given file format.
@ -9044,7 +8916,7 @@ end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Returns the index of a worksheet in the worksheet list Returns the index of a worksheet in the worksheet list
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsWorkbook.GetWorksheetIndex(AWorksheet: TsWorksheet): Integer; function TsWorkbook.GetWorksheetIndex(AWorksheet: TsBasicWorksheet): Integer;
begin begin
Result := FWorksheets.IndexOf(AWorksheet); Result := FWorksheets.IndexOf(AWorksheet);
end; end;
@ -9609,7 +9481,7 @@ begin
AddFont(AFontName, ASize, [], scBlack) AddFont(AFontName, ASize, [], scBlack)
else else
for i:=0 to FBuiltinFontCount-1 do for i:=0 to FBuiltinFontCount-1 do
if (i <> 4) and (i < FFontList.Count) then if (i <> 4) and (i < FFontList.Count) then // wp: why if font #4 relevant here ????
with TsFont(FFontList[i]) do with TsFont(FFontList[i]) do
begin begin
FontName := AFontName; FontName := AFontName;
@ -9663,21 +9535,8 @@ end;
@return String with font name, font size etc. @return String with font name, font size etc.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsWorkbook.GetFontAsString(AIndex: Integer): String; function TsWorkbook.GetFontAsString(AIndex: Integer): String;
var
fnt: TsFont;
begin begin
fnt := GetFont(AIndex); Result := fpsUtils.GetFontAsString(GetFont(AIndex));
if fnt <> nil then begin
Result := Format('%s; size %.1g; %s', [
fnt.FontName, fnt.Size, GetColorName(fnt.Color)]);
if (fssBold in fnt.Style) then Result := Result + '; bold';
if (fssItalic in fnt.Style) then Result := Result + '; italic';
if (fssUnderline in fnt.Style) then Result := Result + '; underline';
if (fssStrikeout in fnt.Style) then result := Result + '; strikeout';
if fnt.Position = fpSubscript then Result := Result + '; subscript';
if fnt.Position = fpSuperscript then Result := Result + '; superscript';
end else
Result := '';
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -10200,42 +10059,6 @@ begin
FEmbeddedObjList.Clear; FEmbeddedObjList.Clear;
end; end;
{@@ ----------------------------------------------------------------------------
Adds a (simple) error message to an internal list
@param AMsg Error text to be stored in the list
-------------------------------------------------------------------------------}
procedure TsWorkbook.AddErrorMsg(const AMsg: String);
begin
FLog.Add(AMsg);
end;
{@@ ----------------------------------------------------------------------------
Adds an error message composed by means of format codes to an internal list
@param AMsg Error text to be stored in the list
@param Args Array of arguments to be used by the Format() function
-------------------------------------------------------------------------------}
procedure TsWorkbook.AddErrorMsg(const AMsg: String; const Args: Array of const);
begin
FLog.Add(Format(AMsg, Args));
end;
{@@ ----------------------------------------------------------------------------
Clears the internal error message list
-------------------------------------------------------------------------------}
procedure TsWorkbook.ClearErrorList;
begin
FLog.Clear;
end;
{@@ ----------------------------------------------------------------------------
Getter to retrieve the error messages collected during reading/writing
-------------------------------------------------------------------------------}
function TsWorkbook.GetErrorMsg: String;
begin
Result := FLog.Text;
end;
(* (*
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Converts a fpspreadsheet color into into a string RRGGBB. Converts a fpspreadsheet color into into a string RRGGBB.

131
components/fpspreadsheet/source/common/fpsreaderwriter.pas
View File

@ -23,7 +23,7 @@ interface
uses uses
Classes, Sysutils, Classes, Sysutils,
fpsTypes, fpsClasses, fpSpreadsheet; fpsTypes, fpsClasses;
type type
@ -31,16 +31,16 @@ type
TsBasicSpreadReaderWriter = class TsBasicSpreadReaderWriter = class
protected protected
{@@ Instance of the workbook which is currently being read or written. } {@@ Instance of the workbook which is currently being read or written. }
FWorkbook: TsWorkbook; FWorkbook: TsBasicWorkbook;
{@@ Instance of the worksheet which is currently being read or written. } {@@ Instance of the worksheet which is currently being read or written. }
FWorksheet: TsWorksheet; FWorksheet: TsBasicWorksheet;
{@@ Limitations for the specific data file format } {@@ Limitations for the specific data file format }
FLimitations: TsSpreadsheetFormatLimitations; FLimitations: TsSpreadsheetFormatLimitations;
public public
constructor Create(AWorkbook: TsWorkbook); virtual; // to allow descendents to override it constructor Create(AWorkbook: TsBasicWorkbook); virtual; // to allow descendents to override it
function Limitations: TsSpreadsheetFormatLimitations; function Limitations: TsSpreadsheetFormatLimitations;
{@@ Instance of the workbook which is currently being read/written. } {@@ Instance of the workbook which is currently being read/written. }
property Workbook: TsWorkbook read FWorkbook; property Workbook: TsBasicWorkbook read FWorkbook;
end; end;
{ TsBasicSpreadReader } { TsBasicSpreadReader }
@ -93,9 +93,9 @@ type
{ Helper methods } { Helper methods }
procedure AddBuiltinNumFormats; virtual; procedure AddBuiltinNumFormats; virtual;
{@@ Removes column records if all of them have the same column width } {@@ Removes column records if all of them have the same column width }
procedure FixCols(AWorksheet: TsWorksheet); procedure FixCols(AWorksheet: TsBasicWorksheet);
{@@ Removes row records if all of them have the same row height } {@@ Removes row records if all of them have the same row height }
procedure FixRows(AWorksheet: TsWorksheet); procedure FixRows(AWorksheet: TsBasicWorksheet);
{ Record reading methods } { Record reading methods }
{@@ Abstract method for reading a blank cell. Must be overridden by descendent classes. } {@@ Abstract method for reading a blank cell. Must be overridden by descendent classes. }
@ -110,7 +110,7 @@ type
procedure ReadNumber(AStream: TStream); virtual; abstract; procedure ReadNumber(AStream: TStream); virtual; abstract;
public public
constructor Create(AWorkbook: TsWorkbook); override; constructor Create(AWorkbook: TsBasicWorkbook); override;
destructor Destroy; override; destructor Destroy; override;
{ General writing methods } { General writing methods }
@ -148,7 +148,7 @@ type
function FindNumFormatInList(ANumFormatStr: String): Integer; function FindNumFormatInList(ANumFormatStr: String): Integer;
// function FixColor(AColor: TsColor): TsColor; virtual; // function FixColor(AColor: TsColor): TsColor; virtual;
procedure FixFormat(ACell: PCell); virtual; procedure FixFormat(ACell: PCell); virtual;
procedure GetSheetDimensions(AWorksheet: TsWorksheet; procedure GetSheetDimensions(AWorksheet: TsBasicWorksheet;
out AFirstRow, ALastRow, AFirstCol, ALastCol: Cardinal); virtual; out AFirstRow, ALastRow, AFirstCol, ALastCol: Cardinal); virtual;
procedure ListAllNumFormats; virtual; procedure ListAllNumFormats; virtual;
@ -174,7 +174,7 @@ type
const AValue: double; ACell: PCell); virtual; abstract; const AValue: double; ACell: PCell); virtual; abstract;
public public
constructor Create(AWorkbook: TsWorkbook); override; constructor Create(AWorkbook: TsBasicWorkbook); override;
destructor Destroy; override; destructor Destroy; override;
{ General writing methods } { General writing methods }
@ -219,7 +219,7 @@ implementation
uses uses
Math, LazUTF8, Math, LazUTF8,
fpsStrings, fpsUtils, fpsNumFormat, fpsStreams; fpsStrings, fpsUtils, fpsNumFormat, fpsStreams, fpspreadsheet;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
@ -234,7 +234,7 @@ uses
file is written. This parameter is passed from the workbook file is written. This parameter is passed from the workbook
which creates the reader/writer. which creates the reader/writer.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
constructor TsBasicSpreadReaderWriter.Create(AWorkbook: TsWorkbook); constructor TsBasicSpreadReaderWriter.Create(AWorkbook: TsBasicWorkbook);
begin begin
inherited Create; inherited Create;
FWorkbook := AWorkbook; FWorkbook := AWorkbook;
@ -264,24 +264,27 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsBasicSpreadWriter.CheckLimitations; procedure TsBasicSpreadWriter.CheckLimitations;
var var
workbook: TsWorkbook;
lastCol, lastRow: Cardinal; lastCol, lastRow: Cardinal;
i: Integer; i: Integer;
sheet: TsWorksheet; sheet: TsWorksheet;
begin begin
Workbook.GetLastRowColIndex(lastRow, lastCol); workbook := FWorkbook as TsWorkbook;
workbook.GetLastRowColIndex(lastRow, lastCol);
// Check row count // Check row count
if lastRow >= FLimitations.MaxRowCount then if lastRow >= FLimitations.MaxRowCount then
Workbook.AddErrorMsg(rsMaxRowsExceeded, [lastRow+1, FLimitations.MaxRowCount]); workbook.AddErrorMsg(rsMaxRowsExceeded, [lastRow+1, FLimitations.MaxRowCount]);
// Check column count // Check column count
if lastCol >= FLimitations.MaxColCount then if lastCol >= FLimitations.MaxColCount then
Workbook.AddErrorMsg(rsMaxColsExceeded, [lastCol+1, FLimitations.MaxColCount]); workbook.AddErrorMsg(rsMaxColsExceeded, [lastCol+1, FLimitations.MaxColCount]);
// Check worksheet names // Check worksheet names
for i:=0 to Workbook.GetWorksheetCount-1 do for i:=0 to workbook.GetWorksheetCount-1 do
begin begin
sheet := Workbook.GetWorksheetByIndex(i); sheet := workbook.GetWorksheetByIndex(i);
if UTF8Length(sheet.Name) > FLimitations.MaxSheetNameLength then if UTF8Length(sheet.Name) > FLimitations.MaxSheetNameLength then
// Worksheet name is too long. // Worksheet name is too long.
// We abort saving here because it is not safe to chop the sheet name // We abort saving here because it is not safe to chop the sheet name
@ -306,7 +309,7 @@ end;
This parameter is passed from the workbook which creates This parameter is passed from the workbook which creates
the reader. the reader.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
constructor TsCustomSpreadReader.Create(AWorkbook: TsWorkbook); constructor TsCustomSpreadReader.Create(AWorkbook: TsBasicWorkbook);
begin begin
inherited Create(AWorkbook); inherited Create(AWorkbook);
// Font list // Font list
@ -316,7 +319,7 @@ begin
AddBuiltinNumFormats; AddBuiltinNumFormats;
// Virtual mode // Virtual mode
FIsVirtualMode := (boVirtualMode in FWorkbook.Options) and FIsVirtualMode := (boVirtualMode in FWorkbook.Options) and
Assigned(FWorkbook.OnReadCellData); Assigned((FWorkbook as TsWorkbook).OnReadCellData);
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -353,10 +356,11 @@ end;
@param AWorksheet The columns in this worksheet are processed. @param AWorksheet The columns in this worksheet are processed.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsCustomSpreadReader.FixCols(AWorkSheet: TsWorksheet); procedure TsCustomSpreadReader.FixCols(AWorkSheet: TsBasicWorksheet);
const const
EPS = 1E-3; EPS = 1E-3;
var var
sheet: TsWorksheet absolute AWorksheet;
c: LongInt; c: LongInt;
w: Single; w: Single;
lCol: PCol; lCol: PCol;
@ -365,30 +369,30 @@ begin
// If the count of columns is equal to the max colcount of the file format // If the count of columns is equal to the max colcount of the file format
// then it is likely that dummy columns have been added -> delete all empty // then it is likely that dummy columns have been added -> delete all empty
// columns (starting at the right) until the first non-empty column is found // columns (starting at the right) until the first non-empty column is found
if AWorksheet.Cols.Count = SizeInt(FLimitations.MaxColCount) then if sheet.Cols.Count = SizeInt(FLimitations.MaxColCount) then
begin begin
c := AWorksheet.Cols.Count - 1; c := sheet.Cols.Count - 1;
lCol := PCol(AWorksheet.Cols[c]); lCol := PCol(sheet.Cols[c]);
w := lCol.Width; w := lCol.Width;
while c >= 0 do begin while c >= 0 do begin
lCol := PCol(AWorksheet.Cols[c]); lCol := PCol(sheet.Cols[c]);
if not SameValue(lCol^.Width, w, EPS) then if not SameValue(lCol^.Width, w, EPS) then
break; break;
if AWorksheet.FindNextCellInCol(0, c) <> nil then if sheet.FindNextCellInCol(0, c) <> nil then
break; break;
AWorksheet.RemoveCol(c); sheet.RemoveCol(c);
dec(c); dec(c);
end; end;
end; end;
if AWorksheet.Cols.Count < 2 then if sheet.Cols.Count < 2 then
exit; exit;
// Check whether all columns have the same column width // Check whether all columns have the same column width
sameWidth := true; sameWidth := true;
w := PCol(AWorksheet.Cols[0])^.Width; w := PCol(sheet.Cols[0])^.Width;
for c := 1 to AWorksheet.Cols.Count-1 do begin for c := 1 to sheet.Cols.Count-1 do begin
lCol := PCol(AWorksheet.Cols[c]); lCol := PCol(sheet.Cols[c]);
if not SameValue(lCol^.Width, w, EPS) then if not SameValue(lCol^.Width, w, EPS) then
begin begin
sameWidth := false; sameWidth := false;
@ -399,12 +403,12 @@ begin
if sameWidth then begin if sameWidth then begin
// At this point we know that all columns have the same width. We pass this // At this point we know that all columns have the same width. We pass this
// to the DefaultColWidth ... // to the DefaultColWidth ...
AWorksheet.WriteDefaultColWidth(w, FWorkbook.Units); sheet.WriteDefaultColWidth(w, FWorkbook.Units);
// ...and delete all column records with non-default format // ...and delete all column records with non-default format
for c := AWorksheet.Cols.Count-1 downto 0 do begin for c := sheet.Cols.Count-1 downto 0 do begin
lCol := PCol(AWorksheet.Cols[c]); lCol := PCol(sheet.Cols[c]);
if lCol^.FormatIndex = 0 then AWorksheet.RemoveCol(c); if lCol^.FormatIndex = 0 then sheet.RemoveCol(c);
end; end;
end; end;
end; end;
@ -414,21 +418,22 @@ end;
row records if they do. Such unnecessary row records are often written row records if they do. Such unnecessary row records are often written
when an Office application converts a file to another format. when an Office application converts a file to another format.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsCustomSpreadReader.FixRows(AWorkSheet: TsWorksheet); procedure TsCustomSpreadReader.FixRows(AWorkSheet: TsBasicWorksheet);
const const
EPS = 1E-3; EPS = 1E-3;
var var
sheet: TsWorksheet absolute AWorksheet;
r, rLast: Cardinal; r, rLast: Cardinal;
h: Single; h: Single;
lRow: PRow; lRow: PRow;
begin begin
if AWorksheet.Rows.Count <= 1 then if sheet.Rows.Count <= 1 then
exit; exit;
// Check whether all rows have the same height // Check whether all rows have the same height
h := PRow(AWorksheet.Rows[0])^.Height; h := PRow(sheet.Rows[0])^.Height;
for r := 1 to AWorksheet.Rows.Count-1 do begin for r := 1 to sheet.Rows.Count-1 do begin
lRow := PRow(AWorksheet.Rows[r]); lRow := PRow(sheet.Rows[r]);
if not SameValue(lRow^.Height, h, EPS) then if not SameValue(lRow^.Height, h, EPS) then
exit; exit;
end; end;
@ -436,21 +441,21 @@ begin
// If there are more rows than row records and the common row height is not // If there are more rows than row records and the common row height is not
// the default row height (i.e. the row height of the non-record rows) then // the default row height (i.e. the row height of the non-record rows) then
// the row heights are different // the row heights are different
rLast := AWorksheet.GetLastRowIndex; rLast := sheet.GetLastRowIndex;
if (AWorksheet.Rows.Count > 0) and if (sheet.Rows.Count > 0) and
(rLast <> PRow(AWorksheet.Rows[AWorksheet.Rows.Count-1]).Row) and (rLast <> PRow(sheet.Rows[sheet.Rows.Count-1]).Row) and
not SameValue(h, AWorksheet.ReadDefaultRowHeight(FWorkbook.Units), EPS) not SameValue(h, sheet.ReadDefaultRowHeight(FWorkbook.Units), EPS)
then then
exit; exit;
// At this point we know that all rows have the same height. We pass this // At this point we know that all rows have the same height. We pass this
// to the DefaultRowHeight ... // to the DefaultRowHeight ...
AWorksheet.WriteDefaultRowHeight(h, FWorkbook.Units); sheet.WriteDefaultRowHeight(h, FWorkbook.Units);
// ... and delete all row records with default format. // ... and delete all row records with default format.
for r := AWorksheet.Rows.Count-1 downto 0 do begin for r := sheet.Rows.Count-1 downto 0 do begin
lRow := PRow(AWorksheet.Rows[r]); lRow := PRow(sheet.Rows[r]);
if lRow^.FormatIndex = 0 then AWorksheet.RemoveRow(r); if lRow^.FormatIndex = 0 then sheet.RemoveRow(r);
end; end;
end; end;
@ -549,7 +554,7 @@ end;
@param AWorkbook Workbook from with the file is written. This parameter is @param AWorkbook Workbook from with the file is written. This parameter is
passed from the workbook which creates the writer. passed from the workbook which creates the writer.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
constructor TsCustomSpreadWriter.Create(AWorkbook: TsWorkbook); constructor TsCustomSpreadWriter.Create(AWorkbook: TsBasicWorkbook);
begin begin
inherited Create(AWorkbook); inherited Create(AWorkbook);
// Number formats // Number formats
@ -616,26 +621,32 @@ end;
@param AFirstCol Index of first column to be written @param AFirstCol Index of first column to be written
@param ALastCol Index of last column to be written @param ALastCol Index of last column to be written
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsCustomSpreadWriter.GetSheetDimensions(AWorksheet: TsWorksheet; procedure TsCustomSpreadWriter.GetSheetDimensions(AWorksheet: TsBasicWorksheet;
out AFirstRow, ALastRow, AFirstCol, ALastCol: Cardinal); out AFirstRow, ALastRow, AFirstCol, ALastCol: Cardinal);
var
book: TsWorkbook;
sheet: TsWorksheet;
begin begin
if (boVirtualMode in AWorksheet.Workbook.Options) then book := FWorkbook as TsWorkbook;
sheet := AWorksheet as TsWorksheet;
if (boVirtualMode in sheet.Workbook.Options) then
begin begin
AFirstRow := 0; AFirstRow := 0;
AFirstCol := 0; AFirstCol := 0;
ALastRow := LongInt(AWorksheet.VirtualRowCount)-1; ALastRow := LongInt(sheet.VirtualRowCount)-1;
ALastCol := LongInt(AWorksheet.VirtualColCount)-1; ALastCol := LongInt(sheet.VirtualColCount)-1;
end else end else
begin begin
Workbook.UpdateCaches; book.UpdateCaches;
AFirstRow := AWorksheet.GetFirstRowIndex; AFirstRow := sheet.GetFirstRowIndex;
if AFirstRow = Cardinal(-1) then if AFirstRow = Cardinal(-1) then
AFirstRow := 0; // this happens if the sheet is empty and does not contain row records AFirstRow := 0; // this happens if the sheet is empty and does not contain row records
AFirstCol := AWorksheet.GetFirstColIndex; AFirstCol := sheet.GetFirstColIndex;
if AFirstCol = Cardinal(-1) then if AFirstCol = Cardinal(-1) then
AFirstCol := 0; // this happens if the sheet is empty and does not contain col records AFirstCol := 0; // this happens if the sheet is empty and does not contain col records
ALastRow := AWorksheet.GetLastRowIndex; ALastRow := sheet.GetLastRowIndex;
ALastCol := AWorksheet.GetLastColIndex; ALastCol := sheet.GetLastColIndex;
end; end;
if AFirstCol >= Limitations.MaxColCount then if AFirstCol >= Limitations.MaxColCount then
AFirstCol := Limitations.MaxColCount-1; AFirstCol := Limitations.MaxColCount-1;
@ -657,9 +668,9 @@ var
numFmt: TsNumFormatParams; numFmt: TsNumFormatParams;
numFmtStr: String; numFmtStr: String;
begin begin
for i:=0 to Workbook.GetNumberFormatCount - 1 do for i:=0 to TsWorkbook(Workbook).GetNumberFormatCount - 1 do
begin begin
numFmt := Workbook.GetNumberFormat(i); numFmt := TsWorkbook(Workbook).GetNumberFormat(i);
if numFmt <> nil then if numFmt <> nil then
begin begin
numFmtStr := numFmt.NumFormatStr; numFmtStr := numFmt.NumFormatStr;
@ -699,7 +710,7 @@ begin
WriteLabel(AStream, ACell^.Row, ACell^.Col, ACell^.UTF8StringValue, ACell); WriteLabel(AStream, ACell^.Row, ACell^.Col, ACell^.UTF8StringValue, ACell);
end; end;
if FWorksheet.ReadComment(ACell) <> '' then if TsWorksheet(FWorksheet).ReadComment(ACell) <> '' then
WriteComment(AStream, ACell); WriteComment(AStream, ACell);
end; end;

248
components/fpspreadsheet/source/common/fpstypes.pas
View File

@ -23,6 +23,10 @@ type
{$ENDIF} {$ENDIF}
type type
{ Forward declarations }
TsBasicWorksheet = class;
TsBasicWorkbook = class;
{@@ Built-in file formats of fpspreadsheet } {@@ Built-in file formats of fpspreadsheet }
TsSpreadsheetFormat = (sfExcel2, sfExcel5, sfExcel8, sfExcelXML, sfOOXML, TsSpreadsheetFormat = (sfExcel2, sfExcel5, sfExcel8, sfExcelXML, sfOOXML,
sfOpenDocument, sfCSV, sfHTML, sfWikiTable_Pipes, sfWikiTable_WikiMedia, sfOpenDocument, sfCSV, sfHTML, sfWikiTable_Pipes, sfWikiTable_WikiMedia,
@ -732,7 +736,7 @@ type
{ Location of the cell } { Location of the cell }
Row: Cardinal; // zero-based Row: Cardinal; // zero-based
Col: Cardinal; // zero-based Col: Cardinal; // zero-based
Worksheet: Pointer; // Must be cast to TsWorksheet when used (avoids circular unit reference) Worksheet: TsBasicWorksheet; // Must be cast to TsWorksheet when used (avoids circular unit reference)
{ Status flags } { Status flags }
Flags: TsCellFlags; Flags: TsCellFlags;
{ Index of format record in the workbook's CellFormatList } { Index of format record in the workbook's CellFormatList }
@ -874,6 +878,124 @@ type
TsStreamParam = (spClipboard, spWindowsClipboardHTML); TsStreamParam = (spClipboard, spWindowsClipboardHTML);
TsStreamParams = set of TsStreamParam; TsStreamParams = set of TsStreamParam;
{@@ Worksheet user interface options:
@param soShowGridLines Show or hide the grid lines in the spreadsheet
@param soShowHeaders Show or hide the column or row headers of the
spreadsheet
@param soHasFrozenPanes If set a number of rows and columns of the
spreadsheet is fixed and does not scroll. The number
is defined by LeftPaneWidth and TopPaneHeight.
@param soHidden Worksheet is hidden.
@param soProtected Worksheet is protected
@param soPanesProtection Panes are locked due to workbook protection }
TsSheetOption = (soShowGridLines, soShowHeaders, soHasFrozenPanes, soHidden,
soProtected, soPanesProtection);
{@@ Set of user interface options
@ see TsSheetOption }
TsSheetOptions = set of TsSheetOption;
{@@ Option flags for the workbook
@param boVirtualMode If in virtual mode date are not taken from cells
when a spreadsheet is written to file, but are
provided by means of the event OnWriteCellData.
Similarly, when data are read they are not added
as cells but passed the the event OnReadCellData;
@param boBufStream When this option is set a buffered stream is used
for writing (a memory stream swapping to disk) or
reading (a file stream pre-reading chunks of data
to memory)
@param boFileStream Uses file streams and temporary files during
reading and writing. Lowest memory consumptions,
but slow.
@param boAutoCalc Automatically recalculate formulas whenever a
cell value changes.
@param boCalcBeforeSaving Calculates formulas before saving the file.
Otherwise there are no results when the file is
loaded back by fpspreadsheet.
@param boReadFormulas Allows to turn off reading of rpn formulas; this
is a precaution since formulas not correctly
implemented by fpspreadsheet could crash the
reading operation.
@param boWriteZoomfactor Instructs the writer to write the current zoom
factors of the worksheets to file.
@param boAbortReadOnFormulaError Aborts reading if a formula error is
encountered
@param boIgnoreFormulas Formulas are not checked and not calculated.
Cannot be used for biff formats. }
TsWorkbookOption = (boVirtualMode, boBufStream, boFileStream,
boAutoCalc, boCalcBeforeSaving, boReadFormulas, boWriteZoomFactor,
boAbortReadOnFormulaError, boIgnoreFormulas);
{@@ Set of option flags for the workbook }
TsWorkbookOptions = set of TsWorkbookOption;
{@@ Basic worksheet class to avoid circular unit references. It has only those
properties and methods which do not require any other unit than fpstypes. }
TsBasicWorksheet = class
protected
FName: String; // Name of the worksheet (displayed at the tab)
FOptions: TsSheetOptions;
FProtection: TsWorksheetProtections;
procedure SetName(const AName: String); virtual; abstract;
public
constructor Create;
function HasHyperlink(ACell: PCell): Boolean;
function IsProtected: Boolean;
{@@ Name of the sheet. In the popular spreadsheet applications this is
displayed in the tab of the sheet. }
property Name: string read FName write SetName;
{@@ Parameters controlling visibility of grid lines and row/column headers,
usage of frozen panes etc. }
property Options: TsSheetOptions read FOptions write FOptions;
{@@ Worksheet protection options }
property Protection: TsWorksheetProtections read FProtection write FProtection;
end;
{@@ Basic worksheet class to avoid circular unit references. It contains only
those properties and methods which do not require any other unit than
fpstypes. }
TsBasicWorkbook = class
private
FLog: TStringList;
function GetErrorMsg: String;
protected
FFileName: String;
FFormatID: TsSpreadFormatID;
FOptions: TsWorkbookOptions;
FProtection: TsWorkbookProtections;
FUnits: TsSizeUnits;
public
{@@ A copy of SysUtil's DefaultFormatSettings (converted to UTF8) to provide
some kind of localization to some formatting strings.
Can be modified before loading/writing files }
FormatSettings: TFormatSettings;
constructor Create;
destructor Destroy; override;
{ Error messages }
procedure AddErrorMsg(const AMsg: String); overload;
procedure AddErrorMsg(const AMsg: String; const Args: array of const); overload;
procedure ClearErrorList; inline;
{ Protection }
function IsProtected: Boolean;
{@@ Retrieves error messages collected during reading/writing }
property ErrorMsg: String read GetErrorMsg;
{@@ Identifies the file format which was detected when reading the file }
property FileFormatID: TsSpreadFormatID read FFormatID;
{@@ Filename of the saved workbook }
property FileName: String read FFileName;
{@@ Option flags for the workbook - see boXXXX declarations }
property Options: TsWorkbookOptions read FOptions write FOptions;
{@@ Workbook protection flags }
property Protection: TsWorkbookProtections read FProtection write FProtection;
{@@ Units of row heights and column widths }
property Units: TsSizeUnits read FUnits;
end;
{@@ Exception types for fpspreadsheet } {@@ Exception types for fpspreadsheet }
EFpSpreadsheet = class(Exception); EFpSpreadsheet = class(Exception);
EFpSpreadsheetReader = class(EFpSpreadsheet); EFpSpreadsheetReader = class(EFpSpreadsheet);
@ -892,6 +1014,10 @@ const
HEADER_FOOTER_INDEX_EVEN = 2; HEADER_FOOTER_INDEX_EVEN = 2;
HEADER_FOOTER_INDEX_ALL = 1; HEADER_FOOTER_INDEX_ALL = 1;
var
{@@ FPC format settings for which all strings have been converted to UTF8 }
UTF8FormatSettings: TFormatSettings;
implementation implementation
@ -914,5 +1040,125 @@ begin
Position := AFont.Position; Position := AFont.Position;
end; end;
{-------------------------------------------------------------------------------
sBasicWorksheet
-------------------------------------------------------------------------------}
constructor TsBasicWorksheet.Create;
begin
inherited;
FProtection := DEFAULT_SHEET_PROTECTION;
end;
{@@ ----------------------------------------------------------------------------
Checks whether the specified cell contains a hyperlink
-------------------------------------------------------------------------------}
function TsBasicWorksheet.HasHyperlink(ACell: PCell): Boolean;
begin
Result := (ACell <> nil) and (cfHyperlink in ACell^.Flags);
end;
{@@ ----------------------------------------------------------------------------
Returns whether the worksheet is protected
-------------------------------------------------------------------------------}
function TsBasicWorksheet.IsProtected: Boolean;
begin
Result := soProtected in FOptions;
end;
{-------------------------------------------------------------------------------
TsBasicWorkbook
-------------------------------------------------------------------------------}
constructor TsBasicWorkbook.Create;
begin
inherited;
FormatSettings := UTF8FormatSettings;
FUnits := suMillimeters; // Units for column width and row height
FFormatID := sfidUnknown;
FLog := TStringList.Create;
FProtection := [];
end;
destructor TsBasicWorkbook.Destroy;
begin
FLog.Free;
inherited;
end;
{@@ ----------------------------------------------------------------------------
Adds a (simple) error message to an internal list
@param AMsg Error text to be stored in the list
-------------------------------------------------------------------------------}
procedure TsBasicWorkbook.AddErrorMsg(const AMsg: String);
begin
FLog.Add(AMsg);
end;
{@@ ----------------------------------------------------------------------------
Adds an error message composed by means of format codes to an internal list
@param AMsg Error text to be stored in the list
@param Args Array of arguments to be used by the Format() function
-------------------------------------------------------------------------------}
procedure TsBasicWorkbook.AddErrorMsg(const AMsg: String;
const Args: Array of const);
begin
FLog.Add(Format(AMsg, Args));
end;
{@@ ----------------------------------------------------------------------------
Clears the internal error message list
-------------------------------------------------------------------------------}
procedure TsBasicWorkbook.ClearErrorList;
begin
FLog.Clear;
end;
{@@ ----------------------------------------------------------------------------
Getter to retrieve the error messages collected during reading/writing
-------------------------------------------------------------------------------}
function TsBasicWorkbook.GetErrorMsg: String;
begin
Result := FLog.Text;
end;
{@@ ----------------------------------------------------------------------------
Returns whether the workbook is protected
-------------------------------------------------------------------------------}
function TsBasicWorkbook.IsProtected: Boolean;
begin
Result := (FProtection <> []);
end;
{@@ ----------------------------------------------------------------------------
Creates a FPC format settings record in which all strings are encoded as
UTF8.
-------------------------------------------------------------------------------}
procedure InitUTF8FormatSettings;
// remove when available in LazUtils
var
i: Integer;
begin
UTF8FormatSettings := DefaultFormatSettings;
UTF8FormatSettings.CurrencyString := AnsiToUTF8(DefaultFormatSettings.CurrencyString);
for i:=1 to 12 do begin
UTF8FormatSettings.LongMonthNames[i] := AnsiToUTF8(DefaultFormatSettings.LongMonthNames[i]);
UTF8FormatSettings.ShortMonthNames[i] := AnsiToUTF8(DefaultFormatSettings.ShortMonthNames[i]);
end;
for i:=1 to 7 do begin
UTF8FormatSettings.LongDayNames[i] := AnsiToUTF8(DefaultFormatSettings.LongDayNames[i]);
UTF8FormatSettings.ShortDayNames[i] := AnsiToUTF8(DefaultFormatSettings.ShortDayNames[i]);
end;
end;
initialization
InitUTF8FormatSettings;
end. end.

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

@ -18,7 +18,7 @@ unit fpsutils;
interface interface
uses uses
Classes, SysUtils, TypInfo, //StrUtils, Classes, SysUtils, TypInfo,
fpstypes; fpstypes;
// Exported types // Exported types
@ -194,7 +194,8 @@ procedure SplitHyperlink(AValue: String; out ATarget, ABookmark: String);
procedure FixHyperlinkPathDelims(var ATarget: String); procedure FixHyperlinkPathDelims(var ATarget: String);
procedure InitCell(out ACell: TCell); overload; procedure InitCell(out ACell: TCell); overload;
procedure InitCell(AWorksheet: Pointer; ARow, ACol: Cardinal; out ACell: TCell); overload; procedure InitCell(AWorksheet: TsBasicWorksheet; ARow, ACol: Cardinal;
out ACell: TCell); overload;
procedure InitCryptoInfo(out AValue: TsCryptoInfo); procedure InitCryptoInfo(out AValue: TsCryptoInfo);
procedure InitFormatRecord(out AValue: TsCellFormat); procedure InitFormatRecord(out AValue: TsCellFormat);
procedure InitImageRecord(out AValue: TsImage; ARow, ACol: Cardinal; procedure InitImageRecord(out AValue: TsImage; ARow, ACol: Cardinal;
@ -210,6 +211,8 @@ function SameFont(AFont: TsFont; AFontName: String; AFontSize: Single;
function Range(ARow1, ACol1, ARow2, ACol2: Cardinal): TsCellRange; function Range(ARow1, ACol1, ARow2, ACol2: Cardinal): TsCellRange;
function GetFontAsString(AFont: TsFont): String;
//function GetUniqueTempDir(Global: Boolean): String; //function GetUniqueTempDir(Global: Boolean): String;
procedure AppendToStream(AStream: TStream; const AString: String); inline; overload; procedure AppendToStream(AStream: TStream; const AString: String); inline; overload;
@ -226,9 +229,6 @@ var
for conversion of distances to pixels} for conversion of distances to pixels}
ScreenPixelsPerInch: Integer = 96; ScreenPixelsPerInch: Integer = 96;
{@@ FPC format settings for which all strings have been converted to UTF8 }
UTF8FormatSettings: TFormatSettings;
implementation implementation
@ -2348,7 +2348,8 @@ end;
@param ACol Column index of the new cell @param ACol Column index of the new cell
@return New cell record with row and column fields preset to passed values. @return New cell record with row and column fields preset to passed values.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure InitCell(AWorksheet: Pointer; ARow, ACol: Cardinal; out ACell: TCell); procedure InitCell(AWorksheet: TsbasicWorksheet;
ARow, ACol: Cardinal; out ACell: TCell);
begin begin
InitCell(ACell); InitCell(ACell);
ACell.Worksheet := AWorksheet; ACell.Worksheet := AWorksheet;
@ -2552,6 +2553,26 @@ begin
end; end;
end; end;
{@@ ----------------------------------------------------------------------------
Combines the relevant font properties into a string
-------------------------------------------------------------------------------}
function GetFontAsString(AFont: TsFont): String;
begin
if AFont = nil then
Result := ''
else begin
Result := Format('%s; size %.1g; %s', [
AFont.FontName, AFont.Size, GetColorName(AFont.Color)]);
if (fssBold in AFont.Style) then Result := Result + '; bold';
if (fssItalic in AFont.Style) then Result := Result + '; italic';
if (fssUnderline in AFont.Style) then Result := Result + '; underline';
if (fssStrikeout in AFont.Style) then result := Result + '; strikeout';
if AFont.Position = fpSubscript then Result := Result + '; subscript';
if AFont.Position = fpSuperscript then Result := Result + '; superscript';
end;
end;
(* (*
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Constructs a string of length "Len" containing random uppercase characters Constructs a string of length "Len" containing random uppercase characters
@ -2838,30 +2859,5 @@ end;
{$POP} {$POP}
{@@ ----------------------------------------------------------------------------
Creates a FPC format settings record in which all strings are encoded as
UTF8.
-------------------------------------------------------------------------------}
procedure InitUTF8FormatSettings;
// remove when available in LazUtils
var
i: Integer;
begin
UTF8FormatSettings := DefaultFormatSettings;
UTF8FormatSettings.CurrencyString := AnsiToUTF8(DefaultFormatSettings.CurrencyString);
for i:=1 to 12 do begin
UTF8FormatSettings.LongMonthNames[i] := AnsiToUTF8(DefaultFormatSettings.LongMonthNames[i]);
UTF8FormatSettings.ShortMonthNames[i] := AnsiToUTF8(DefaultFormatSettings.ShortMonthNames[i]);
end;
for i:=1 to 7 do begin
UTF8FormatSettings.LongDayNames[i] := AnsiToUTF8(DefaultFormatSettings.LongDayNames[i]);
UTF8FormatSettings.ShortDayNames[i] := AnsiToUTF8(DefaultFormatSettings.ShortDayNames[i]);
end;
end;
initialization
InitUTF8FormatSettings;
end. end.

8
components/fpspreadsheet/source/common/fpsxmlcommon.pas
View File

@ -15,7 +15,7 @@ uses
{$ELSE} {$ELSE}
fpszipper, fpszipper,
{$ENDIF} {$ENDIF}
fpSpreadsheet, fpsreaderwriter; fpstypes, fpsreaderwriter;
type type
TsSpreadXMLReader = class(TsCustomSpreadReader) TsSpreadXMLReader = class(TsCustomSpreadReader)
@ -53,7 +53,8 @@ procedure UnzipFile(AZipFileName, AZippedFile, ADestFolder: String);
function UnzipToStream(AZipStream: TStream; const AZippedFile: String; function UnzipToStream(AZipStream: TStream; const AZippedFile: String;
ADestStream: TStream): Boolean; ADestStream: TStream): Boolean;
function CreateTempStream(AWorkbook: TsWorkbook; AFileNameBase: String): TStream; function CreateTempStream(AWorkbook: TsBasicWorkbook;
AFileNameBase: String): TStream;
procedure DestroyTempStream(AStream: TStream); procedure DestroyTempStream(AStream: TStream);
@ -379,7 +380,8 @@ end;
In the latter two cases a filename mask is provided to create a temporary In the latter two cases a filename mask is provided to create a temporary
filename around this mask. filename around this mask.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function CreateTempStream(AWorkbook: TsWorkbook; AFilenameBase: String): TStream; function CreateTempStream(AWorkbook: TsBasicWorkbook;
AFilenameBase: String): TStream;
begin begin
if boFileStream in AWorkbook.Options then if boFileStream in AWorkbook.Options then
Result := TFileStream.Create(GetTempFileName('', AFilenameBase), fmCreate) Result := TFileStream.Create(GetTempFileName('', AFilenameBase), fmCreate)

66
components/fpspreadsheet/source/common/wikitable.pas
View File

@ -31,7 +31,7 @@ interface
uses uses
Classes, SysUtils, Classes, SysUtils,
fpimage, fgl, lconvencoding, fpimage, fgl, lconvencoding,
fpsTypes, fpSpreadsheet, fpsUtils, fpsReaderWriter; fpsTypes, fpsUtils, fpsReaderWriter;
type type
@ -52,10 +52,10 @@ type
TWikiTableTokenizer = class TWikiTableTokenizer = class
private private
FWorkbook: TsWorkbook; FWorkbook: TsBasicWorkbook;
public public
Tokens: TWikiTableTokenList; Tokens: TWikiTableTokenList;
constructor Create(AWorkbook: TsWorkbook); virtual; constructor Create(AWorkbook: TsBasicWorkbook); virtual;
destructor Destroy; override; destructor Destroy; override;
procedure Clear; procedure Clear;
function AddToken(AValue: string): TWikiTableToken; function AddToken(AValue: string): TWikiTableToken;
@ -79,7 +79,7 @@ type
TsWikiTable_PipesReader = class(TsWikiTableReader) TsWikiTable_PipesReader = class(TsWikiTableReader)
public public
constructor Create(AWorkbook: TsWorkbook); override; constructor Create(AWorkbook: TsBasicWorkbook); override;
end; end;
@ -98,7 +98,7 @@ type
TsWikiTable_WikiMediaWriter = class(TsWikiTableWriter) TsWikiTable_WikiMediaWriter = class(TsWikiTableWriter)
public public
constructor Create(AWorkbook: TsWorkbook); override; constructor Create(AWorkbook: TsBasicWorkbook); override;
end; end;
@ -110,12 +110,12 @@ var
implementation implementation
uses uses
fpsStrings, fpsXMLCommon; fpsStrings, fpsXMLCommon, fpSpreadsheet;
{ TWikiTableTokenizer } { TWikiTableTokenizer }
constructor TWikiTableTokenizer.Create(AWorkbook: TsWorkbook); constructor TWikiTableTokenizer.Create(AWorkbook: TsBasicWorkbook);
begin begin
inherited Create; inherited Create;
FWorkbook := AWorkbook; FWorkbook := AWorkbook;
@ -321,7 +321,7 @@ var
lLineSplitter: TWikiTableTokenizer; lLineSplitter: TWikiTableTokenizer;
lCurToken: TWikiTableToken; lCurToken: TWikiTableToken;
begin begin
FWorksheet := FWorkbook.AddWorksheet('Table', true); FWorksheet := (FWorkbook as TsWorkbook).AddWorksheet('Table', true);
lLineSplitter := TWikiTableTokenizer.Create(FWorkbook); lLineSplitter := TWikiTableTokenizer.Create(FWorkbook);
try try
for i := 0 to AStrings.Count-1 do for i := 0 to AStrings.Count-1 do
@ -331,11 +331,11 @@ begin
for j := 0 to lLineSplitter.Tokens.Count-1 do for j := 0 to lLineSplitter.Tokens.Count-1 do
begin begin
lCurToken := lLineSplitter.Tokens[j]; lCurToken := lLineSplitter.Tokens[j];
FWorksheet.WriteText(i, j, lCurToken.Value); (FWorksheet as TsWorksheet).WriteText(i, j, lCurToken.Value);
if lCurToken.Bold then if lCurToken.Bold then
FWorksheet.WriteFontStyle(i, j, [fssBold]); (FWorksheet as TsWorksheet).WriteFontStyle(i, j, [fssBold]);
if lCurToken.UseBackgroundColor then if lCurToken.UseBackgroundColor then
FWorksheet.WriteBackgroundColor(i, j, lCurToken.BackgroundColor); (FWorksheet as TsWorksheet).WriteBackgroundColor(i, j, lCurToken.BackgroundColor);
end; end;
end; end;
finally finally
@ -346,7 +346,7 @@ end;
{ TsWikiTable_PipesReader } { TsWikiTable_PipesReader }
constructor TsWikiTable_PipesReader.Create(AWorkbook: TsWorkbook); constructor TsWikiTable_PipesReader.Create(AWorkbook: TsBasicWorkbook);
begin begin
inherited Create(AWorkbook); inherited Create(AWorkbook);
SubFormat := sfWikiTable_Pipes; SubFormat := sfWikiTable_Pipes;
@ -420,25 +420,27 @@ var
borders: TsCellBorders; borders: TsCellBorders;
fs: TFormatSettings; fs: TFormatSettings;
fmt: PsCellFormat; fmt: PsCellFormat;
sheet: TsWorksheet;
begin begin
FWorksheet := Workbook.GetFirstWorksheet(); FWorksheet := (Workbook as TsWorkbook).GetFirstWorksheet();
FWorksheet.UpdateCaches; sheet := FWorksheet as TsWorksheet;
sheet.UpdateCaches;
fs := FWorksheet.FormatSettings; fs := sheet.FormatSettings;
fs.DecimalSeparator := '.'; fs.DecimalSeparator := '.';
fs.ThousandSeparator := ','; fs.ThousandSeparator := ',';
AStrings.Add('<!-- generated by fpspreadsheet -->'); AStrings.Add('<!-- generated by fpspreadsheet -->');
// Show/hide grid lines // Show/hide grid lines
if soShowGridLines in FWorksheet.Options then if soShowGridLines in sheet.Options then
lCurStr := '{| class="wikitable"' // sortable"' lCurStr := '{| class="wikitable"' // sortable"'
else else
lCurStr := '{| border="0" cellpadding="2"'; lCurStr := '{| border="0" cellpadding="2"';
// Default font // Default font
lStyleStr := ''; lStyleStr := '';
lFont := FWorkbook.GetDefaultFont; lFont := (FWorkbook as TsWorkbook).GetDefaultFont;
if lFont.FontName <> DEFAULT_FONTNAME then if lFont.FontName <> DEFAULT_FONTNAME then
lStyleStr := lStyleStr + Format('font-family:%s;', [lFont.FontName]); lStyleStr := lStyleStr + Format('font-family:%s;', [lFont.FontName]);
if fssBold in lFont.Style then if fssBold in lFont.Style then
@ -454,16 +456,16 @@ begin
AStrings.Add(lCurStr); AStrings.Add(lCurStr);
for i := 0 to FWorksheet.GetLastRowIndex() do for i := 0 to sheet.GetLastRowIndex() do
begin begin
AStrings.Add('|-'); AStrings.Add('|-');
//lRow := FWorksheet.FindRow(i); //lRow := sheet.FindRow(i);
for j := 0 to FWorksheet.GetLastColIndex do for j := 0 to sheet.GetLastColIndex do
begin begin
lCell := FWorksheet.FindCell(i, j); lCell := sheet.FindCell(i, j);
//lCol := FWorksheet.FindCol(j); //lCol := sheet.FindCol(j);
lCurStr := FWorksheet.ReadAsText(lCell, fs); lCurStr := sheet.ReadAsText(lCell, fs);
// Check for invalid characters // Check for invalid characters
if not ValidXMLText(lCurStr, false) then if not ValidXMLText(lCurStr, false) then
@ -480,32 +482,32 @@ begin
lRowHeightStr := ''; lRowHeightStr := '';
// Format // Format
fmt := FWorksheet.GetPointerToEffectiveCellFormat(i, j); fmt := sheet.GetPointerToEffectiveCellFormat(i, j);
if fmt <> nil then if fmt <> nil then
lCurUsedFormatting := fmt^.UsedFormattingFields else lCurUsedFormatting := fmt^.UsedFormattingFields else
lCurUsedFormatting := []; lCurUsedFormatting := [];
// Row header // Row header
isHeader := (soHasFrozenPanes in FWorksheet.Options) and isHeader := (soHasFrozenPanes in FWorksheet.Options) and
((i < cardinal(FWorksheet.TopPaneHeight)) or (j < cardinal(FWorksheet.LeftPaneWidth))); ((i < cardinal(sheet.TopPaneHeight)) or (j < cardinal(sheet.LeftPaneWidth)));
// Column width (to be considered in first row) // Column width (to be considered in first row)
if i = 0 then if i = 0 then
lColWidthStr := Format(' width="%.0fpt"', [ lColWidthStr := Format(' width="%.0fpt"', [
FWorkbook.ConvertUnits(FWorksheet.GetColWidth(i, suChars), FWorkbook.Units, suPoints) (FWorkbook as TsWorkbook).ConvertUnits(sheet.GetColWidth(i, suChars), FWorkbook.Units, suPoints)
]); ]);
// Row height (to be considered in first column) // Row height (to be considered in first column)
if j = 0 then if j = 0 then
lRowHeightStr := Format(' height="%.0fpt"', [ lRowHeightStr := Format(' height="%.0fpt"', [
FWorkbook.ConvertUnits(FWorksheet.GetRowHeight(j, suLines), FWorkbook.Units, suPoints) (FWorkbook as TsWorkbook).ConvertUnits(sheet.GetRowHeight(j, suLines), FWorkbook.Units, suPoints)
]); ]);
// Font // Font
lFont := FWorkbook.GetDefaultFont; lFont := (FWorkbook as TsWorkbook).GetDefaultFont;
if (uffFont in lCurUsedFormatting) and (fmt <> nil) then if (uffFont in lCurUsedFormatting) and (fmt <> nil) then
begin begin
lFont := FWorkbook.GetFont(fmt^.FontIndex); lFont := (FWorkbook as TsWorkbook).GetFont(fmt^.FontIndex);
if fssBold in lFont.Style then lCurStr := '<b>' + lCurStr + '</b>'; if fssBold in lFont.Style then lCurStr := '<b>' + lCurStr + '</b>';
if fssItalic in lFont.Style then lCurStr := '<i>' + lCurStr + '</i>'; if fssItalic in lFont.Style then lCurStr := '<i>' + lCurStr + '</i>';
if fssUnderline in lFont.Style then lCurStr := '<u>' + lCurStr + '</u>'; if fssUnderline in lFont.Style then lCurStr := '<u>' + lCurStr + '</u>';
@ -570,9 +572,9 @@ begin
end; end;
// Merged cells // Merged cells
if FWorksheet.IsMerged(lCell) then if sheet.IsMerged(lCell) then
begin begin
FWorksheet.FindMergedRange(lCell, r1, c1, r2, c2); sheet.FindMergedRange(lCell, r1, c1, r2, c2);
if (i = r1) and (j = c1) then if (i = r1) and (j = c1) then
begin begin
if r1 < r2 then if r1 < r2 then
@ -619,7 +621,7 @@ end;
{ TsWikiTable_WikiMediaWriter } { TsWikiTable_WikiMediaWriter }
constructor TsWikiTable_WikiMediaWriter.Create(AWorkbook: TsWorkbook); constructor TsWikiTable_WikiMediaWriter.Create(AWorkbook: TsBasicWorkbook);
begin begin
inherited Create(AWorkbook); inherited Create(AWorkbook);
SubFormat := sfWikiTable_WikiMedia; SubFormat := sfWikiTable_WikiMedia;

250
components/fpspreadsheet/source/common/xlsbiff2.pas
View File

@ -34,7 +34,7 @@ interface
uses uses
Classes, SysUtils, lconvencoding, Classes, SysUtils, lconvencoding,
fpsTypes, fpspreadsheet, fpsUtils, xlscommon; fpsTypes, fpsUtils, xlscommon;
const const
BIFF2_MAX_PALETTE_SIZE = 8; BIFF2_MAX_PALETTE_SIZE = 8;
@ -75,7 +75,7 @@ type
procedure ReadWindow2(AStream: TStream); override; procedure ReadWindow2(AStream: TStream); override;
procedure ReadXF(AStream: TStream); procedure ReadXF(AStream: TStream);
public public
constructor Create(AWorkbook: TsWorkbook); override; constructor Create(AWorkbook: TsBasicWorkbook); override;
{ General reading methods } { General reading methods }
procedure ReadFromStream(AStream: TStream; APassword: String = ''; procedure ReadFromStream(AStream: TStream; APassword: String = '';
AParams: TsStreamParams = []); override; AParams: TsStreamParams = []); override;
@ -100,8 +100,8 @@ type
procedure WriteColumnDefault(AStream: TStream; procedure WriteColumnDefault(AStream: TStream;
AFirstColIndex, ALastColIndex: Word; AFormatIndex: Integer); AFirstColIndex, ALastColIndex: Word; AFormatIndex: Integer);
procedure WriteColumnDefaults(AStream: TStream); procedure WriteColumnDefaults(AStream: TStream);
procedure WriteDefaultRowHeight(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteDefaultRowHeight(AStream: TStream; AWorksheet: TsBasicWorksheet);
procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteDimensions(AStream: TStream; AWorksheet: TsBasicWorksheet);
procedure WriteEOF(AStream: TStream); procedure WriteEOF(AStream: TStream);
procedure WriteFont(AStream: TStream; AFontIndex: Integer); procedure WriteFont(AStream: TStream; AFontIndex: Integer);
procedure WriteFonts(AStream: TStream); procedure WriteFonts(AStream: TStream);
@ -111,7 +111,7 @@ type
procedure AddBuiltinNumFormats; override; procedure AddBuiltinNumFormats; override;
function FunctionSupported(AExcelCode: Integer; function FunctionSupported(AExcelCode: Integer;
const AFuncName: String): Boolean; override; const AFuncName: String): Boolean; override;
procedure PopulatePalette(AWorkbook: TsWorkbook); override; procedure PopulatePalette(AWorkbook: TsbasicWorkbook); override;
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override; ACell: PCell); override;
procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal;
@ -126,7 +126,7 @@ type
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: double; ACell: PCell); override; const AValue: double; ACell: PCell); override;
procedure WritePASSWORD(AStream: TStream); procedure WritePASSWORD(AStream: TStream);
procedure WriteRow(AStream: TStream; ASheet: TsWorksheet; procedure WriteRow(AStream: TStream; ASheet: TsBasicWorksheet;
ARowIndex, AFirstColIndex, ALastColIndex: Cardinal; ARow: PRow); override; ARowIndex, AFirstColIndex, ALastColIndex: Cardinal; ARow: PRow); override;
procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal;
AFormula: TsRPNFormula; ACell: PCell); override; AFormula: TsRPNFormula; ACell: PCell); override;
@ -134,11 +134,11 @@ type
procedure WriteRPNTokenArraySize(AStream: TStream; ASize: Word); override; procedure WriteRPNTokenArraySize(AStream: TStream; ASize: Word); override;
procedure WriteStringRecord(AStream: TStream; AString: String); override; procedure WriteStringRecord(AStream: TStream; AString: String); override;
procedure WriteWindow1(AStream: TStream); override; procedure WriteWindow1(AStream: TStream); override;
procedure WriteWindow2(AStream: TStream; ASheet: TsWorksheet); procedure WriteWindow2(AStream: TStream; ASheet: TsBasicWorksheet);
procedure WriteXF(AStream: TStream; AFormatRecord: PsCellFormat; procedure WriteXF(AStream: TStream; AFormatRecord: PsCellFormat;
XFType_Prot: Byte = 0); override; XFType_Prot: Byte = 0); override;
public public
constructor Create(AWorkbook: TsWorkbook); override; constructor Create(AWorkbook: TsbasicWorkbook); override;
procedure WriteToStream(AStream: TStream; AParams: TsStreamParams = []); override; procedure WriteToStream(AStream: TStream; AParams: TsStreamParams = []); override;
end; end;
@ -180,7 +180,7 @@ uses
LazLogger, LazLogger,
{$ENDIF} {$ENDIF}
Math, Math,
fpsStrings, fpsReaderWriter, fpsPalette, fpsNumFormat; fpsStrings, fpspreadsheet, fpsReaderWriter, fpsPalette, fpsNumFormat;
const const
{ Excel record IDs } { Excel record IDs }
@ -320,7 +320,7 @@ end;
{ TsSpreadBIFF2Reader } { TsSpreadBIFF2Reader }
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
constructor TsSpreadBIFF2Reader.Create(AWorkbook: TsWorkbook); constructor TsSpreadBIFF2Reader.Create(AWorkbook: TsBasicWorkbook);
begin begin
inherited Create(AWorkbook); inherited Create(AWorkbook);
InitBiff2Limitations(FLimitations); InitBiff2Limitations(FLimitations);
@ -342,10 +342,10 @@ begin
InitCell(FWorksheet, ARow, ACol, FVirtualCell); InitCell(FWorksheet, ARow, ACol, FVirtualCell);
cell := @FVirtualCell; cell := @FVirtualCell;
end else end else
cell := FWorksheet.AddCell(ARow, ACol); cell := TsWorksheet(FWorksheet).AddCell(ARow, ACol);
ApplyCellFormatting(cell, XF); ApplyCellFormatting(cell, XF);
if FIsVirtualMode then if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell); TsWorkbook(FWorkbook).OnReadCellData(Workbook, ARow, ACol, cell);
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -358,7 +358,10 @@ var
r, c: Cardinal; r, c: Cardinal;
xf: Word; xf: Word;
cell: PCell; cell: PCell;
sheet: TsWorksheet;
begin begin
sheet := FWorksheet as TsWorksheet;
{ Read entire record, starting at Row } { Read entire record, starting at Row }
rec.Row := 0; // to silence the compiler... rec.Row := 0; // to silence the compiler...
AStream.ReadBuffer(rec.Row, SizeOf(TBIFF2_BoolErrRecord) - 2*SizeOf(Word)); AStream.ReadBuffer(rec.Row, SizeOf(TBIFF2_BoolErrRecord) - 2*SizeOf(Word));
@ -372,19 +375,19 @@ begin
InitCell(FWorksheet, r, c, FVirtualCell); InitCell(FWorksheet, r, c, FVirtualCell);
cell := @FVirtualCell; cell := @FVirtualCell;
end else end else
cell := FWorksheet.AddCell(r, c); cell := sheet.AddCell(r, c);
{ Retrieve boolean or error value depending on the "ValueType" } { Retrieve boolean or error value depending on the "ValueType" }
case rec.ValueType of case rec.ValueType of
0: FWorksheet.WriteBoolValue(cell, boolean(rec.BoolErrValue)); 0: sheet.WriteBoolValue(cell, boolean(rec.BoolErrValue));
1: FWorksheet.WriteErrorValue(cell, ConvertFromExcelError(rec.BoolErrValue)); 1: sheet.WriteErrorValue(cell, ConvertFromExcelError(rec.BoolErrValue));
end; end;
{ Apply formatting } { Apply formatting }
ApplyCellFormatting(cell, xf); ApplyCellFormatting(cell, xf);
if FIsVirtualMode then if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, r, c, cell); TsWorkbook(FWorkbook).OnReadCellData(Workbook, r, c, cell);
end; end;
procedure TsSpreadBIFF2Reader.ReadColumnDefault(AStream: TStream); procedure TsSpreadBIFF2Reader.ReadColumnDefault(AStream: TStream);
@ -398,7 +401,10 @@ var
nf: TsNumFormatParams; nf: TsNumFormatParams;
nfs: String; nfs: String;
b: Byte; b: Byte;
book: TsWorkbook;
begin begin
book := TsWorkbook(FWorkbook);
{ Index of first column } { Index of first column }
col1 := WordLEToN(AStream.ReadWord); col1 := WordLEToN(AStream.ReadWord);
@ -417,9 +423,9 @@ begin
fontIndex := (attr2 and $C0) shr 6; fontIndex := (attr2 and $C0) shr 6;
if fontIndex > 4 then dec(fontIndex); // Watch out for the nasty missing font #4... if fontIndex > 4 then dec(fontIndex); // Watch out for the nasty missing font #4...
fnt := TsFont(FFontList[fontIndex]); fnt := TsFont(FFontList[fontIndex]);
fmt.FontIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color); fmt.FontIndex := book.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
if fmt.FontIndex = -1 then if fmt.FontIndex = -1 then
fmt.FontIndex := Workbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color); fmt.FontIndex := book.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
if fmt.FontIndex > 0 then if fmt.FontIndex > 0 then
Include(fmt.UsedFormattingFields, uffFont); Include(fmt.UsedFormattingFields, uffFont);
@ -427,8 +433,8 @@ begin
b := attr2 and $3F; b := attr2 and $3F;
nfs := NumFormatList[b]; nfs := NumFormatList[b];
if nfs <> '' then begin if nfs <> '' then begin
fmt.NumberFormatIndex := Workbook.AddNumberFormat(nfs); fmt.NumberFormatIndex := book.AddNumberFormat(nfs);
nf := Workbook.GetNumberFormat(fmt.NumberFormatIndex); nf := book.GetNumberFormat(fmt.NumberFormatIndex);
fmt.NumberFormat := nf.NumFormat; fmt.NumberFormat := nf.NumFormat;
fmt.NumberFormatStr := nf.NumFormatStr; fmt.NumberFormatStr := nf.NumFormatStr;
if fmt.NumberFormat <> nfGeneral then if fmt.NumberFormat <> nfGeneral then
@ -477,10 +483,10 @@ begin
// Add the decoded data to the format list // Add the decoded data to the format list
FCellFormatList.Add(fmt); FCellFormatList.Add(fmt);
fmtIndex := FWorkbook.AddCellFormat(fmt); fmtIndex := book.AddCellFormat(fmt);
for c := col1 to col2 do for c := col1 to col2 do
FWorksheet.WriteColFormatIndex(c, fmtIndex); TsWorksheet(FWorksheet).WriteColFormatIndex(c, fmtIndex);
end; end;
procedure TsSpreadBIFF2Reader.ReadColWidth(AStream: TStream); procedure TsSpreadBIFF2Reader.ReadColWidth(AStream: TStream);
@ -490,18 +496,21 @@ var
c, c1, c2: Cardinal; c, c1, c2: Cardinal;
w: Word; w: Word;
colwidth: Single; colwidth: Single;
sheet: TsWorksheet;
begin begin
sheet := TsWorksheet(FWorksheet);
// read column start and end index of column range // read column start and end index of column range
c1 := AStream.ReadByte; c1 := AStream.ReadByte;
c2 := AStream.ReadByte; c2 := AStream.ReadByte;
// read col width in 1/256 of the width of "0" character // read col width in 1/256 of the width of "0" character
w := WordLEToN(AStream.ReadWord); w := WordLEToN(AStream.ReadWord);
// calculate width in units of "characters" // calculate width in units of "characters"
colwidth := FWorkbook.ConvertUnits(w / 256, suChars, FWorkbook.Units); colwidth := (FWorkbook as TsWorkbook).ConvertUnits(w / 256, suChars, FWorkbook.Units);
// assign width to columns, but only if different from default column width. // assign width to columns, but only if different from default column width.
if not SameValue(colwidth, FWorksheet.ReadDefaultColWidth(FWorkbook.Units), EPS) then if not SameValue(colwidth, sheet.ReadDefaultColWidth(FWorkbook.Units), EPS) then
for c := c1 to c2 do for c := c1 to c2 do
FWorksheet.WriteColWidth(c, colwidth, FWorkbook.Units); sheet.WriteColWidth(c, colwidth, FWorkbook.Units);
end; end;
procedure TsSpreadBIFF2Reader.ReadDefRowHeight(AStream: TStream); procedure TsSpreadBIFF2Reader.ReadDefRowHeight(AStream: TStream);
@ -511,12 +520,7 @@ var
begin begin
hw := WordLEToN(AStream.ReadWord); hw := WordLEToN(AStream.ReadWord);
h := TwipsToPts(hw and $7FFF); h := TwipsToPts(hw and $7FFF);
FWorksheet.WriteDefaultRowHeight(h, suPoints); (FWorksheet as TsWorksheet).WriteDefaultRowHeight(h, suPoints);
{
h := TwipsToPts(hw and $8000) / FWorkbook.GetDefaultFontSize;
if h > ROW_HEIGHT_CORRECTION then
FWorksheet.DefaultRowHeight := h - ROW_HEIGHT_CORRECTION;
}
end; end;
procedure TsSpreadBIFF2Reader.ReadFONT(AStream: TStream); procedure TsSpreadBIFF2Reader.ReadFONT(AStream: TStream);
@ -553,7 +557,7 @@ begin
FFontList.Add(FFont); FFontList.Add(FFont);
if isDefaultFont then if isDefaultFont then
Workbook.SetDefaultFont(FFont.FontName, FFont.Size); TsWorkbook(FWorkbook).SetDefaultFont(FFont.FontName, FFont.Size);
end; end;
procedure TsSpreadBIFF2Reader.ReadFONTCOLOR(AStream: TStream); procedure TsSpreadBIFF2Reader.ReadFONTCOLOR(AStream: TStream);
@ -606,7 +610,7 @@ begin
BIFF2EOF := False; BIFF2EOF := False;
{ In BIFF2 files there is only one worksheet, let's create it } { In BIFF2 files there is only one worksheet, let's create it }
FWorksheet := FWorkbook.AddWorksheet('Sheet', true); FWorksheet := TsWorkbook(FWorkbook).AddWorksheet('Sheet', true);
{ Read all records in a loop } { Read all records in a loop }
BOFFound := false; BOFFound := false;
@ -685,7 +689,10 @@ var
nfs: String; nfs: String;
err: TsErrorValue; err: TsErrorValue;
cell: PCell; cell: PCell;
sheet: TsWorksheet;
begin begin
sheet := TsWorksheet(FWorksheet);
{ BIFF Record row/column/style } { BIFF Record row/column/style }
ReadRowColXF(AStream, ARow, ACol, XF); ReadRowColXF(AStream, ARow, ACol, XF);
@ -701,7 +708,7 @@ begin
InitCell(FWorksheet, ARow, ACol, FVirtualCell); InitCell(FWorksheet, ARow, ACol, FVirtualCell);
cell := @FVirtualCell; cell := @FVirtualCell;
end else end else
cell := FWorksheet.AddCell(ARow, ACol); cell := sheet.AddCell(ARow, ACol);
// Now determine the type of the formula result // Now determine the type of the formula result
if (Data[6] = $FF) and (Data[7] = $FF) then if (Data[6] = $FF) and (Data[7] = $FF) then
@ -709,7 +716,7 @@ begin
0: // String -> Value is found in next record (STRING) 0: // String -> Value is found in next record (STRING)
FIncompleteCell := cell; FIncompleteCell := cell;
1: // Boolean value 1: // Boolean value
FWorksheet.WriteBoolValue(cell, Data[2] = 1); sheet.WriteBoolValue(cell, Data[2] = 1);
2: begin // Error value 2: begin // Error value
case Data[2] of case Data[2] of
ERR_INTERSECTION_EMPTY : err := errEmptyIntersection; ERR_INTERSECTION_EMPTY : err := errEmptyIntersection;
@ -720,10 +727,10 @@ begin
ERR_OVERFLOW : err := errOverflow; ERR_OVERFLOW : err := errOverflow;
ERR_ARG_ERROR : err := errArgError; ERR_ARG_ERROR : err := errArgError;
end; end;
FWorksheet.WriteErrorValue(cell, err); sheet.WriteErrorValue(cell, err);
end; end;
3: // Empty cell 3: // Empty cell
FWorksheet.WriteBlank(cell); sheet.WriteBlank(cell);
end end
else else
begin begin
@ -733,23 +740,23 @@ begin
{Find out what cell type, set content type and value} {Find out what cell type, set content type and value}
ExtractNumberFormat(XF, nf, nfs); ExtractNumberFormat(XF, nf, nfs);
if IsDateTime(formulaResult, nf, nfs, dt) then if IsDateTime(formulaResult, nf, nfs, dt) then
FWorksheet.WriteDateTime(cell, dt, nf, nfs) sheet.WriteDateTime(cell, dt, nf, nfs)
else else
FWorksheet.WriteNumber(cell, formulaResult, nf, nfs); sheet.WriteNumber(cell, formulaResult, nf, nfs);
end; end;
{ Formula token array } { Formula token array }
if (boReadFormulas in FWorkbook.Options) then if (boReadFormulas in FWorkbook.Options) then
begin begin
ok := ReadRPNTokenArray(AStream, cell); ok := ReadRPNTokenArray(AStream, cell);
if not ok then FWorksheet.WriteErrorValue(cell, errFormulaNotSupported); if not ok then sheet.WriteErrorValue(cell, errFormulaNotSupported);
end; end;
{ Apply formatting to cell } { Apply formatting to cell }
ApplyCellFormatting(cell, XF); ApplyCellFormatting(cell, XF);
if FIsVirtualMode and (cell <> FIncompleteCell) then if FIsVirtualMode and (cell <> FIncompleteCell) then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell); TsWorkbook(FWorkbook).OnReadCellData(Workbook, ARow, ACol, cell);
end; end;
procedure TsSpreadBIFF2Reader.ReadLabel(AStream: TStream); procedure TsSpreadBIFF2Reader.ReadLabel(AStream: TStream);
@ -761,7 +768,10 @@ var
ansiStr: ansistring; ansiStr: ansistring;
valueStr: UTF8String; valueStr: UTF8String;
cell: PCell; cell: PCell;
sheet: TsWorksheet;
begin begin
sheet := FWorksheet as TsWorksheet;
{ Read entire record, starting at Row, except for string data } { Read entire record, starting at Row, except for string data }
rec.Row := 0; // to silence the compiler... rec.Row := 0; // to silence the compiler...
AStream.ReadBuffer(rec.Row, SizeOf(TBIFF2_LabelRecord) - 2*SizeOf(Word)); AStream.ReadBuffer(rec.Row, SizeOf(TBIFF2_LabelRecord) - 2*SizeOf(Word));
@ -777,33 +787,20 @@ begin
{ Save the data } { Save the data }
valueStr := ConvertEncoding(ansiStr, FCodePage, encodingUTF8); valueStr := ConvertEncoding(ansiStr, FCodePage, encodingUTF8);
{
case WorkBookEncoding of
seLatin2: AStrValue := CP1250ToUTF8(AValue);
seCyrillic: AStrValue := CP1251ToUTF8(AValue);
seGreek: AStrValue := CP1253ToUTF8(AValue);
seTurkish: AStrValue := CP1254ToUTF8(AValue);
seHebrew: AStrValue := CP1255ToUTF8(AValue);
seArabic: AStrValue := CP1256ToUTF8(AValue);
else
// Latin 1 is the default
AStrValue := CP1252ToUTF8(AValue);
end;
}
{ Create cell } { Create cell }
if FIsVirtualMode then begin if FIsVirtualMode then begin
InitCell(FWorksheet, ARow, ACol, FVirtualCell); InitCell(FWorksheet, ARow, ACol, FVirtualCell);
cell := @FVirtualCell; cell := @FVirtualCell;
end else end else
cell := FWorksheet.AddCell(ARow, ACol); cell := sheet.AddCell(ARow, ACol);
FWorksheet.WriteText(cell, valueStr); sheet.WriteText(cell, valueStr);
{ Apply formatting to cell } { Apply formatting to cell }
ApplyCellFormatting(cell, XF); ApplyCellFormatting(cell, XF);
if FIsVirtualMode and (cell <> FIncompleteCell) then if FIsVirtualMode and (cell <> FIncompleteCell) then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell); TsWorkbook(FWorkbook).OnReadCellData(Workbook, ARow, ACol, cell);
end; end;
procedure TsSpreadBIFF2Reader.ReadNumber(AStream: TStream); procedure TsSpreadBIFF2Reader.ReadNumber(AStream: TStream);
@ -816,7 +813,10 @@ var
nf: TsNumberFormat; nf: TsNumberFormat;
nfs: String; nfs: String;
cell: PCell; cell: PCell;
sheet: TsWorksheet;
begin begin
sheet := FWorksheet as TsWorksheet;
{ Read entire record, starting at Row } { Read entire record, starting at Row }
rec.Row := 0; // to silence the compiler... rec.Row := 0; // to silence the compiler...
AStream.ReadBuffer(rec.Row, SizeOf(TBIFF2_NumberRecord) - 2*SizeOf(Word)); AStream.ReadBuffer(rec.Row, SizeOf(TBIFF2_NumberRecord) - 2*SizeOf(Word));
@ -831,30 +831,33 @@ begin
InitCell(FWorksheet, ARow, ACol, FVirtualCell); InitCell(FWorksheet, ARow, ACol, FVirtualCell);
cell := @FVirtualCell; cell := @FVirtualCell;
end else end else
cell := FWorksheet.AddCell(ARow, ACol); cell := sheet.AddCell(ARow, ACol);
{Find out what cell type, set content type and value} {Find out what cell type, set content type and value}
ExtractNumberFormat(XF, nf, nfs); ExtractNumberFormat(XF, nf, nfs);
if IsDateTime(value, nf, nfs, dt) then if IsDateTime(value, nf, nfs, dt) then
FWorksheet.WriteDateTime(cell, dt, nf, nfs) sheet.WriteDateTime(cell, dt, nf, nfs)
else else
FWorksheet.WriteNumber(cell, value, nf, nfs); sheet.WriteNumber(cell, value, nf, nfs);
{ Apply formatting to cell } { Apply formatting to cell }
ApplyCellFormatting(cell, XF); ApplyCellFormatting(cell, XF);
if FIsVirtualMode and (cell <> FIncompleteCell) then if FIsVirtualMode and (cell <> FIncompleteCell) then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell); TsWorkbook(FWorkbook).OnReadCellData(Workbook, ARow, ACol, cell);
end; end;
procedure TsSpreadBIFF2Reader.ReadInteger(AStream: TStream); procedure TsSpreadBIFF2Reader.ReadInteger(AStream: TStream);
var var
sheet: TsWorksheet;
ARow, ACol: Cardinal; ARow, ACol: Cardinal;
XF: Word; XF: Word;
AWord : Word = 0; AWord : Word = 0;
cell: PCell; cell: PCell;
rec: TBIFF2_IntegerRecord; rec: TBIFF2_IntegerRecord;
begin begin
sheet := FWorksheet as TsWorksheet;
{ Read record into buffer } { Read record into buffer }
rec.Row := 0; // to silence the comiler... rec.Row := 0; // to silence the comiler...
AStream.ReadBuffer(rec.Row, SizeOf(TBIFF2_NumberRecord) - 2*SizeOf(Word)); AStream.ReadBuffer(rec.Row, SizeOf(TBIFF2_NumberRecord) - 2*SizeOf(Word));
@ -870,16 +873,16 @@ begin
InitCell(FWorksheet, ARow, ACol, FVirtualCell); InitCell(FWorksheet, ARow, ACol, FVirtualCell);
cell := @FVirtualCell; cell := @FVirtualCell;
end else end else
cell := FWorksheet.AddCell(ARow, ACol); cell := sheet.AddCell(ARow, ACol);
{ Save the data } { Save the data }
FWorksheet.WriteNumber(cell, AWord); sheet.WriteNumber(cell, AWord);
{ Apply formatting to cell } { Apply formatting to cell }
ApplyCellFormatting(cell, XF); ApplyCellFormatting(cell, XF);
if FIsVirtualMode and (cell <> FIncompleteCell) then if FIsVirtualMode and (cell <> FIncompleteCell) then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell); TsWorkbook(FWorkbook).OnReadCellData(Workbook, ARow, ACol, cell);
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -911,14 +914,14 @@ begin
// Use the same password for workbook and worksheet protection because // Use the same password for workbook and worksheet protection because
// BIFF2 can have only a single sheet. // BIFF2 can have only a single sheet.
FWorkbook.CryptoInfo := cinfo; (FWorkbook as TsWorkbook).CryptoInfo := cinfo;
FWorksheet.CryptoInfo := cinfo; (FWorksheet as TsWorksheet).CryptoInfo := cinfo;
end; end;
procedure TsSpreadBIFF2Reader.ReadPROTECT(AStream: TStream); procedure TsSpreadBIFF2Reader.ReadPROTECT(AStream: TStream);
begin begin
inherited ReadPROTECT(AStream); inherited ReadPROTECT(AStream);
FWorksheet.Protect(Workbook.IsProtected); (FWorksheet as TsWorksheet).Protect(Workbook.IsProtected);
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -966,13 +969,18 @@ var
defRowHeight: Single; defRowHeight: Single;
containsXF: Boolean; containsXF: Boolean;
xf: Word; xf: Word;
book: TsWorkbook;
sheet: TsWorksheet;
begin begin
book := FWorkbook as TsWorkbook;
sheet := FWorksheet as TsWorksheet;
rowRec.RowIndex := 0; // to silence the compiler... rowRec.RowIndex := 0; // to silence the compiler...
AStream.ReadBuffer(rowrec, SizeOf(TRowRecord)); AStream.ReadBuffer(rowrec, SizeOf(TRowRecord));
h := WordLEToN(rowrec.Height); h := WordLEToN(rowrec.Height);
auto := h and $8000 <> 0; auto := h and $8000 <> 0;
rowheight := FWorkbook.ConvertUnits(TwipsToPts(h and $7FFF), suPoints, FWorkbook.Units); rowheight := book.ConvertUnits(TwipsToPts(h and $7FFF), suPoints, FWorkbook.Units);
defRowHeight := FWorksheet.ReadDefaultRowHeight(FWorkbook.Units); defRowHeight := sheet.ReadDefaultRowHeight(FWorkbook.Units);
containsXF := rowRec.ContainsXF = 1; containsXF := rowRec.ContainsXF = 1;
xf := WordLEToN(rowRec.XFIndex); xf := WordLEToN(rowRec.XFIndex);
@ -982,7 +990,7 @@ begin
exit; exit;
// Otherwise: create a row record // Otherwise: create a row record
lRow := FWorksheet.GetRow(WordLEToN(rowrec.RowIndex)); lRow := sheet.GetRow(WordLEToN(rowrec.RowIndex));
lRow^.Height := rowHeight; lRow^.Height := rowHeight;
if auto then if auto then
lRow^.RowHeightType := rhtAuto else lRow^.RowHeightType := rhtAuto else
@ -1062,7 +1070,9 @@ begin
FIncompleteCell^.UTF8StringValue := ConvertEncoding(s, FCodePage, encodingUTF8); FIncompleteCell^.UTF8StringValue := ConvertEncoding(s, FCodePage, encodingUTF8);
FIncompleteCell^.ContentType := cctUTF8String; FIncompleteCell^.ContentType := cctUTF8String;
if FIsVirtualMode then if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, FIncompleteCell^.Row, FIncompleteCell^.Col, FIncompleteCell); TsWorkbook(FWorkbook).OnReadCellData(FWorkbook,
FIncompleteCell^.Row, FIncompleteCell^.Col, FIncompleteCell
);
end; end;
end; end;
FIncompleteCell := nil; FIncompleteCell := nil;
@ -1120,7 +1130,10 @@ var
nfs: String; nfs: String;
i: Integer; i: Integer;
fnt: TsFont; fnt: TsFont;
book: TsWorkbook;
begin begin
book := FWorkbook as TsWorkbook;
// Read entire xf record into buffer // Read entire xf record into buffer
InitFormatRecord(fmt); InitFormatRecord(fmt);
fmt.ID := FCellFormatList.Count; fmt.ID := FCellFormatList.Count;
@ -1132,9 +1145,9 @@ begin
i := rec.FontIndex; i := rec.FontIndex;
if i > 4 then dec(i); // Watch out for the nasty missing font #4... if i > 4 then dec(i); // Watch out for the nasty missing font #4...
fnt := TsFont(FFontList[i]); fnt := TsFont(FFontList[i]);
fmt.FontIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color); fmt.FontIndex := book.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
if fmt.FontIndex = -1 then if fmt.FontIndex = -1 then
fmt.FontIndex := Workbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color); fmt.FontIndex := book.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
if fmt.FontIndex > 0 then if fmt.FontIndex > 0 then
Include(fmt.UsedFormattingFields, uffFont); Include(fmt.UsedFormattingFields, uffFont);
@ -1143,8 +1156,8 @@ begin
nfs := NumFormatList[b]; nfs := NumFormatList[b];
if nfs <> '' then if nfs <> '' then
begin begin
fmt.NumberFormatIndex := Workbook.AddNumberFormat(nfs); fmt.NumberFormatIndex := book.AddNumberFormat(nfs);
nf := Workbook.GetNumberFormat(fmt.NumberFormatIndex); nf := book.GetNumberFormat(fmt.NumberFormatIndex);
fmt.NumberFormat := nf.NumFormat; fmt.NumberFormat := nf.NumFormat;
fmt.NumberFormatStr := nf.NumFormatStr; fmt.NumberFormatStr := nf.NumFormatStr;
if fmt.NumberFormat <> nfGeneral then if fmt.NumberFormat <> nfGeneral then
@ -1211,7 +1224,7 @@ end;
{ TsSpreadBIFF2Writer } { TsSpreadBIFF2Writer }
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
constructor TsSpreadBIFF2Writer.Create(AWorkbook: TsWorkbook); constructor TsSpreadBIFF2Writer.Create(AWorkbook: TsBasicWorkbook);
begin begin
inherited Create(AWorkbook); inherited Create(AWorkbook);
@ -1252,7 +1265,7 @@ var
fmt: PsCellFormat; fmt: PsCellFormat;
fontIdx, formatIdx: Integer; fontIdx, formatIdx: Integer;
begin begin
fmt := Workbook.GetPointerToCellFormat(AFormatIndex); fmt := (Workbook as TsWorkbook).GetPointerToCellFormat(AFormatIndex);
if fmt^.UsedFormattingFields = [] then begin if fmt^.UsedFormattingFields = [] then begin
Attrib1 := 15 + MASK_XF_TYPE_PROT_LOCKED_BIFF2; // $40 Attrib1 := 15 + MASK_XF_TYPE_PROT_LOCKED_BIFF2; // $40
@ -1308,7 +1321,7 @@ begin
AFormatIndex := 0; AFormatIndex := 0;
if (AFormatRecord <> nil) and (uffNumberFormat in AFormatRecord^.UsedFormattingFields) then if (AFormatRecord <> nil) and (uffNumberFormat in AFormatRecord^.UsedFormattingFields) then
begin begin
nfParams := Workbook.GetNumberFormat(AFormatRecord^.NumberFormatIndex); nfParams := TsWorkbook(FWorkbook).GetNumberFormat(AFormatRecord^.NumberFormatIndex);
nfs := nfParams.NumFormatStr; nfs := nfParams.NumFormatStr;
AFormatIndex := NumFormatList.IndexOf(nfs); AFormatIndex := NumFormatList.IndexOf(nfs);
if AFormatIndex = -1 then AFormatIndex := 0; if AFormatIndex = -1 then AFormatIndex := 0;
@ -1323,7 +1336,7 @@ begin
end; end;
end; end;
procedure TsSpreadBIFF2Writer.PopulatePalette(AWorkbook: TsWorkbook); procedure TsSpreadBIFF2Writer.PopulatePalette(AWorkbook: TsBasicWorkbook);
begin begin
FPalette.Clear; FPalette.Clear;
FPalette.AddBuiltinColors(false); FPalette.AddBuiltinColors(false);
@ -1353,7 +1366,7 @@ var
fmt: PsCellFormat; fmt: PsCellFormat;
w: Word; w: Word;
begin begin
fmt := Workbook.GetPointerToCellFormat(AFormatIndex); fmt := TsWorkbook(FWorkbook).GetPointerToCellFormat(AFormatIndex);
rec.XFIndex_Locked_Hidden := 0; // to silence the compiler... rec.XFIndex_Locked_Hidden := 0; // to silence the compiler...
FillChar(rec, SizeOf(rec), 0); FillChar(rec, SizeOf(rec), 0);
@ -1466,7 +1479,7 @@ var
lCol, lCol1: PCol; lCol, lCol1: PCol;
lastcol: Integer; lastcol: Integer;
begin begin
sheet := Workbook.GetFirstWorksheet; sheet := TsWorkbook(FWorkbook).GetFirstWorksheet;
j := 0; j := 0;
while (j < sheet.Cols.Count) do begin while (j < sheet.Cols.Count) do begin
lCol := PCol(sheet.Cols[j]); lCol := PCol(sheet.Cols[j]);
@ -1518,9 +1531,9 @@ begin
{ Column width } { Column width }
{ calculate width to be in units of 1/256 of pixel width of character "0" } { calculate width to be in units of 1/256 of pixel width of character "0" }
if ACol^.ColWidthType = cwtDefault then if ACol^.ColWidthType = cwtDefault then
w := FWorksheet.ReadDefaultColWidth(suChars) w := TsWorksheet(FWorksheet).ReadDefaultColWidth(suChars)
else else
w := FWorkbook.ConvertUnits(ACol^.Width, FWorkbook.Units, suChars); w := tsWorkbook(FWorkbook).ConvertUnits(ACol^.Width, FWorkbook.Units, suChars);
rec.ColWidth := WordToLE(round(w*256)); rec.ColWidth := WordToLE(round(w*256));
{ Write out } { Write out }
@ -1536,7 +1549,7 @@ var
sheet: TsWorksheet; sheet: TsWorksheet;
col: PCol; col: PCol;
begin begin
sheet := Workbook.GetFirstWorksheet; sheet := TsWorkbook(FWorkbook).GetFirstWorksheet;
for j := 0 to sheet.Cols.Count-1 do begin for j := 0 to sheet.Cols.Count-1 do begin
col := PCol(sheet.Cols[j]); col := PCol(sheet.Cols[j]);
WriteColWidth(AStream, col); WriteColWidth(AStream, col);
@ -1547,7 +1560,7 @@ end;
Writes an Excel 2 DIMENSIONS record Writes an Excel 2 DIMENSIONS record
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteDimensions(AStream: TStream; procedure TsSpreadBIFF2Writer.WriteDimensions(AStream: TStream;
AWorksheet: TsWorksheet); AWorksheet: TsBasicWorksheet);
var var
firstRow, lastRow, firstCol, lastCol: Cardinal; firstRow, lastRow, firstCol, lastCol: Cardinal;
rec: TBIFF2_DimensionsRecord; rec: TBIFF2_DimensionsRecord;
@ -1595,7 +1608,7 @@ var
begin begin
Unused(AParams); Unused(AParams);
FWorksheet := Workbook.GetWorksheetByIndex(FSheetIndex); FWorksheet := (FWorkbook as TsWorkbook).GetWorksheetByIndex(FSheetIndex);
if FWorksheet = nil then if FWorksheet = nil then
raise EFPSpreadsheetWriter.Create(rsWorksheetNotFound1); raise EFPSpreadsheetWriter.Create(rsWorksheetNotFound1);
@ -1633,7 +1646,7 @@ begin
if (boVirtualMode in Workbook.Options) then if (boVirtualMode in Workbook.Options) then
WriteVirtualCells(AStream, FWorksheet) WriteVirtualCells(AStream, FWorksheet)
else else
WriteCellsToStream(AStream, FWorksheet.Cells); WriteCellsToStream(AStream, TsWorksheet(FWorksheet).Cells);
WriteWindow1(AStream); WriteWindow1(AStream);
// { -- currently not working // { -- currently not working
@ -1673,9 +1686,10 @@ end;
Writes an Excel 2 WINDOW2 record Writes an Excel 2 WINDOW2 record
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteWindow2(AStream: TStream; procedure TsSpreadBIFF2Writer.WriteWindow2(AStream: TStream;
ASheet: TsWorksheet); ASheet: TsBasicWorksheet);
var var
b: Byte; b: Byte;
sheet: TsWorksheet absolute ASheet;
begin begin
{ BIFF Record header } { BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_WINDOW2)); AStream.WriteWord(WordToLE(INT_EXCEL_ID_WINDOW2));
@ -1685,17 +1699,17 @@ begin
AStream.WriteByte(0); AStream.WriteByte(0);
{ Show grid lines } { Show grid lines }
b := IfThen(soShowGridLines in ASheet.Options, 1, 0); b := IfThen(soShowGridLines in sheet.Options, 1, 0);
AStream.WriteByte(b); AStream.WriteByte(b);
{ Show sheet headers } { Show sheet headers }
b := IfThen(soShowHeaders in ASheet.Options, 1, 0); b := IfThen(soShowHeaders in sheet.Options, 1, 0);
AStream.WriteByte(b); AStream.WriteByte(b);
{ Panes are frozen? } { Panes are frozen? }
b := 0; b := 0;
if (soHasFrozenPanes in ASheet.Options) and if (soHasFrozenPanes in sheet.Options) and
((ASheet.LeftPaneWidth > 0) or (ASheet.TopPaneHeight > 0)) ((sheet.LeftPaneWidth > 0) or (sheet.TopPaneHeight > 0))
then then
b := 1; b := 1;
AStream.WriteByte(b); AStream.WriteByte(b);
@ -1820,7 +1834,7 @@ var
optn: Word; optn: Word;
font: TsFont; font: TsFont;
begin begin
font := Workbook.GetFont(AFontIndex); font := TsWorkbook(FWorkbook).GetFont(AFontIndex);
if font = nil then // this happens for FONT4 in case of BIFF if font = nil then // this happens for FONT4 in case of BIFF
exit; exit;
@ -1868,7 +1882,7 @@ procedure TsSpreadBiff2Writer.WriteFonts(AStream: TStream);
var var
i: Integer; i: Integer;
begin begin
for i:=0 to Workbook.GetFontCount-1 do for i:=0 to TsWorkbook(FWorkbook).GetFontCount-1 do
WriteFont(AStream, i); WriteFont(AStream, i);
end; end;
@ -2075,7 +2089,7 @@ end;
corresponding ROW record corresponding ROW record
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteDefaultRowHeight(AStream: TStream; procedure TsSpreadBIFF2Writer.WriteDefaultRowHeight(AStream: TStream;
AWorksheet: TsWorksheet); AWorksheet: TsBasicWorksheet);
var var
h: Single; h: Single;
begin begin
@ -2085,7 +2099,7 @@ begin
{ Default height for unused rows, in twips = 1/20 of a point { Default height for unused rows, in twips = 1/20 of a point
Bits 0-14: Default height for unused rows, in twips Bits 0-14: Default height for unused rows, in twips
Bit 15 = 1: Row height not changed manually } Bit 15 = 1: Row height not changed manually }
h := AWorksheet.ReadDefaultRowHeight(suPoints); // h is in points h := TsWorksheet(AWorksheet).ReadDefaultRowHeight(suPoints); // h is in points
AStream.WriteWord(WordToLE(PtsToTwips(h))); // write as twips AStream.WriteWord(WordToLE(PtsToTwips(h))); // write as twips
end; end;
@ -2267,20 +2281,25 @@ procedure TsSpreadBIFF2Writer.WritePassword(AStream: TStream);
var var
hash: Word; hash: Word;
hb, hs: LongInt; hb, hs: LongInt;
book: TsWorkbook;
sheet: TsWorksheet;
begin begin
book := FWorkbook as TsWorkbook;
sheet := FWorksheet as TsWorksheet;
hb := 0; hb := 0;
if (Workbook.CryptoInfo.PasswordHash <> '') and if (book.CryptoInfo.PasswordHash <> '') and
not TryStrToInt('$' + Workbook.CryptoInfo.PasswordHash, hb) then not TryStrToInt('$' + book.CryptoInfo.PasswordHash, hb) then
begin begin
Workbook.AddErrorMsg(rsPasswordRemoved_NotValid); book.AddErrorMsg(rsPasswordRemoved_NotValid);
exit; exit;
end; end;
hs := 0; hs := 0;
if (FWorksheet.CryptoInfo.PasswordHash <> '') and if (sheet.CryptoInfo.PasswordHash <> '') and
not TryStrToInt('$' + FWorksheet.CryptoInfo.PasswordHash, hs) then not TryStrToInt('$' + sheet.CryptoInfo.PasswordHash, hs) then
begin begin
Workbook.AddErrorMsg(rsPasswordRemoved_NotValid); book.AddErrorMsg(rsPasswordRemoved_NotValid);
exit; exit;
end; end;
@ -2290,28 +2309,28 @@ begin
// Only workbook password set. Check for Excel algorithm. // Only workbook password set. Check for Excel algorithm.
if (hb <> 0) and (hs = 0) then begin if (hb <> 0) and (hs = 0) then begin
if Workbook.CryptoInfo.Algorithm <> caExcel then begin if book.CryptoInfo.Algorithm <> caExcel then begin
Workbook.AddErrorMsg(rsPasswordRemoved_Excel); book.AddErrorMsg(rsPasswordRemoved_Excel);
exit; exit;
end; end;
hash := hb; hash := hb;
end else end else
// Only worksheet password set, check for Excel algorithm // Only worksheet password set, check for Excel algorithm
if (hs <> 0) and (hb = 0) then begin if (hs <> 0) and (hb = 0) then begin
if FWorksheet.CryptoInfo.Algorithm <> caExcel then begin if sheet.CryptoInfo.Algorithm <> caExcel then begin
Workbook.AddErrorMsg(rsPasswordRemoved_Excel); book.AddErrorMsg(rsPasswordRemoved_Excel);
exit; exit;
end; end;
hash := hs; hash := hs;
end else end else
if (hs <> hb) then begin if (hs <> hb) then begin
Workbook.AddErrorMsg(rsPasswordRemoved_BIFF2); book.AddErrorMsg(rsPasswordRemoved_BIFF2);
exit; exit;
end else end else
if (Workbook.CryptoInfo.Algorithm <> caExcel) or if (book.CryptoInfo.Algorithm <> caExcel) or
(FWorksheet.CryptoInfo.Algorithm <> caExcel) then (sheet.CryptoInfo.Algorithm <> caExcel) then
begin begin
Workbook.AddErrorMsg(rsPasswordRemoved_Excel); book.AddErrorMsg(rsPasswordRemoved_Excel);
exit; exit;
end else end else
hash := hs; // or hb -- they are equal here. hash := hs; // or hb -- they are equal here.
@ -2321,7 +2340,7 @@ begin
AStream.WriteWord(WordToLE(hash)); AStream.WriteWord(WordToLE(hash));
end; end;
procedure TsSpreadBIFF2Writer.WriteRow(AStream: TStream; ASheet: TsWorksheet; procedure TsSpreadBIFF2Writer.WriteRow(AStream: TStream; ASheet: TsBasicWorksheet;
ARowIndex, AFirstColIndex, ALastColIndex: Cardinal; ARow: PRow); ARowIndex, AFirstColIndex, ALastColIndex: Cardinal; ARow: PRow);
var var
containsXF: Boolean; containsXF: Boolean;
@ -2329,6 +2348,8 @@ var
auto: Boolean; auto: Boolean;
w: Word; w: Word;
xf: Word; xf: Word;
book: TsWorkbook;
sheet: TsWorksheet;
begin begin
if (ARowIndex >= FLimitations.MaxRowCount) or if (ARowIndex >= FLimitations.MaxRowCount) or
(AFirstColIndex >= FLimitations.MaxColCount) or (AFirstColIndex >= FLimitations.MaxColCount) or
@ -2336,6 +2357,9 @@ begin
then then
exit; exit;
book := FWorkbook as TsWorkbook;
sheet := ASheet as TsWorksheet;
containsXF := (ARow <> nil) and (ARow^.FormatIndex > 0); containsXF := (ARow <> nil) and (ARow^.FormatIndex > 0);
{ BIFF record header } { BIFF record header }
@ -2353,12 +2377,12 @@ begin
auto := true; auto := true;
{ Row height (in twips, 1/20 point) and info on custom row height } { Row height (in twips, 1/20 point) and info on custom row height }
if (ARow = nil) or (ARow^.RowHeightType = rhtDefault) then if (ARow = nil) or (ARow^.RowHeightType = rhtDefault) then
rowheight := PtsToTwips(ASheet.ReadDefaultRowHeight(suPoints)) rowheight := PtsToTwips(sheet.ReadDefaultRowHeight(suPoints))
else else
if (ARow^.Height = 0) then if (ARow^.Height = 0) then
rowheight := 0 rowheight := 0
else begin else begin
rowheight := PtsToTwips(FWorkbook.ConvertUnits(ARow^.Height, FWorkbook.Units, suPoints)); rowheight := PtsToTwips(book.ConvertUnits(ARow^.Height, book.Units, suPoints));
auto := ARow^.RowHeightType <> rhtCustom; auto := ARow^.RowHeightType <> rhtCustom;
end; end;
w := rowheight and $7FFF; w := rowheight and $7FFF;

151
components/fpspreadsheet/source/common/xlsbiff5.pas
View File

@ -58,7 +58,7 @@ interface
uses uses
Classes, SysUtils, fpcanvas, lconvencoding, Classes, SysUtils, fpcanvas, lconvencoding,
fpsTypes, fpspreadsheet, fpsTypes,
xlscommon, xlscommon,
{$ifdef USE_NEW_OLE} {$ifdef USE_NEW_OLE}
fpolebasic, fpolebasic,
@ -83,7 +83,7 @@ type
procedure ReadRPNSheetIndex(AStream: TStream; out ADocumentURL: String; procedure ReadRPNSheetIndex(AStream: TStream; out ADocumentURL: String;
out ASheet1, ASheet2: Integer); override; out ASheet1, ASheet2: Integer); override;
procedure ReadRSTRING(AStream: TStream); procedure ReadRSTRING(AStream: TStream);
procedure ReadStandardWidth(AStream: TStream; ASheet: TsWorksheet); procedure ReadStandardWidth(AStream: TStream; ASheet: TsBasicWorksheet);
procedure ReadStringRecord(AStream: TStream); override; procedure ReadStringRecord(AStream: TStream); override;
procedure ReadWorkbookGlobals(AStream: TStream); override; procedure ReadWorkbookGlobals(AStream: TStream); override;
procedure ReadWorksheet(AStream: TStream); override; procedure ReadWorksheet(AStream: TStream); override;
@ -100,14 +100,14 @@ type
protected protected
function FunctionSupported(AExcelCode: Integer; const AFuncName: String): Boolean; override; function FunctionSupported(AExcelCode: Integer; const AFuncName: String): Boolean; override;
procedure InternalWriteToStream(AStream: TStream); procedure InternalWriteToStream(AStream: TStream);
procedure PopulatePalette(AWorkbook: TsWorkbook); override; procedure PopulatePalette(AWorkbook: TsBasicWorkbook); override;
{ Record writing methods } { Record writing methods }
procedure WriteBOF(AStream: TStream; ADataType: Word); procedure WriteBOF(AStream: TStream; ADataType: Word);
function WriteBoundsheet(AStream: TStream; AWorkSheet: TsWorksheet): Int64; function WriteBoundsheet(AStream: TStream; AWorkSheet: TsBasicWorksheet): Int64;
procedure WriteDefinedName(AStream: TStream; AWorksheet: TsWorksheet; procedure WriteDefinedName(AStream: TStream; AWorksheet: TsBasicWorksheet;
const AName: String; AIndexToREF, ASheetIndex: Word; const AName: String; AIndexToREF, ASheetIndex: Word;
AKind: TsBIFFExternKind); override; AKind: TsBIFFExternKind); override;
procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteDimensions(AStream: TStream; AWorksheet: TsBasicWorksheet);
procedure WriteEOF(AStream: TStream); procedure WriteEOF(AStream: TStream);
procedure WriteFont(AStream: TStream; AFont: TsFont); procedure WriteFont(AStream: TStream; AFont: TsFont);
procedure WriteFonts(AStream: TStream); procedure WriteFonts(AStream: TStream);
@ -117,16 +117,17 @@ type
procedure WriteIndex(AStream: TStream); procedure WriteIndex(AStream: TStream);
procedure WriteLABEL(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteLABEL(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override; const AValue: string; ACell: PCell); override;
procedure WriteLocalLinkTable(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteLocalLinkTable(AStream: TStream;
AWorksheet: TsBasicWorksheet);
function WriteRPNSheetIndex(AStream: TStream; ADocumentURL: String; function WriteRPNSheetIndex(AStream: TStream; ADocumentURL: String;
ASheet1, ASheet2: Integer): Word; override; ASheet1, ASheet2: Integer): Word; override;
procedure WriteStringRecord(AStream: TStream; AString: String); override; procedure WriteStringRecord(AStream: TStream; AString: String); override;
procedure WriteStyle(AStream: TStream); procedure WriteStyle(AStream: TStream);
procedure WriteWindow2(AStream: TStream; ASheet: TsWorksheet); procedure WriteWindow2(AStream: TStream; ASheet: TsBasicWorksheet);
procedure WriteXF(AStream: TStream; AFormatRecord: PsCellFormat; procedure WriteXF(AStream: TStream; AFormatRecord: PsCellFormat;
XFType_Prot: Byte = 0); override; XFType_Prot: Byte = 0); override;
public public
constructor Create(AWorkbook: TsWorkbook); override; constructor Create(AWorkbook: TsBasicWorkbook); override;
{ General writing methods } { General writing methods }
procedure WriteToFile(const AFileName: string; procedure WriteToFile(const AFileName: string;
const AOverwriteExisting: Boolean = False; AParams: TsStreamParams = []); override; const AOverwriteExisting: Boolean = False; AParams: TsStreamParams = []); override;
@ -228,7 +229,8 @@ uses
LazLogger, LazLogger,
{$ENDIF} {$ENDIF}
Math, Math,
fpsStrings, fpsReaderWriter, fpsStreams, fpsPalette, fpsNumFormat, xlsconst; fpsStrings, fpspreadsheet, fpsReaderWriter, fpsStreams,
fpsPalette, fpsNumFormat, xlsconst;
const const
{ Excel record IDs } { Excel record IDs }
@ -397,7 +399,9 @@ begin
SetLength(s, len); SetLength(s, len);
AStream.ReadBuffer(s[1], len*SizeOf(AnsiChar)); AStream.ReadBuffer(s[1], len*SizeOf(AnsiChar));
sheet := FWorkbook.AddWorksheet(ConvertEncoding(s, FCodePage, EncodingUTF8), true); sheet := (FWorkbook as TsWorkbook).AddWorksheet(
ConvertEncoding(s, FCodePage, EncodingUTF8), true
);
if sheetState <> 0 then if sheetState <> 0 then
sheet.Options := sheet.Options + [soHidden]; sheet.Options := sheet.Options + [soHidden];
end; end;
@ -513,7 +517,7 @@ var
RecordType: Word; RecordType: Word;
CurStreamPos: Int64; CurStreamPos: Int64;
begin begin
FWorksheet := FWorkbook.GetWorksheetByIndex(FCurSheetIndex); FWorksheet := (FWorkbook as TsWorkbook).GetWorksheetByIndex(FCurSheetIndex);
while (not SectionEOF) do while (not SectionEOF) do
begin begin
{ Read the record header } { Read the record header }
@ -703,15 +707,20 @@ var
rtfRuns: TBiff5_RichTextFormattingRuns; rtfRuns: TBiff5_RichTextFormattingRuns;
fntIndex: Integer; fntIndex: Integer;
fnt: TsFont; fnt: TsFont;
sheet: TsWorksheet;
book: TsWorkbook;
begin begin
sheet := TsWorksheet(FWorksheet);
book := TsWorkbook(FWorkbook);
ReadRowColXF(AStream, ARow, ACol, XF); ReadRowColXF(AStream, ARow, ACol, XF);
{ Create cell } { Create cell }
if FIsVirtualMode then begin if FIsVirtualMode then begin
InitCell(FWorksheet, ARow, ACol, FVirtualCell); InitCell(sheet, ARow, ACol, FVirtualCell);
cell := @FVirtualCell; cell := @FVirtualCell;
end else end else
cell := FWorksheet.AddCell(ARow, ACol); cell := sheet.AddCell(ARow, ACol);
{ Read data string (Byte string with 16-bit length) } { Read data string (Byte string with 16-bit length) }
L := WordLEtoN(AStream.ReadWord); L := WordLEtoN(AStream.ReadWord);
@ -720,7 +729,7 @@ begin
{ Save the data string to cell } { Save the data string to cell }
valueStr := ConvertEncoding(ansistr, FCodePage, encodingUTF8); valueStr := ConvertEncoding(ansistr, FCodePage, encodingUTF8);
FWorksheet.WriteText(cell, valuestr); sheet.WriteText(cell, valuestr);
{ Read rich-text formatting runs } { Read rich-text formatting runs }
B := AStream.ReadByte; B := AStream.ReadByte;
@ -734,9 +743,9 @@ begin
// in the file is different from the font index stored by the workbook. // in the file is different from the font index stored by the workbook.
fntIndex := rtfRuns[i].FontIndex; fntIndex := rtfRuns[i].FontIndex;
fnt := TsFont(FFontList[fntIndex]); fnt := TsFont(FFontList[fntIndex]);
fntIndex := FWorkbook.FindFont(fnt.FontName, fnt.Size, fnt.Style,fnt.Color, fnt.Position); fntIndex := book.FindFont(fnt.FontName, fnt.Size, fnt.Style,fnt.Color, fnt.Position);
if fntIndex = -1 then if fntIndex = -1 then
fntIndex := FWorkbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position); fntIndex := book.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position);
cell^.RichTextParams[i].FontIndex := fntIndex; cell^.RichTextParams[i].FontIndex := fntIndex;
// Hyperlink index (not used here) // Hyperlink index (not used here)
cell^.RichTextParams[i].HyperlinkIndex := -1; cell^.RichTextParams[i].HyperlinkIndex := -1;
@ -746,20 +755,21 @@ begin
ApplyCellFormatting(cell, XF); ApplyCellFormatting(cell, XF);
if FIsVirtualMode then if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell); book.OnReadCellData(Workbook, ARow, ACol, cell);
end; end;
{ Reads the default column width that is used when a bit in the GCW bit structure { Reads the default column width that is used when a bit in the GCW bit structure
is set for the corresponding column. The GCW is ignored here. The column is set for the corresponding column. The GCW is ignored here. The column
width read from the STANDARDWIDTH record overrides the one from the width read from the STANDARDWIDTH record overrides the one from the
DEFCOLWIDTH record. } DEFCOLWIDTH record. }
procedure TsSpreadBIFF5Reader.ReadStandardWidth(AStream: TStream; ASheet: TsWorksheet); procedure TsSpreadBIFF5Reader.ReadStandardWidth(AStream: TStream;
ASheet: TsBasicWorksheet);
var var
w: Word; w: Word;
begin begin
// read width in 1/256 of the width of "0" character // read width in 1/256 of the width of "0" character
w := WordLEToN(AStream.ReadWord); w := WordLEToN(AStream.ReadWord);
ASheet.WriteDefaultRowHeight(w / 256, suChars); (ASheet as TsWorksheet).WriteDefaultRowHeight(w / 256, suChars);
end; end;
{ Reads a STRING record which contains the result of string formula. } { Reads a STRING record which contains the result of string formula. }
@ -777,7 +787,9 @@ begin
FIncompletecell^.UTF8StringValue := ConvertEncoding(s, FCodePage, encodingUTF8); FIncompletecell^.UTF8StringValue := ConvertEncoding(s, FCodePage, encodingUTF8);
FIncompleteCell^.ContentType := cctUTF8String; FIncompleteCell^.ContentType := cctUTF8String;
if FIsVirtualMode then if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, FIncompleteCell^.Row, FIncompleteCell^.Col, FIncompleteCell); (Workbook as TsWorkbook).OnReadCellData(
Workbook, FIncompleteCell^.Row, FIncompleteCell^.Col, FIncompleteCell
);
end; end;
end; end;
FIncompleteCell := nil; FIncompleteCell := nil;
@ -823,8 +835,10 @@ var
dw: DWord; dw: DWord;
fill: Word; fill: Word;
fs: TsFillStyle; fs: TsFillStyle;
// fnt: TsFont; book: TsWorkbook;
begin begin
book := FWorkbook as TsWorkbook;
InitFormatRecord(fmt); InitFormatRecord(fmt);
fmt.ID := FCellFormatList.Count; fmt.ID := FCellFormatList.Count;
@ -843,8 +857,8 @@ begin
// "General" (NumFormatIndex = 0) not stored in workbook's NumFormatList // "General" (NumFormatIndex = 0) not stored in workbook's NumFormatList
if (rec.NumFormatIndex > 0) and not SameText(nfs, 'General') then if (rec.NumFormatIndex > 0) and not SameText(nfs, 'General') then
begin begin
fmt.NumberFormatIndex := Workbook.AddNumberFormat(nfs); fmt.NumberFormatIndex := book.AddNumberFormat(nfs);
nfParams := Workbook.GetNumberFormat(fmt.NumberFormatIndex); nfParams := book.GetNumberFormat(fmt.NumberFormatIndex);
fmt.NumberFormat := nfParams.NumFormat; fmt.NumberFormat := nfParams.NumFormat;
fmt.NumberFormatStr := nfs; fmt.NumberFormatStr := nfs;
Include(fmt.UsedFormattingFields, uffNumberFormat); Include(fmt.UsedFormattingFields, uffNumberFormat);
@ -1090,7 +1104,7 @@ begin
if FFontList.Count = 4 then FFontList.Add(nil); if FFontList.Count = 4 then FFontList.Add(nil);
if isDefaultFont then if isDefaultFont then
FWorkbook.SetDefaultFont(font.FontName, font.Size); (FWorkbook as TsWorkbook).SetDefaultFont(font.FontName, font.Size);
end; end;
// Read the FORMAT record for formatting numerical data // Read the FORMAT record for formatting numerical data
@ -1149,17 +1163,17 @@ begin
InitCell(FWorksheet, ARow, ACol, FVirtualCell); InitCell(FWorksheet, ARow, ACol, FVirtualCell);
cell := @FVirtualCell; cell := @FVirtualCell;
end else end else
cell := FWorksheet.AddCell(ARow, ACol); cell := (FWorksheet as TsWorksheet).AddCell(ARow, ACol);
{ Save the data } { Save the data }
valueStr := ConvertEncoding(ansistr, FCodePage, encodingUTF8); valueStr := ConvertEncoding(ansistr, FCodePage, encodingUTF8);
FWorksheet.WriteText(cell, valueStr); //ISO_8859_1ToUTF8(ansistr)); (FWorksheet as TsWorksheet).WriteText(cell, valueStr); //ISO_8859_1ToUTF8(ansistr));
{ Add attributes } { Add attributes }
ApplyCellFormatting(cell, XF); ApplyCellFormatting(cell, XF);
if FIsVirtualMode then if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell); (Workbook as TsWorkbook).OnReadCellData(Workbook, ARow, ACol, cell);
end; end;
@ -1167,7 +1181,7 @@ end;
{ TsSpreadBIFF5Writer } { TsSpreadBIFF5Writer }
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
constructor TsSpreadBIFF5Writer.Create(AWorkbook: TsWorkbook); constructor TsSpreadBIFF5Writer.Create(AWorkbook: TsBasicWorkbook);
begin begin
inherited Create(AWorkbook); inherited Create(AWorkbook);
FDateMode := Excel5Settings.DateMode; FDateMode := Excel5Settings.DateMode;
@ -1192,14 +1206,17 @@ var
sheetPos: array of Int64; sheetPos: array of Int64;
i: Integer; i: Integer;
pane: Byte; pane: Byte;
book: TsWorkbook;
begin begin
book := FWorkbook as TsWorkbook;
{ Write workbook globals } { Write workbook globals }
WriteBOF(AStream, INT_BOF_WORKBOOK_GLOBALS); WriteBOF(AStream, INT_BOF_WORKBOOK_GLOBALS);
WriteCODEPAGE(AStream, FCodePage); WriteCODEPAGE(AStream, FCodePage);
WriteWindowProtect(AStream, bpLockWindows in Workbook.Protection); WriteWindowProtect(AStream, bpLockWindows in Workbook.Protection);
WritePROTECT(AStream, bpLockStructure in Workbook.Protection); WritePROTECT(AStream, bpLockStructure in Workbook.Protection);
WritePASSWORD(AStream, Workbook.CryptoInfo); WritePASSWORD(AStream, book.CryptoInfo);
WriteGlobalLinkTable(AStream); WriteGlobalLinkTable(AStream);
WriteDefinedNames(AStream); WriteDefinedNames(AStream);
WriteWINDOW1(AStream); WriteWINDOW1(AStream);
@ -1210,17 +1227,17 @@ begin
WriteStyle(AStream); WriteStyle(AStream);
// A BOUNDSHEET for each worksheet // A BOUNDSHEET for each worksheet
SetLength(sheetPos, Workbook.GetWorksheetCount); SetLength(sheetPos, book.GetWorksheetCount);
for i := 0 to Workbook.GetWorksheetCount - 1 do for i := 0 to book.GetWorksheetCount - 1 do
sheetPos[i] := WriteBoundsheet(AStream, Workbook.GetWorksheetByIndex(i)); sheetPos[i] := WriteBoundsheet(AStream, book.GetWorksheetByIndex(i));
WriteEOF(AStream); WriteEOF(AStream);
{ Write each worksheet } { Write each worksheet }
for i := 0 to Workbook.GetWorksheetCount - 1 do for i := 0 to book.GetWorksheetCount - 1 do
begin begin
FWorksheet := Workbook.GetWorksheetByIndex(i); FWorksheet := book.GetWorksheetByIndex(i);
{ First goes back and writes the position of the BOF of the { First goes back and writes the position of the BOF of the
sheet on the respective BOUNDSHEET record } sheet on the respective BOUNDSHEET record }
@ -1255,7 +1272,7 @@ begin
WritePROTECT(AStream, true); WritePROTECT(AStream, true);
// WriteScenarioProtect(AStream); // WriteScenarioProtect(AStream);
WriteObjectProtect(AStream, FWorksheet); WriteObjectProtect(AStream, FWorksheet);
WritePASSWORD(AStream, FWorksheet.CryptoInfo); WritePASSWORD(AStream, TsWorksheet(FWorksheet).CryptoInfo);
end; end;
WriteDefaultColWidth(AStream, FWorksheet); WriteDefaultColWidth(AStream, FWorksheet);
@ -1271,7 +1288,7 @@ begin
WriteVirtualCells(AStream, FWorksheet) WriteVirtualCells(AStream, FWorksheet)
else begin else begin
WriteRows(AStream, FWorksheet); WriteRows(AStream, FWorksheet);
WriteCellsToStream(AStream, FWorksheet.Cells); WriteCellsToStream(AStream, TsWorksheet(FWorksheet).Cells);
end; end;
WriteEOF(AStream); WriteEOF(AStream);
@ -1287,7 +1304,7 @@ end;
BIFF8 begins with the 8 default colors which are duplicated. Then the user BIFF8 begins with the 8 default colors which are duplicated. Then the user
colors follow up to a max of total 64 entries. colors follow up to a max of total 64 entries.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFF5Writer.PopulatePalette(AWorkbook: TsWorkbook); procedure TsSpreadBIFF5Writer.PopulatePalette(AWorkbook: TsBasicWorkbook);
var var
i: Integer; i: Integer;
begin begin
@ -1405,7 +1422,7 @@ end;
of the BOF of this sheet should be written (4 bytes size). of the BOF of this sheet should be written (4 bytes size).
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsSpreadBIFF5Writer.WriteBoundsheet(AStream: TStream; function TsSpreadBIFF5Writer.WriteBoundsheet(AStream: TStream;
AWorkSheet: TsWorksheet): Int64; AWorkSheet: TsBasicWorksheet): Int64;
var var
len: Byte; len: Byte;
xlsSheetName: ansistring; xlsSheetName: ansistring;
@ -1442,8 +1459,8 @@ end;
Writes out a DEFINEDNAMES record Writes out a DEFINEDNAMES record
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFF5Writer.WriteDefinedName(AStream: TStream; procedure TsSpreadBIFF5Writer.WriteDefinedName(AStream: TStream;
AWorksheet: TsWorksheet; const AName: String; AIndexToREF, ASheetIndex: Word; AWorksheet: TsBasicWorksheet; const AName: String;
AKind: TsBIFFExternKind); AIndexToREF, ASheetIndex: Word; AKind: TsBIFFExternKind);
procedure WriteRangeFormula(MemStream: TMemoryStream; ARange: TsCellRange; procedure WriteRangeFormula(MemStream: TMemoryStream; ARange: TsCellRange;
AIndexToREF, ASheetIndex, ACounter: Word); AIndexToREF, ASheetIndex, ACounter: Word);
@ -1503,42 +1520,46 @@ var
memstream: TMemoryStream; memstream: TMemoryStream;
rng: TsCellRange; rng: TsCellRange;
j: Integer; j: Integer;
sheet: TsWorksheet;
begin begin
sheet := AWorksheet as TsWorksheet;
// Since this is a variable length record we begin by writing the formula // Since this is a variable length record we begin by writing the formula
// to a memory stream // to a memory stream
memstream := TMemoryStream.Create; memstream := TMemoryStream.Create;
try try
case AName of case AName of
#06: begin // Print range #06: begin // Print range
for j := 0 to AWorksheet.PageLayout.NumPrintRanges-1 do for j := 0 to sheet.PageLayout.NumPrintRanges-1 do
begin begin
rng := AWorksheet.PageLayout.PrintRange[j]; rng := sheet.PageLayout.PrintRange[j];
WriteRangeFormula(memstream, rng, AIndexToRef, ASheetIndex, j+1); WriteRangeFormula(memstream, rng, AIndexToRef, ASheetIndex, j+1);
end; end;
end; end;
#07: begin #07: begin
j := 1; j := 1;
if AWorksheet.PageLayout.HasRepeatedCols then if sheet.PageLayout.HasRepeatedCols then
begin begin
rng.Col1 := AWorksheet.PageLayout.RepeatedCols.FirstIndex; rng.Col1 := sheet.PageLayout.RepeatedCols.FirstIndex;
rng.Col2 := AWorksheet.PageLayout.RepeatedCols.LastIndex; rng.Col2 := sheet.PageLayout.RepeatedCols.LastIndex;
if rng.Col2 = UNASSIGNED_ROW_COL_INDEX then rng.Col2 := rng.Col1; if rng.Col2 = UNASSIGNED_ROW_COL_INDEX then rng.Col2 := rng.Col1;
rng.Row1 := 0; rng.Row1 := 0;
rng.Row2 := 65535; rng.Row2 := 65535;
WriteRangeFormula(memstream, rng, AIndexToRef, ASheetIndex, j); WriteRangeFormula(memstream, rng, AIndexToRef, ASheetIndex, j);
inc(j); inc(j);
end; end;
if AWorksheet.PageLayout.HasRepeatedRows then if sheet.PageLayout.HasRepeatedRows then
begin begin
rng.Row1 := AWorksheet.PageLayout.RepeatedRows.FirstIndex; rng.Row1 := sheet.PageLayout.RepeatedRows.FirstIndex;
rng.Row2 := AWorksheet.PageLayout.RepeatedRows.LastIndex; rng.Row2 := sheet.PageLayout.RepeatedRows.LastIndex;
if rng.Row2 = UNASSIGNED_ROW_COL_INDEX then rng.Row2 := rng.Row1; if rng.Row2 = UNASSIGNED_ROW_COL_INDEX then rng.Row2 := rng.Row1;
rng.Col1 := 0; rng.Col1 := 0;
rng.Col2 := 255; rng.Col2 := 255;
WriteRangeFormula(memstream, rng, AIndexToRef, ASheetIndex, j); WriteRangeFormula(memstream, rng, AIndexToRef, ASheetIndex, j);
end; end;
end; end;
else raise EFPSpreadsheetWriter.Create('Name not supported'); else
raise EFPSpreadsheetWriter.Create('Name not supported');
end; // case end; // case
{ BIFF record header } { BIFF record header }
@ -1598,7 +1619,8 @@ end;
See bug 18886: excel5 files are truncated when imported See bug 18886: excel5 files are truncated when imported
--------------------------------------------------------------------------------} --------------------------------------------------------------------------------}
procedure TsSpreadBIFF5Writer.WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet); procedure TsSpreadBIFF5Writer.WriteDimensions(AStream: TStream;
AWorksheet: TsBasicWorksheet);
var var
rec: TBIFF5_DimensionsRecord; rec: TBIFF5_DimensionsRecord;
firstCol, lastCol, firstRow, lastRow: Cardinal; firstCol, lastCol, firstRow, lastRow: Cardinal;
@ -1704,8 +1726,8 @@ procedure TsSpreadBiff5Writer.WriteFonts(AStream: TStream);
var var
i: Integer; i: Integer;
begin begin
for i:=0 to Workbook.GetFontCount-1 do for i:=0 to TsWorkbook(Workbook).GetFontCount-1 do
WriteFont(AStream, Workbook.GetFont(i)); WriteFont(AStream, TsWorkbook(Workbook).GetFont(i));
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -1907,7 +1929,7 @@ end;
internal 3D references to other sheets internal 3D references to other sheets
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFF5Writer.WriteLocalLinkTable(AStream: TStream; procedure TsSpreadBIFF5Writer.WriteLocalLinkTable(AStream: TStream;
AWorksheet: TsWorksheet); AWorksheet: TsBasicWorksheet);
var var
i, n: Integer; i, n: Integer;
externSheetList: TsBIFFExternSheetList; externSheetList: TsBIFFExternSheetList;
@ -1993,7 +2015,7 @@ begin
externSheetList := FLinkLists.GetLocalLinks(FWorksheet); externSheetList := FLinkLists.GetLocalLinks(FWorksheet);
s := FWorkbook.GetWorksheetByIndex(ASheet1).Name; s := (FWorkbook as TsWorkbook).GetWorksheetByIndex(ASheet1).Name;
externSheetIdx := externSheetList.IndexOfSheet(s); externSheetIdx := externSheetList.IndexOfSheet(s);
if ASheet2 = -1 then if ASheet2 = -1 then
@ -2065,11 +2087,14 @@ end;
Writes an Excel 5 WINDOW2 record Writes an Excel 5 WINDOW2 record
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFF5Writer.WriteWindow2(AStream: TStream; procedure TsSpreadBIFF5Writer.WriteWindow2(AStream: TStream;
ASheet: TsWorksheet); ASheet: TsBasicWorksheet);
var var
Options: Word; Options: Word;
book: TsWorkbook;
actSheet: TsWorksheet; actSheet: TsWorksheet;
begin begin
book := FWorkbook as TsWorkbook;
{ BIFF Record header } { BIFF Record header }
WriteBiffHeader(AStream, INT_EXCEL_ID_WINDOW2, 10); WriteBiffHeader(AStream, INT_EXCEL_ID_WINDOW2, 10);
@ -2087,13 +2112,15 @@ begin
Options := Options or MASK_WINDOW2_OPTION_SHOW_GRID_LINES; Options := Options or MASK_WINDOW2_OPTION_SHOW_GRID_LINES;
if (soShowHeaders in ASheet.Options) then if (soShowHeaders in ASheet.Options) then
Options := Options or MASK_WINDOW2_OPTION_SHOW_SHEET_HEADERS; Options := Options or MASK_WINDOW2_OPTION_SHOW_SHEET_HEADERS;
if (soHasFrozenPanes in ASheet.Options) and ((ASheet.LeftPaneWidth > 0) or (ASheet.TopPaneHeight > 0)) then if (soHasFrozenPanes in ASheet.Options) and
((TsWorksheet(ASheet).LeftPaneWidth > 0) or (TsWorksheet(ASheet).TopPaneHeight > 0))
then
Options := Options or MASK_WINDOW2_OPTION_PANES_ARE_FROZEN; Options := Options or MASK_WINDOW2_OPTION_PANES_ARE_FROZEN;
if (ASheet.BiDiMode = bdRTL) then if (TsWorksheet(ASheet).BiDiMode = bdRTL) then
Options := Options or MASK_WINDOW2_OPTION_COLUMNS_RIGHT_TO_LEFT; Options := Options or MASK_WINDOW2_OPTION_COLUMNS_RIGHT_TO_LEFT;
if FWorkbook.ActiveWorksheet <> nil then if book.ActiveWorksheet <> nil then
actSheet := FWorkbook.ActiveWorksheet else actSheet := book.ActiveWorksheet else
actSheet := Fworkbook.GetWorksheetByIndex(0); actSheet := book.GetWorksheetByIndex(0);
if (ASheet = actSheet) then if (ASheet = actSheet) then
Options := Options or MASK_WINDOW2_OPTION_SHEET_ACTIVE or MASK_WINDOW2_OPTION_SHEET_SELECTED; Options := Options or MASK_WINDOW2_OPTION_SHEET_ACTIVE or MASK_WINDOW2_OPTION_SHEET_SELECTED;
@ -2160,7 +2187,7 @@ begin
j := 0; j := 0;
if (AFormatRecord <> nil) and (uffNumberFormat in AFormatRecord^.UsedFormattingFields) if (AFormatRecord <> nil) and (uffNumberFormat in AFormatRecord^.UsedFormattingFields)
then begin then begin
nfParams := Workbook.GetNumberFormat(AFormatRecord^.NumberFormatIndex); nfParams := TsWorkbook(Workbook).GetNumberFormat(AFormatRecord^.NumberFormatIndex);
nfs := nfParams.NumFormatStr; nfs := nfParams.NumFormatStr;
j := NumFormatList.IndexOf(nfs); j := NumFormatList.IndexOf(nfs);
if j = -1 then j := 0; if j = -1 then j := 0;

249
components/fpspreadsheet/source/common/xlsbiff8.pas
View File

@ -55,7 +55,7 @@ interface
uses uses
Classes, SysUtils, fpcanvas, DateUtils, contnrs, lazutf8, Classes, SysUtils, fpcanvas, DateUtils, contnrs, lazutf8,
fpstypes, fpspreadsheet, xlscommon, fpstypes, xlscommon,
{$ifdef USE_NEW_OLE} {$ifdef USE_NEW_OLE}
fpolebasic, fpolebasic,
{$else} {$else}
@ -175,7 +175,7 @@ type
procedure ReadWorksheet(AStream: TStream); override; procedure ReadWorksheet(AStream: TStream); override;
public public
constructor Create(AWorkbook: TsWorkbook); override; constructor Create(AWorkbook: TsBasicWorkbook); override;
destructor Destroy; override; destructor Destroy; override;
procedure ReadFromStream(AStream: TStream; procedure ReadFromStream(AStream: TStream;
APassword: String = ''; AParams: TsStreamParams = []); override; APassword: String = ''; AParams: TsStreamParams = []); override;
@ -203,19 +203,20 @@ type
function IndexOfSharedString(const AText: String; function IndexOfSharedString(const AText: String;
const ARichTextParams: TsRichTextParams): Integer; const ARichTextParams: TsRichTextParams): Integer;
procedure InternalWriteToStream(AStream: TStream); procedure InternalWriteToStream(AStream: TStream);
procedure PopulatePalette(AWorkbook: TsWorkbook); override; procedure PopulatePalette(AWorkbook: TsBasicWorkbook); override;
procedure PopulateSharedStringTable(AWorkbook: TsWorkbook); procedure PopulateSharedStringTable(AWorkbook: TsBasicWorkbook);
{ Record writing methods } { Record writing methods }
procedure WriteBOF(AStream: TStream; ADataType: Word); procedure WriteBOF(AStream: TStream; ADataType: Word);
function WriteBoundsheet(AStream: TStream; AWorksheet: TsWorksheet): Int64; function WriteBoundsheet(AStream: TStream;
AWorksheet: TsBasicWorksheet): Int64;
procedure WriteComment(AStream: TStream; ACell: PCell); override; procedure WriteComment(AStream: TStream; ACell: PCell); override;
procedure WriteComments(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteComments(AStream: TStream; AWorksheet: TsBasicWorksheet);
procedure WriteDefinedName(AStream: TStream; AWorksheet: TsWorksheet; procedure WriteDefinedName(AStream: TStream; AWorksheet: TsBasicWorksheet;
const AName: String; AIndexToREF, ASheetIndex: Word; const AName: String; AIndexToREF, ASheetIndex: Word;
AKind: TsBIFFExternKind); AKind: TsBIFFExternKind);
procedure WriteDefinedNames(AStream: TStream); procedure WriteDefinedNames(AStream: TStream);
procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteDimensions(AStream: TStream; AWorksheet: TsBasicWorksheet);
procedure WriteEOF(AStream: TStream); procedure WriteEOF(AStream: TStream);
procedure WriteEXTERNBOOK(AStream: TStream; AUrl: String); procedure WriteEXTERNBOOK(AStream: TStream; AUrl: String);
procedure WriteEXTERNSHEET(AStream: TStream); procedure WriteEXTERNSHEET(AStream: TStream);
@ -225,14 +226,14 @@ type
ANumFormatIndex: Integer); override; ANumFormatIndex: Integer); override;
procedure WriteHeaderFooter(AStream: TStream; AIsHeader: Boolean); override; procedure WriteHeaderFooter(AStream: TStream; AIsHeader: Boolean); override;
procedure WriteHyperlink(AStream: TStream; AHyperlink: PsHyperlink; procedure WriteHyperlink(AStream: TStream; AHyperlink: PsHyperlink;
AWorksheet: TsWorksheet); AWorksheet: TsBasicWorksheet);
procedure WriteHyperlinks(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteHyperlinks(AStream: TStream; AWorksheet: TsBasicWorksheet);
procedure WriteHyperlinkToolTip(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteHyperlinkToolTip(AStream: TStream; const ARow, ACol: Cardinal;
const ATooltip: String); const ATooltip: String);
procedure WriteINDEX(AStream: TStream); procedure WriteINDEX(AStream: TStream);
procedure WriteLABEL(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteLABEL(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override; const AValue: string; ACell: PCell); override;
procedure WriteMergedCells(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteMergedCells(AStream: TStream; AWorksheet: TsBasicWorksheet);
procedure WriteMSODrawing1(AStream: TStream; ANumShapes: Word; AComment: PsComment); procedure WriteMSODrawing1(AStream: TStream; ANumShapes: Word; AComment: PsComment);
procedure WriteMSODrawing2(AStream: TStream; AComment: PsComment; AObjID: Word); procedure WriteMSODrawing2(AStream: TStream; AComment: PsComment; AObjID: Word);
procedure WriteMSODrawing2_Data(AStream: TStream; AComment: PsComment; AShapeID: Word); procedure WriteMSODrawing2_Data(AStream: TStream; AComment: PsComment; AShapeID: Word);
@ -255,11 +256,11 @@ type
procedure WriteSTRINGRecord(AStream: TStream; AString: string); override; procedure WriteSTRINGRecord(AStream: TStream; AString: string); override;
procedure WriteSTYLE(AStream: TStream); procedure WriteSTYLE(AStream: TStream);
procedure WriteTXO(AStream: TStream; AComment: PsComment); procedure WriteTXO(AStream: TStream; AComment: PsComment);
procedure WriteWINDOW2(AStream: TStream; ASheet: TsWorksheet); procedure WriteWINDOW2(AStream: TStream; ASheet: TsBasicWorksheet);
procedure WriteXF(AStream: TStream; AFormatRecord: PsCellFormat; procedure WriteXF(AStream: TStream; AFormatRecord: PsCellFormat;
XFType_Prot: Byte = 0); override; XFType_Prot: Byte = 0); override;
public public
constructor Create(AWorkbook: TsWorkbook); override; constructor Create(AWorkbook: TsBasicWorkbook); override;
destructor Destroy; override; destructor Destroy; override;
{ General writing methods } { General writing methods }
procedure WriteToFile(const AFileName: string; procedure WriteToFile(const AFileName: string;
@ -363,7 +364,7 @@ uses
{$ENDIF} {$ENDIF}
Math, lconvencoding, LazFileUtils, URIParser, Math, lconvencoding, LazFileUtils, URIParser,
fpsStrings, {%H-}fpsPatches, fpsStreams, fpsReaderWriter, fpsPalette, fpsStrings, {%H-}fpsPatches, fpsStreams, fpsReaderWriter, fpsPalette,
fpsNumFormat, fpsExprParser, xlsEscher; fpspreadsheet, fpsNumFormat, fpsExprParser, xlsEscher;
const const
{ Excel record IDs } { Excel record IDs }
@ -769,7 +770,7 @@ end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
{ TsSpreadBIFF8Reader } { TsSpreadBIFF8Reader }
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
constructor TsSpreadBIFF8Reader.Create(AWorkbook: TsWorkbook); constructor TsSpreadBIFF8Reader.Create(AWorkbook: TsBasicWorkbook);
begin begin
inherited; inherited;
InitBIFF8Limitations(FLimitations); InitBIFF8Limitations(FLimitations);
@ -858,7 +859,7 @@ begin
if TBIFF8Comment(FCommentList[i]).ID = commentID then if TBIFF8Comment(FCommentList[i]).ID = commentID then
begin begin
commentText := TBIFF8Comment(FCommentList[i]).Text; commentText := TBIFF8Comment(FCommentList[i]).Text;
FWorksheet.WriteComment(r, c, commentText); TsWorksheet(FWorksheet).WriteComment(r, c, commentText);
exit; exit;
end; end;
end; end;
@ -1158,7 +1159,7 @@ var
RecordType: Word; RecordType: Word;
CurStreamPos: Int64; CurStreamPos: Int64;
begin begin
FWorksheet := FWorkbook.GetWorksheetByIndex(FCurSheetIndex); FWorksheet := (FWorkbook as TsWorkbook).GetWorksheetByIndex(FCurSheetIndex);
while (not SectionEOF) do while (not SectionEOF) do
begin begin
{ Read the record header } { Read the record header }
@ -1269,7 +1270,7 @@ begin
{ Read string with flags } { Read string with flags }
wideName := ReadWideString(AStream, len, rtParams); wideName := ReadWideString(AStream, len, rtParams);
sheet := FWorkbook.AddWorksheet(UTF8Encode(widename), true); sheet := (FWorkbook as TsWorkbook).AddWorksheet(UTF8Encode(widename), true);
if sheetState <> 0 then if sheetState <> 0 then
sheet.Options := sheet.Options + [soHidden]; sheet.Options := sheet.Options + [soHidden];
end; end;
@ -1357,7 +1358,10 @@ var
rtParams: TsRichTextParams; rtParams: TsRichTextParams;
fntIndex: Integer; fntIndex: Integer;
fnt: TsFont; fnt: TsFont;
book: TsWorkbook;
begin begin
book := FWorkbook as TsWorkbook;
{ BIFF Record data: Row, Column, XF Index } { BIFF Record data: Row, Column, XF Index }
ReadRowColXF(AStream, ARow, ACol, XF); ReadRowColXF(AStream, ARow, ACol, XF);
@ -1372,9 +1376,9 @@ begin
InitCell(FWorksheet, ARow, ACol, FVirtualCell); // "virtual" cell InitCell(FWorksheet, ARow, ACol, FVirtualCell); // "virtual" cell
cell := @FVirtualCell; cell := @FVirtualCell;
end else end else
cell := FWorksheet.AddCell(ARow, ACol); // "real" cell cell := (FWorksheet as TsWorksheet).AddCell(ARow, ACol); // "real" cell
FWorksheet.WriteText(cell, UTF16ToUTF8(wideStrValue)); (FWorksheet as TsWorksheet).WriteText(cell, UTF16ToUTF8(wideStrValue));
{ Add attributes } { Add attributes }
ApplyCellFormatting(cell, XF); ApplyCellFormatting(cell, XF);
@ -1389,9 +1393,9 @@ begin
// Font index of new format - need to adjust index! // Font index of new format - need to adjust index!
fntIndex := rtParams[i].FontIndex; fntIndex := rtParams[i].FontIndex;
fnt := TsFont(FFontList[fntIndex]); fnt := TsFont(FFontList[fntIndex]);
fntIndex := FWorkbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position); fntIndex := book.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position);
if fntIndex = -1 then if fntIndex = -1 then
fntIndex := FWorkbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position); fntIndex := book.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position);
cell^.RichTextParams[i].FontIndex := fntIndex; cell^.RichTextParams[i].FontIndex := fntIndex;
// Hyperlink index, not used here // Hyperlink index, not used here
cell^.RichTextParams[i].HyperlinkIndex := -1; cell^.RichTextParams[i].HyperlinkIndex := -1;
@ -1399,7 +1403,7 @@ begin
end; end;
if FIsVirtualMode then if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell); book.OnReadCellData(Workbook, ARow, ACol, cell);
end; end;
procedure TsSpreadBIFF8Reader.ReadMergedCells(const AStream: TStream); procedure TsSpreadBIFF8Reader.ReadMergedCells(const AStream: TStream);
@ -1416,7 +1420,7 @@ begin
// Read range // Read range
AStream.ReadBuffer(rng, SizeOf(rng)); AStream.ReadBuffer(rng, SizeOf(rng));
// Transfer cell range to worksheet // Transfer cell range to worksheet
FWorksheet.MergeCells( (FWorksheet as TsWorksheet).MergeCells(
WordLEToN(rng.Row1), WordLEToN(rng.Col1), WordLEToN(rng.Row1), WordLEToN(rng.Col1),
WordLEToN(rng.Row2), WordLEToN(rng.Col2) WordLEToN(rng.Row2), WordLEToN(rng.Col2)
); );
@ -1629,7 +1633,10 @@ var
rtfRuns: TBiff8_RichTextFormattingRuns; rtfRuns: TBiff8_RichTextFormattingRuns;
fntIndex: Integer; fntIndex: Integer;
fnt: TsFont; fnt: TsFont;
book: TsWorkbook;
begin begin
book := FWorkbook as TsWorkbook;
{ BIFF Record data: Row, Column, XF Index } { BIFF Record data: Row, Column, XF Index }
ReadRowColXF(AStream, ARow, ACol, XF); ReadRowColXF(AStream, ARow, ACol, XF);
@ -1644,10 +1651,10 @@ begin
InitCell(FWorksheet, ARow, ACol, FVirtualCell); // "virtual" cell InitCell(FWorksheet, ARow, ACol, FVirtualCell); // "virtual" cell
cell := @FVirtualCell; cell := @FVirtualCell;
end else end else
cell := FWorksheet.AddCell(ARow, ACol); // "real" cell cell := (FWorksheet as TsWorksheet).AddCell(ARow, ACol); // "real" cell
{ Save the data string} { Save the data string}
FWorksheet.WriteText(cell, UTF16ToUTF8(wideStrValue)); (FWorksheet as TsWorksheet).WriteText(cell, UTF16ToUTF8(wideStrValue));
{ Read rich-text formatting runs } { Read rich-text formatting runs }
L := WordLEToN(AStream.ReadWord); L := WordLEToN(AStream.ReadWord);
@ -1660,9 +1667,9 @@ begin
// necessarily the same as the index used by the workbook! // necessarily the same as the index used by the workbook!
fntIndex := WordLEToN(rtfRuns[j].FontIndex); fntIndex := WordLEToN(rtfRuns[j].FontIndex);
fnt := TsFont(FFontList[fntIndex]); fnt := TsFont(FFontList[fntIndex]);
fntIndex := FWorkbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position); fntIndex := book.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position);
if fntIndex = -1 then if fntIndex = -1 then
fntIndex := FWorkbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position); fntIndex := book.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position);
cell^.RichTextParams[j].FontIndex := fntIndex; cell^.RichTextParams[j].FontIndex := fntIndex;
// Index of the first character using this font: 0-based in file, 1-based in fps // Index of the first character using this font: 0-based in file, 1-based in fps
cell^.RichTextParams[j].FirstIndex := WordLEToN(rtfRuns[j].FirstIndex) + 1; cell^.RichTextParams[j].FirstIndex := WordLEToN(rtfRuns[j].FirstIndex) + 1;
@ -1674,7 +1681,7 @@ begin
ApplyCellFormatting(cell, XF); ApplyCellFormatting(cell, XF);
if FIsVirtualMode then if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell); book.OnReadCellData(book, ARow, ACol, cell);
end; end;
procedure TsSpreadBIFF8Reader.ReadSST(const AStream: TStream); procedure TsSpreadBIFF8Reader.ReadSST(const AStream: TStream);
@ -1773,7 +1780,10 @@ var
rtParams: TsRichTextParams; rtParams: TsRichTextParams;
fnt: TsFont; fnt: TsFont;
fntIndex: Integer; fntIndex: Integer;
book: TsWorkbook;
begin begin
book := FWorkbook as TsWorkbook;
rec.Row := 0; // to silence the compiler... rec.Row := 0; // to silence the compiler...
{ Read entire record, starting at Row } { Read entire record, starting at Row }
@ -1794,9 +1804,9 @@ begin
InitCell(FWorksheet, ARow, ACol, FVirtualCell); InitCell(FWorksheet, ARow, ACol, FVirtualCell);
cell := @FVirtualCell; cell := @FVirtualCell;
end else end else
cell := FWorksheet.AddCell(ARow, ACol); cell := (FWorksheet as TsWorksheet).AddCell(ARow, ACol);
FWorksheet.WriteText(cell, FSharedStringTable.Strings[SSTIndex]); (FWorksheet as TsWorksheet).WriteText(cell, FSharedStringTable.Strings[SSTIndex]);
{ Add attributes } { Add attributes }
ApplyCellFormatting(cell, XF); ApplyCellFormatting(cell, XF);
@ -1814,16 +1824,16 @@ begin
cell^.RichTextParams[i].FirstIndex := rtParams[i].FirstIndex; cell^.RichTextParams[i].FirstIndex := rtParams[i].FirstIndex;
fntIndex := rtParams[i].FontIndex; fntIndex := rtParams[i].FontIndex;
fnt := TsFont(FFontList[fntIndex]); fnt := TsFont(FFontList[fntIndex]);
fntIndex := FWorkbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position); fntIndex := book.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position);
if fntIndex = -1 then if fntIndex = -1 then
fntIndex := FWorkbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position); fntIndex := book.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position);
cell^.RichTextParams[i].FontIndex := fntIndex; cell^.RichTextParams[i].FontIndex := fntIndex;
cell^.RichTextParams[i].HyperlinkIndex := -1; cell^.RichTextParams[i].HyperlinkIndex := -1;
end; end;
end; end;
if FIsVirtualMode then if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell); book.OnReadCellData(book, ARow, ACol, cell);
end; end;
{ Helper function for reading a string with 8-bit length. } { Helper function for reading a string with 8-bit length. }
@ -1841,13 +1851,16 @@ end;
procedure TsSpreadBIFF8Reader.ReadStringRecord(AStream: TStream); procedure TsSpreadBIFF8Reader.ReadStringRecord(AStream: TStream);
var var
wideStr: WideString; wideStr: WideString;
book: TsWorkbook;
begin begin
book := FWorkbook as TsWorkbook;
wideStr := ReadWideString(AStream, false); wideStr := ReadWideString(AStream, false);
if (FIncompleteCell <> nil) and (wideStr <> '') then begin if (FIncompleteCell <> nil) and (wideStr <> '') then begin
FIncompleteCell^.UTF8StringValue := UTF8Encode(wideStr); FIncompleteCell^.UTF8StringValue := UTF8Encode(wideStr);
FIncompleteCell^.ContentType := cctUTF8String; FIncompleteCell^.ContentType := cctUTF8String;
if FIsVirtualMode then if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, FIncompleteCell^.Row, FIncompleteCell^.Col, FIncompleteCell); book.OnReadCellData(book, FIncompleteCell^.Row, FIncompleteCell^.Col, FIncompleteCell);
end; end;
FIncompleteCell := nil; FIncompleteCell := nil;
end; end;
@ -1875,7 +1888,10 @@ var
nfs: String; nfs: String;
nfParams: TsNumFormatParams; nfParams: TsNumFormatParams;
iclr: Integer; iclr: Integer;
book: TsWorkbook;
begin begin
book := FWorkbook as TsWorkbook;
InitFormatRecord(fmt); InitFormatRecord(fmt);
fmt.ID := FCellFormatList.Count; fmt.ID := FCellFormatList.Count;
@ -1894,8 +1910,8 @@ begin
// "General" (NumFormatIndex = 0) not stored in workbook's NumFormatList // "General" (NumFormatIndex = 0) not stored in workbook's NumFormatList
if (rec.NumFormatIndex > 0) and not SameText(nfs, 'General') then if (rec.NumFormatIndex > 0) and not SameText(nfs, 'General') then
begin begin
fmt.NumberFormatIndex := Workbook.AddNumberFormat(nfs); fmt.NumberFormatIndex := book.AddNumberFormat(nfs);
nfParams := Workbook.GetNumberFormat(fmt.NumberFormatIndex); nfParams := book.GetNumberFormat(fmt.NumberFormatIndex);
if nfParams <> nil then if nfParams <> nil then
begin begin
fmt.NumberFormat := nfParams.NumFormat; fmt.NumberFormat := nfParams.NumFormat;
@ -2265,7 +2281,7 @@ begin
if FFontList.Count = 4 then FFontList.Add(nil); if FFontList.Count = 4 then FFontList.Add(nil);
if isDefaultFont then if isDefaultFont then
Workbook.SetDefaultFont(font.FontName, font.Size); (Workbook as TsWorkbook).SetDefaultFont(font.FontName, font.Size);
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -2312,10 +2328,11 @@ begin
len := WordLEToN(AStream.ReadWord); len := WordLEToN(AStream.ReadWord);
s := ReadWideString(AStream, len, rtParams); s := ReadWideString(AStream, len, rtParams);
if AIsHeader then with (FWorksheet as TsWorksheet).Pagelayout do
FWorksheet.PageLayout.Headers[1] := UTF8Encode(s) if AIsHeader then
else Headers[1] := UTF8Encode(s)
FWOrksheet.PageLayout.Footers[1] := UTF8Encode(s); else
Footers[1] := UTF8Encode(s);
{ Options poDifferentFirst and poDifferentOddEvent are not used, BIFF supports { Options poDifferentFirst and poDifferentOddEvent are not used, BIFF supports
only common headers/footers } only common headers/footers }
@ -2461,7 +2478,7 @@ begin
// Add hyperlink(s) to worksheet // Add hyperlink(s) to worksheet
for row := row1 to row2 do for row := row1 to row2 do
for col := col1 to col2 do for col := col1 to col2 do
FWorksheet.WriteHyperlink(row, col, link); TsWorksheet(FWorksheet).WriteHyperlink(row, col, link);
end; end;
@ -2476,6 +2493,7 @@ var
row1, col1, row2, col2: Word; row1, col1, row2, col2: Word;
hyperlink: PsHyperlink; hyperlink: PsHyperlink;
numbytes: Integer; numbytes: Integer;
sheet: TsWorksheet;
begin begin
{ Record type; this matches the BIFF record type } { Record type; this matches the BIFF record type }
AStream.ReadWord; AStream.ReadWord;
@ -2494,7 +2512,8 @@ begin
txt := UTF8Encode(wideStr); txt := UTF8Encode(wideStr);
{ Add tooltip to hyperlinks } { Add tooltip to hyperlinks }
for hyperlink in FWorksheet.Hyperlinks.GetRangeEnumerator(row1, col1, row2, col2) do sheet := FWorksheet as TsWorksheet;
for hyperlink in sheet.Hyperlinks.GetRangeEnumerator(row1, col1, row2, col2) do
hyperlink^.ToolTip := txt; hyperlink^.ToolTip := txt;
end; end;
@ -2506,7 +2525,7 @@ end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Constructor of the Excel 8 writer Constructor of the Excel 8 writer
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
constructor TsSpreadBIFF8Writer.Create(AWorkbook: TsWorkbook); constructor TsSpreadBIFF8Writer.Create(AWorkbook: TsBasicWorkbook);
begin begin
inherited Create(AWorkbook); inherited Create(AWorkbook);
InitBiff8Limitations(FLimitations); InitBiff8Limitations(FLimitations);
@ -2576,6 +2595,7 @@ procedure TsSpreadBIFF8Writer.CollectExternData;
end; end;
var var
book: TsWorkbook;
sheet: TsWorksheet; sheet: TsWorksheet;
i: Integer; i: Integer;
writeIt: Boolean; writeIt: Boolean;
@ -2586,9 +2606,11 @@ begin
FBiff8ExternBooks := TsBIFF8ExternBookList.Create; FBiff8ExternBooks := TsBIFF8ExternBookList.Create;
FBiff8ExternSheets := TsBIFF8ExternSheetList.Create(FBiff8ExternBooks); FBiff8ExternSheets := TsBIFF8ExternSheetList.Create(FBiff8ExternBooks);
book := FWorkbook as TsWorkbook;
{ Add sheets used in print ranges, repeated cols or repeated rows } { Add sheets used in print ranges, repeated cols or repeated rows }
for i:=0 to FWorkbook.GetWorksheetCount-1 do begin for i:=0 to book.GetWorksheetCount-1 do begin
sheet := FWorkbook.GetWorksheetByIndex(i); sheet := book.GetWorksheetByIndex(i);
with sheet.PageLayout do with sheet.PageLayout do
writeIt := (NumPrintRanges > 0) or HasRepeatedCols or HasRepeatedRows; writeIt := (NumPrintRanges > 0) or HasRepeatedCols or HasRepeatedRows;
if writeIt then if writeIt then
@ -2596,9 +2618,9 @@ begin
end; end;
{ Add sheets related to 3d references of all sheets } { Add sheets related to 3d references of all sheets }
for i:=0 to FWorkbook.GetWorksheetCount-1 do for i:=0 to book.GetWorksheetCount-1 do
begin begin
sheet := FWorkbook.GetWorksheetByIndex(i); sheet := book.GetWorksheetByIndex(i);
DoCollectForSheet(sheet); DoCollectForSheet(sheet);
end; end;
@ -2632,7 +2654,7 @@ Begin
Bit 9: 0 = Print notes as displayed; 1 = Print notes at end of sheet Bit 9: 0 = Print notes as displayed; 1 = Print notes at end of sheet
Bit 11-10: 00 = Print errors as displayed; 1 = Do not print errors Bit 11-10: 00 = Print errors as displayed; 1 = Do not print errors
2 = Print errors as “--”; 3 = Print errors as “#N/A” } 2 = Print errors as “--”; 3 = Print errors as “#N/A” }
if poCommentsAtEnd in FWorksheet.PageLayout.Options then if poCommentsAtEnd in (FWorksheet as TsWorksheet).PageLayout.Options then
Result := Result or $0200; Result := Result or $0200;
end; end;
@ -2671,7 +2693,9 @@ var
sheetPos: array of Int64; sheetPos: array of Int64;
i: Integer; i: Integer;
pane: Byte; pane: Byte;
book: TsWorkbook;
begin begin
book := FWorkbook as TsWorkbook;
CollectExternData; CollectExternData;
{ Write workbook globals } { Write workbook globals }
@ -2679,7 +2703,7 @@ begin
WriteCodePage(AStream, 'ucs2le'); // = utf-16 WriteCodePage(AStream, 'ucs2le'); // = utf-16
WriteWindowProtect(AStream, bpLockWindows in Workbook.Protection); WriteWindowProtect(AStream, bpLockWindows in Workbook.Protection);
WritePROTECT(AStream, bpLockStructure in Workbook.Protection); WritePROTECT(AStream, bpLockStructure in Workbook.Protection);
WritePASSWORD(AStream, Workbook.CryptoInfo); WritePASSWORD(AStream, book.CryptoInfo);
WriteWINDOW1(AStream); WriteWINDOW1(AStream);
WriteFonts(AStream); WriteFonts(AStream);
WriteNumFormats(AStream); WriteNumFormats(AStream);
@ -2688,9 +2712,9 @@ begin
WriteStyle(AStream); WriteStyle(AStream);
// A BOUNDSHEET for each worksheet // A BOUNDSHEET for each worksheet
SetLength(sheetPos, Workbook.GetWorksheetCount); SetLength(sheetPos, book.GetWorksheetCount);
for i := 0 to Workbook.GetWorksheetCount - 1 do for i := 0 to book.GetWorksheetCount - 1 do
sheetPos[i] := WriteBoundsheet(AStream, Workbook.GetWorksheetByIndex(i)); sheetPos[i] := WriteBoundsheet(AStream, book.GetWorksheetByIndex(i));
WriteEXTERNBOOK(AStream, ''); WriteEXTERNBOOK(AStream, '');
WriteEXTERNSHEET(AStream); WriteEXTERNSHEET(AStream);
@ -2700,9 +2724,9 @@ begin
WriteEOF(AStream); WriteEOF(AStream);
{ Write each worksheet } { Write each worksheet }
for i := 0 to Workbook.GetWorksheetCount - 1 do for i := 0 to book.GetWorksheetCount - 1 do
begin begin
FWorksheet := Workbook.GetWorksheetByIndex(i); FWorksheet := book.GetWorksheetByIndex(i);
{ First goes back and writes the position of the BOF of the { First goes back and writes the position of the BOF of the
sheet on the respective BOUNDSHEET record } sheet on the respective BOUNDSHEET record }
@ -2734,7 +2758,7 @@ begin
WritePROTECT(AStream, true); WritePROTECT(AStream, true);
// WriteScenarioProtect(AStream); // WriteScenarioProtect(AStream);
WriteObjectProtect(AStream, FWorksheet); WriteObjectProtect(AStream, FWorksheet);
WritePASSWORD(AStream, FWorksheet.CryptoInfo); WritePASSWORD(AStream, (FWorksheet as TsWorksheet).CryptoInfo);
end; end;
WriteDefaultColWidth(AStream, FWorksheet); WriteDefaultColWidth(AStream, FWorksheet);
@ -2745,7 +2769,7 @@ begin
WriteVirtualCells(AStream, FWorksheet) WriteVirtualCells(AStream, FWorksheet)
else begin else begin
WriteRows(AStream, FWorksheet); WriteRows(AStream, FWorksheet);
WriteCellsToStream(AStream, FWorksheet.Cells); WriteCellsToStream(AStream, (FWorksheet as TsWorksheet).Cells);
WriteComments(AStream, FWorksheet); WriteComments(AStream, FWorksheet);
end; end;
@ -2770,7 +2794,7 @@ end;
BIFF8 begins with the 8 default colors which are duplicated. Then the user BIFF8 begins with the 8 default colors which are duplicated. Then the user
colors follow up to a max of total 64 entries. colors follow up to a max of total 64 entries.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.PopulatePalette(AWorkbook: TsWorkbook); procedure TsSpreadBIFF8Writer.PopulatePalette(AWorkbook: TsBasicWorkbook);
var var
i: Integer; i: Integer;
begin begin
@ -2791,18 +2815,19 @@ end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Collects all strings of the workbook in the SharedStringTable Collects all strings of the workbook in the SharedStringTable
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.PopulateSharedStringTable(AWorkbook: TsWorkbook); procedure TsSpreadBIFF8Writer.PopulateSharedStringTable(AWorkbook: TsBasicWorkbook);
var var
i, idx: Integer; i, idx: Integer;
cell: PCell; cell: PCell;
sheet: TsWorksheet; sheet: TsWorksheet;
book: TsWorkbook absolute AWorkbook;
begin begin
FNumStrings := 0; FNumStrings := 0;
FSharedStringTable := TStringList.Create; FSharedStringTable := TStringList.Create;
for i:=0 to AWorkbook.GetWorksheetCount-1 do for i:=0 to book.GetWorksheetCount-1 do
begin begin
sheet := AWorkbook.GetWorksheetByIndex(i); sheet := book.GetWorksheetByIndex(i);
for cell in sheet.Cells do begin for cell in sheet.Cells do begin
if (cell^.ContentType <> cctUTF8String) then if (cell^.ContentType <> cctUTF8String) then
Continue; Continue;
@ -2925,7 +2950,7 @@ end;
of the BOF of this sheet should be written (4 bytes size). of the BOF of this sheet should be written (4 bytes size).
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsSpreadBIFF8Writer.WriteBoundsheet(AStream: TStream; function TsSpreadBIFF8Writer.WriteBoundsheet(AStream: TStream;
AWorksheet: TsWorksheet): Int64; AWorksheet: TsBasicWorksheet): Int64;
var var
len: Byte; len: Byte;
wideSheetName: WideString; wideSheetName: WideString;
@ -2972,21 +2997,24 @@ end;
Writes all comments to the worksheet stream Writes all comments to the worksheet stream
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteComments(AStream: TStream; procedure TsSpreadBIFF8Writer.WriteComments(AStream: TStream;
AWorksheet: TsWorksheet); AWorksheet: TsBasicWorksheet);
var var
index: Integer; index: Integer;
comment: PsComment; comment: PsComment;
sheet: TsWorksheet;
begin begin
exit; // Remove after comments can be written correctly exit; // Remove after comments can be written correctly
{$warning TODO: Fix writing of cell comments in BIFF8 (file is readable by OpenOffice, but not by Excel)} {$warning TODO: Fix writing of cell comments in BIFF8 (file is readable by OpenOffice, but not by Excel)}
sheet := AWorksheet as TsWorksheet;
{ At first we have to write all Escher-related records for all comments; { At first we have to write all Escher-related records for all comments;
MSODRAWING - OBJ - MSODRAWING - TXO } MSODRAWING - OBJ - MSODRAWING - TXO }
index := 1; index := 1;
for comment in AWorksheet.Comments do for comment in sheet.Comments do
begin begin
if index = 1 then if index = 1 then
WriteMSODrawing1(AStream, FWorksheet.Comments.Count, comment) WriteMSODrawing1(AStream, sheet.Comments.Count, comment)
else else
WriteMSODrawing2(AStream, comment, index); WriteMSODrawing2(AStream, comment, index);
WriteOBJ(AStream, index); WriteOBJ(AStream, index);
@ -2997,7 +3025,7 @@ begin
{ The NOTE records for all comments follow subsequently. } { The NOTE records for all comments follow subsequently. }
index := 1; index := 1;
for comment in AWorksheet.Comments do for comment in sheet.Comments do
begin begin
WriteNOTE(AStream, comment, index); WriteNOTE(AStream, comment, index);
inc(index); inc(index);
@ -3009,8 +3037,8 @@ end;
Implements only the builtin defined names for print ranges and titles! Implements only the builtin defined names for print ranges and titles!
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteDefinedName(AStream: TStream; procedure TsSpreadBIFF8Writer.WriteDefinedName(AStream: TStream;
AWorksheet: TsWorksheet; const AName: String; AIndexToREF, ASheetIndex: Word; AWorksheet: TsBasicWorksheet; const AName: String;
AKind: TsBIFFExternKind); AIndexToREF, ASheetIndex: Word; AKind: TsBIFFExternKind);
procedure WriteRangeFormula(MemStream: TMemoryStream; ARange: TsCellRange; procedure WriteRangeFormula(MemStream: TMemoryStream; ARange: TsCellRange;
AIndexToRef, ACounter: Word); AIndexToRef, ACounter: Word);
@ -3042,6 +3070,8 @@ var
memstream: TMemoryStream; memstream: TMemoryStream;
rng: TsCellRange; rng: TsCellRange;
j: Integer; j: Integer;
idx: Integer;
sheet: TsWorksheet absolute AWorksheet;
begin begin
// Since this is a variable length record we begin by writing the formula // Since this is a variable length record we begin by writing the formula
@ -3050,28 +3080,28 @@ begin
try try
case AName of case AName of
#06: begin // Print range #06: begin // Print range
for j := 0 to AWorksheet.PageLayout.NumPrintRanges-1 do for j := 0 to sheet.PageLayout.NumPrintRanges-1 do
begin begin
rng := AWorksheet.PageLayout.PrintRange[j]; rng := sheet.PageLayout.PrintRange[j];
WriteRangeFormula(memstream, rng, AIndexToRef, j+1); WriteRangeFormula(memstream, rng, AIndexToRef, j+1);
end; end;
end; end;
#07: begin // Print titles #07: begin // Print titles
j := 1; j := 1;
if AWorksheet.PageLayout.HasRepeatedCols then if sheet.PageLayout.HasRepeatedCols then
begin begin
rng.Col1 := AWorksheet.PageLayout.RepeatedCols.FirstIndex; rng.Col1 := sheet.PageLayout.RepeatedCols.FirstIndex;
rng.Col2 := AWorksheet.PageLayout.RepeatedCols.LastIndex; rng.Col2 := sheet.PageLayout.RepeatedCols.LastIndex;
if rng.Col2 = UNASSIGNED_ROW_COL_INDEX then rng.Col2 := rng.Col1; if rng.Col2 = UNASSIGNED_ROW_COL_INDEX then rng.Col2 := rng.Col1;
rng.Row1 := 0; rng.Row1 := 0;
rng.Row2 := 65535; rng.Row2 := 65535;
WriteRangeFormula(memstream, rng, AIndexToRef, j); WriteRangeFormula(memstream, rng, AIndexToRef, j);
inc(j); inc(j);
end; end;
if AWorksheet.PageLayout.HasRepeatedRows then if sheet.PageLayout.HasRepeatedRows then
begin begin
rng.Row1 := AWorksheet.PageLayout.RepeatedRows.FirstIndex; rng.Row1 := sheet.PageLayout.RepeatedRows.FirstIndex;
rng.Row2 := AWorksheet.PageLayout.RepeatedRows.LastIndex; rng.Row2 := sheet.PageLayout.RepeatedRows.LastIndex;
if rng.Row2 = UNASSIGNED_ROW_COL_INDEX then rng.Row2 := rng.Row1; if rng.Row2 = UNASSIGNED_ROW_COL_INDEX then rng.Row2 := rng.Row1;
rng.Col1 := 0; rng.Col1 := 0;
rng.Col2 := 255; rng.Col2 := 255;
@ -3102,7 +3132,8 @@ begin
AStream.WriteWord(0); AStream.WriteWord(0);
{ Index to sheet (1-based) } { Index to sheet (1-based) }
AStream.WriteWord(WordToLE(FWorkbook.GetWorksheetIndex(AWorksheet)+1)); idx := (FWorkbook as TsWorkbook).GetWorksheetIndex(AWorksheet);
AStream.WriteWord(WordToLE(idx+1));
{ Length of menu text } { Length of menu text }
AStream.WriteByte(0); AStream.WriteByte(0);
@ -3134,18 +3165,21 @@ end;
procedure TsSpreadBIFF8Writer.WriteDefinedNames(AStream: TStream); procedure TsSpreadBIFF8Writer.WriteDefinedNames(AStream: TStream);
var var
bookIdx: Integer; bookIdx: Integer;
book: TsWorkbook;
sheet: TsWorksheet; sheet: TsWorksheet;
i: Integer; i: Integer;
begin begin
if (FBiff8ExternBooks = nil) or (FBiff8ExternSheets = nil) then if (FBiff8ExternBooks = nil) or (FBiff8ExternSheets = nil) then
exit; exit;
book := FWorkbook as TsWorkbook;
// Defined names in "internal" book only // Defined names in "internal" book only
bookIdx := FBiff8ExternBooks.IndexOfInternalbook; bookIdx := FBiff8ExternBooks.IndexOfInternalbook;
for i:=0 to FWorkbook.GetWorksheetCount-1 do for i:=0 to book.GetWorksheetCount-1 do
begin begin
sheet := FWorkbook.GetWorksheetByIndex(i); sheet := book.GetWorksheetByIndex(i);
if (sheet.PageLayout.NumPrintRanges > 0) or if (sheet.PageLayout.NumPrintRanges > 0) or
sheet.PageLayout.HasRepeatedCols or sheet.PageLayout.HasRepeatedRows then sheet.PageLayout.HasRepeatedCols or sheet.PageLayout.HasRepeatedRows then
begin begin
@ -3170,7 +3204,7 @@ end;
See bug 18886: excel5 files are truncated when imported See bug 18886: excel5 files are truncated when imported
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteDimensions(AStream: TStream; procedure TsSpreadBIFF8Writer.WriteDimensions(AStream: TStream;
AWorksheet: TsWorksheet); AWorksheet: TsBasicWorksheet);
var var
firstRow, lastRow, firstCol, lastCol: Cardinal; firstRow, lastRow, firstCol, lastCol: Cardinal;
rec: TBIFF8_DimensionsRecord; rec: TBIFF8_DimensionsRecord;
@ -3219,7 +3253,7 @@ begin
{ Current workbook -- assuming that it has index 0 in list FExternBook8 } { Current workbook -- assuming that it has index 0 in list FExternBook8 }
if AUrl = '' then begin if AUrl = '' then begin
{ Number of sheets in this workbook } { Number of sheets in this workbook }
AStream.WriteWord(WordToLE(FWorkbook.GetWorksheetCount)); AStream.WriteWord(WordToLE((FWorkbook as TsWorkbook).GetWorksheetCount));
{ Relict from BIFF5 } { Relict from BIFF5 }
AStream.WriteWord(WordToLE($0401)); AStream.WriteWord(WordToLE($0401));
@ -3344,9 +3378,11 @@ end;
procedure TsSpreadBiff8Writer.WriteFonts(AStream: TStream); procedure TsSpreadBiff8Writer.WriteFonts(AStream: TStream);
var var
i: Integer; i: Integer;
book: TsWorkbook;
begin begin
for i:=0 to Workbook.GetFontCount-1 do book := FWorkbook as TsWorkbook;
WriteFONT(AStream, Workbook.GetFont(i)); for i:=0 to book.GetFontCount-1 do
WriteFONT(AStream, book.GetFont(i));
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -3407,7 +3443,7 @@ var
len: Integer; len: Integer;
id: Word; id: Word;
begin begin
with FWorksheet.PageLayout do with (FWorksheet as TsWorksheet).PageLayout do
if AIsHeader then if AIsHeader then
begin begin
if (Headers[HEADER_FOOTER_INDEX_ALL] = '') then if (Headers[HEADER_FOOTER_INDEX_ALL] = '') then
@ -3440,7 +3476,7 @@ end;
Writes an Excel 8 HYPERLINK record Writes an Excel 8 HYPERLINK record
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteHyperlink(AStream: TStream; procedure TsSpreadBIFF8Writer.WriteHyperlink(AStream: TStream;
AHyperlink: PsHyperlink; AWorksheet: TsWorksheet); AHyperlink: PsHyperlink; AWorksheet: TsBasicWorksheet);
var var
temp: TStream; temp: TStream;
guid: TGUID; guid: TGUID;
@ -3456,11 +3492,11 @@ var
isInternal: Boolean; isInternal: Boolean;
dirUpCounter: Integer; dirUpCounter: Integer;
begin begin
cell := AWorksheet.FindCell(AHyperlink^.Row, AHyperlink^.Col); cell := (AWorksheet as TsWorksheet).FindCell(AHyperlink^.Row, AHyperlink^.Col);
if (cell = nil) or (AHyperlink^.Target='') then if (cell = nil) or (AHyperlink^.Target='') then
exit; exit;
descr := AWorksheet.ReadAsText(cell); // Hyperlink description descr := (AWorksheet as TsWorksheet).ReadAsText(cell); // Hyperlink description
SplitHyperlink(AHyperlink^.Target, target, bookmark); SplitHyperlink(AHyperlink^.Target, target, bookmark);
u := ParseURI(AHyperlink^.Target); u := ParseURI(AHyperlink^.Target);
isInternal := (target = '') and (bookmark <> ''); isInternal := (target = '') and (bookmark <> '');
@ -3597,11 +3633,11 @@ end;
Writes all hyperlinks Writes all hyperlinks
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteHyperlinks(AStream: TStream; procedure TsSpreadBIFF8Writer.WriteHyperlinks(AStream: TStream;
AWorksheet: TsWorksheet); AWorksheet: TsBasicWorksheet);
var var
hyperlink: PsHyperlink; hyperlink: PsHyperlink;
begin begin
for hyperlink in AWorksheet.Hyperlinks do begin for hyperlink in (AWorksheet as TsWorksheet).Hyperlinks do begin
{ Write HYPERLINK record } { Write HYPERLINK record }
WriteHyperlink(AStream, hyperlink, AWorksheet); WriteHyperlink(AStream, hyperlink, AWorksheet);
{ Write HYPERLINK TOOLTIP record } { Write HYPERLINK TOOLTIP record }
@ -3787,18 +3823,19 @@ begin
end; end;
procedure TsSpreadBIFF8Writer.WriteMergedCells(AStream: TStream; procedure TsSpreadBIFF8Writer.WriteMergedCells(AStream: TStream;
AWorksheet: TsWorksheet); AWorksheet: TsBasicWorksheet);
const const
MAX_PER_RECORD = 1026; MAX_PER_RECORD = 1026;
var var
n0, n: Integer; n0, n: Integer;
rng: PsCellRange; rng: PsCellRange;
newRecord: Boolean; newRecord: Boolean;
sheet: TsWorksheet absolute AWorksheet;
begin begin
n0 := AWorksheet.MergedCells.Count; n0 := sheet.MergedCells.Count;
n := Min(n0, MAX_PER_RECORD); n := Min(n0, MAX_PER_RECORD);
newRecord := true; newRecord := true;
for rng in AWorksheet.MergedCells do for rng in sheet.MergedCells do
begin begin
if newRecord then if newRecord then
begin begin
@ -4781,11 +4818,15 @@ end;
sheets. sheets.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteWINDOW2(AStream: TStream; procedure TsSpreadBIFF8Writer.WriteWINDOW2(AStream: TStream;
ASheet: TsWorksheet); ASheet: TsBasicWorksheet);
var var
Options: Word; Options: Word;
actSheet: TsWorksheet; book: TsWorkbook;
sheet, actSheet: TsWorksheet;
begin begin
book := FWorkbook as TsWorkbook;
sheet := ASheet as TsWorksheet;
{ BIFF Record header } { BIFF Record header }
WriteBiffHeader(AStream, INT_EXCEL_ID_WINDOW2, 18); WriteBiffHeader(AStream, INT_EXCEL_ID_WINDOW2, 18);
@ -4800,18 +4841,18 @@ begin
{ Bug 0026386 -> every sheet must be selected/active, otherwise Excel cannot print { Bug 0026386 -> every sheet must be selected/active, otherwise Excel cannot print
---> wp: after changes for issue 0028452: this is not necessary any more. } ---> wp: after changes for issue 0028452: this is not necessary any more. }
if (soShowGridLines in ASheet.Options) then if (soShowGridLines in sheet.Options) then
Options := Options or MASK_WINDOW2_OPTION_SHOW_GRID_LINES; Options := Options or MASK_WINDOW2_OPTION_SHOW_GRID_LINES;
if (soShowHeaders in ASheet.Options) then if (soShowHeaders in sheet.Options) then
Options := Options or MASK_WINDOW2_OPTION_SHOW_SHEET_HEADERS; Options := Options or MASK_WINDOW2_OPTION_SHOW_SHEET_HEADERS;
if (soHasFrozenPanes in ASheet.Options) and ((ASheet.LeftPaneWidth > 0) or (ASheet.TopPaneHeight > 0)) then if (soHasFrozenPanes in sheet.Options) and ((sheet.LeftPaneWidth > 0) or (sheet.TopPaneHeight > 0)) then
Options := Options or MASK_WINDOW2_OPTION_PANES_ARE_FROZEN; Options := Options or MASK_WINDOW2_OPTION_PANES_ARE_FROZEN;
if FWorkbook.ActiveWorksheet <> nil then if book.ActiveWorksheet <> nil then
actSheet := FWorkbook.ActiveWorksheet else actSheet := book.ActiveWorksheet else
actSheet := Fworkbook.GetWorksheetByIndex(0); actSheet := book.GetWorksheetByIndex(0);
if (ASheet = actSheet) then if (sheet = actSheet) then
Options := Options or MASK_WINDOW2_OPTION_SHEET_ACTIVE or MASK_WINDOW2_OPTION_SHEET_SELECTED; Options := Options or MASK_WINDOW2_OPTION_SHEET_ACTIVE or MASK_WINDOW2_OPTION_SHEET_SELECTED;
if (ASheet.BiDiMode = bdRTL) then if (sheet.BiDiMode = bdRTL) then
Options := Options or MASK_WINDOW2_OPTION_COLUMNS_RIGHT_TO_LEFT; Options := Options or MASK_WINDOW2_OPTION_COLUMNS_RIGHT_TO_LEFT;
AStream.WriteWord(WordToLE(Options)); AStream.WriteWord(WordToLE(Options));
@ -4870,7 +4911,7 @@ begin
j := 0; j := 0;
if (AFormatRecord <> nil) and (uffNumberFormat in AFormatRecord^.UsedFormattingFields) if (AFormatRecord <> nil) and (uffNumberFormat in AFormatRecord^.UsedFormattingFields)
then begin then begin
nfParams := Workbook.GetNumberFormat(AFormatRecord^.NumberFormatIndex); nfParams := (Workbook as TsWorkbook).GetNumberFormat(AFormatRecord^.NumberFormatIndex);
if nfParams <> nil then if nfParams <> nil then
begin begin
nfs := nfParams.NumFormatStr; nfs := nfParams.NumFormatStr;

605
components/fpspreadsheet/source/common/xlscommon.pas
View File

File diff suppressed because it is too large Load Diff

164
components/fpspreadsheet/source/common/xlsxml.pas
View File

@ -23,7 +23,7 @@ interface
uses uses
Classes, SysUtils, Classes, SysUtils,
laz2_xmlread, laz2_DOM, laz2_xmlread, laz2_DOM,
fpsTypes, fpspreadsheet, fpsReaderWriter, xlsCommon; fpsTypes, fpsReaderWriter, xlsCommon;
type type
@ -35,21 +35,21 @@ type
FPointSeparatorSettings: TFormatSettings; FPointSeparatorSettings: TFormatSettings;
function GetCommentStr(ACell: PCell): String; function GetCommentStr(ACell: PCell): String;
function GetFormulaStr(ACell: PCell): String; function GetFormulaStr(ACell: PCell): String;
function GetFrozenPanesStr(AWorksheet: TsWorksheet; AIndent: String): String; function GetFrozenPanesStr(AWorksheet: TsBasicWorksheet; AIndent: String): String;
function GetHyperlinkStr(ACell: PCell): String; function GetHyperlinkStr(ACell: PCell): String;
function GetIndexStr(AIndex: Integer): String; function GetIndexStr(AIndex: Integer): String;
function GetLayoutStr(AWorksheet: TsWorksheet): String; function GetLayoutStr(AWorksheet: TsBasicWorksheet): String;
function GetMergeStr(ACell: PCell): String; function GetMergeStr(ACell: PCell): String;
function GetPageFooterStr(AWorksheet: TsWorksheet): String; function GetPageFooterStr(AWorksheet: TsBasicWorksheet): String;
function GetPageHeaderStr(AWorksheet: TsWorksheet): String; function GetPageHeaderStr(AWorksheet: TsBasicWorksheet): String;
function GetPageMarginStr(AWorksheet: TsWorksheet): String; function GetPageMarginStr(AWorksheet: TsBasicWorksheet): String;
function GetStyleStr(AFormatIndex: Integer): String; function GetStyleStr(AFormatIndex: Integer): String;
procedure WriteExcelWorkbook(AStream: TStream); procedure WriteExcelWorkbook(AStream: TStream);
procedure WriteStyle(AStream: TStream; AIndex: Integer); procedure WriteStyle(AStream: TStream; AIndex: Integer);
procedure WriteStyles(AStream: TStream); procedure WriteStyles(AStream: TStream);
procedure WriteTable(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteTable(AStream: TStream; AWorksheet: TsBasicWorksheet);
procedure WriteWorksheet(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteWorksheet(AStream: TStream; AWorksheet: TsBasicWorksheet);
procedure WriteWorksheetOptions(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteWorksheetOptions(AStream: TStream; AWorksheet: TsBasicWorksheet);
procedure WriteWorksheets(AStream: TStream); procedure WriteWorksheets(AStream: TStream);
protected protected
@ -68,7 +68,7 @@ type
const AValue: double; ACell: PCell); override; const AValue: double; ACell: PCell); override;
public public
constructor Create(AWorkbook: TsWorkbook); override; constructor Create(AWorkbook: TsBasicWorkbook); override;
procedure WriteToStream(AStream: TStream; AParams: TsStreamParams = []); override; procedure WriteToStream(AStream: TStream; AParams: TsStreamParams = []); override;
end; end;
@ -90,7 +90,7 @@ implementation
uses uses
StrUtils, Math, StrUtils, Math,
fpsStrings, fpsUtils, fpsNumFormat, fpsXmlCommon, fpsHTMLUtils; fpsStrings, fpspreadsheet, fpsUtils, fpsNumFormat, fpsXmlCommon, fpsHTMLUtils;
const const
FMT_OFFSET = 61; FMT_OFFSET = 61;
@ -164,7 +164,7 @@ end;
Defines the date mode and the limitations of the file format. Defines the date mode and the limitations of the file format.
Initializes the format settings to be used when writing to xml. Initializes the format settings to be used when writing to xml.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
constructor TsSpreadExcelXMLWriter.Create(AWorkbook: TsWorkbook); constructor TsSpreadExcelXMLWriter.Create(AWorkbook: TsBasicWorkbook);
begin begin
inherited Create(AWorkbook); inherited Create(AWorkbook);
@ -186,7 +186,7 @@ var
comment: PsComment; comment: PsComment;
begin begin
Result := ''; Result := '';
comment := FWorksheet.FindComment(ACell); comment := (FWorksheet as TsWorksheet).FindComment(ACell);
if Assigned(comment) then if Assigned(comment) then
Result := INDENT1 + '<Comment><Data>' + comment^.Text + '</Data></Comment>' + LF + CELL_INDENT; Result := INDENT1 + '<Comment><Data>' + comment^.Text + '</Data></Comment>' + LF + CELL_INDENT;
// If there will be some rich-text-like formatting in the future, use // If there will be some rich-text-like formatting in the future, use
@ -197,40 +197,41 @@ function TsSpreadExcelXMLWriter.GetFormulaStr(ACell: PCell): String;
begin begin
if HasFormula(ACell) then if HasFormula(ACell) then
begin begin
Result := UTF8TextToXMLText(FWorksheet.ConvertFormulaDialect(ACell, fdExcelR1C1)); Result := UTF8TextToXMLText((FWorksheet as TsWorksheet).ConvertFormulaDialect(ACell, fdExcelR1C1));
Result := ' ss:Formula="=' + Result + '"'; Result := ' ss:Formula="=' + Result + '"';
end else end else
Result := ''; Result := '';
end; end;
function TsSpreadExcelXMLWriter.GetFrozenPanesStr(AWorksheet: TsWorksheet; function TsSpreadExcelXMLWriter.GetFrozenPanesStr(AWorksheet: TsBasicWorksheet;
AIndent: String): String; AIndent: String): String;
var var
activePane: Integer; activePane: Integer;
sheet: TsWorksheet absolute AWorksheet;
begin begin
if (soHasFrozenPanes in AWorksheet.Options) then if (soHasFrozenPanes in sheet.Options) then
begin begin
Result := AIndent + Result := AIndent +
'<FreezePanes/>' + LF + AIndent + '<FreezePanes/>' + LF + AIndent +
'<FrozenNoSplit/>' + LF; '<FrozenNoSplit/>' + LF;
if FWorksheet.LeftPaneWidth > 0 then if sheet.LeftPaneWidth > 0 then
Result := Result + AIndent + Result := Result + AIndent +
'<SplitVertical>1</SplitVertical>' + LF + AIndent + '<SplitVertical>1</SplitVertical>' + LF + AIndent +
'<LeftColumnRightPane>' + IntToStr(FWorksheet.LeftPaneWidth) + '</LeftColumnRightPane>' + LF; '<LeftColumnRightPane>' + IntToStr(sheet.LeftPaneWidth) + '</LeftColumnRightPane>' + LF;
if FWorksheet.TopPaneHeight > 0 then if sheet.TopPaneHeight > 0 then
Result := Result + AIndent + Result := Result + AIndent +
'<SplitHorizontal>1</SplitHorizontal>' + LF + AIndent + '<SplitHorizontal>1</SplitHorizontal>' + LF + AIndent +
'<TopRowBottomPane>' + IntToStr(FWorksheet.TopPaneHeight) + '</TopRowBottomPane>' + LF; '<TopRowBottomPane>' + IntToStr(sheet.TopPaneHeight) + '</TopRowBottomPane>' + LF;
if (FWorksheet.LeftPaneWidth = 0) and (FWorkSheet.TopPaneHeight = 0) then if (sheet.LeftPaneWidth = 0) and (sheet.TopPaneHeight = 0) then
activePane := 3 activePane := 3
else else
if (FWorksheet.LeftPaneWidth = 0) then if (sheet.LeftPaneWidth = 0) then
activePane := 2 activePane := 2
else else
if (FWorksheet.TopPaneHeight = 0) then if (sheet.TopPaneHeight = 0) then
activePane := 1 activePane := 1
else else
activePane := 0; activePane := 0;
@ -245,7 +246,7 @@ var
hyperlink: PsHyperlink; hyperlink: PsHyperlink;
begin begin
Result := ''; Result := '';
hyperlink := FWorksheet.FindHyperlink(ACell); hyperlink := (FWorksheet as TsWorksheet).FindHyperlink(ACell);
if Assigned(hyperlink) then if Assigned(hyperlink) then
Result := ' ss:HRef="' + hyperlink^.Target + '"'; Result := ' ss:HRef="' + hyperlink^.Target + '"';
end; end;
@ -255,17 +256,19 @@ begin
Result := Format(' ss:Index="%d"', [AIndex]); Result := Format(' ss:Index="%d"', [AIndex]);
end; end;
function TsSpreadExcelXMLWriter.GetLayoutStr(AWorksheet: TsWorksheet): String; function TsSpreadExcelXMLWriter.GetLayoutStr(AWorksheet: TsBasicWorksheet): String;
var
sheet: TsWorksheet absolute AWorksheet;
begin begin
Result := ''; Result := '';
if AWorksheet.PageLayout.Orientation = spoLandscape then if sheet.PageLayout.Orientation = spoLandscape then
Result := Result + ' x:Orientation="Landscape"'; Result := Result + ' x:Orientation="Landscape"';
if (poHorCentered in AWorksheet.PageLayout.Options) then if (poHorCentered in sheet.PageLayout.Options) then
Result := Result + ' x:CenterHorizontal="1"'; Result := Result + ' x:CenterHorizontal="1"';
if (poVertCentered in AWorksheet.PageLayout.Options) then if (poVertCentered in sheet.PageLayout.Options) then
Result := Result + ' x:CenterVertical="1"'; Result := Result + ' x:CenterVertical="1"';
if (poUseStartPageNumber in AWorksheet.PageLayout.Options) then if (poUseStartPageNumber in sheet.PageLayout.Options) then
Result := Result + ' x:StartPageNumber="' + IntToStr(AWorksheet.PageLayout.StartPageNumber) + '"'; Result := Result + ' x:StartPageNumber="' + IntToStr(sheet.PageLayout.StartPageNumber) + '"';
Result := '<Layout' + Result + '/>'; Result := '<Layout' + Result + '/>';
end; end;
@ -274,8 +277,8 @@ var
r1, c1, r2, c2: Cardinal; r1, c1, r2, c2: Cardinal;
begin begin
Result := ''; Result := '';
if FWorksheet.IsMerged(ACell) then begin if (FWorksheet as TsWorksheet).IsMerged(ACell) then begin
FWorksheet.FindMergedRange(ACell, r1, c1, r2, c2); (FWorksheet as TsWorksheet).FindMergedRange(ACell, r1, c1, r2, c2);
if c2 > c1 then if c2 > c1 then
Result := Result + Format(' ss:MergeAcross="%d"', [c2-c1]); Result := Result + Format(' ss:MergeAcross="%d"', [c2-c1]);
if r2 > r1 then if r2 > r1 then
@ -283,29 +286,38 @@ begin
end; end;
end; end;
function TsSpreadExcelXMLWriter.GetPageFooterStr(AWorksheet: TsWorksheet): String; function TsSpreadExcelXMLWriter.GetPageFooterStr(
AWorksheet: TsBasicWorksheet): String;
var
sheet: TsWorksheet absolute AWorksheet;
begin begin
Result := Format('x:Margin="%g"', [mmToIn(AWorksheet.PageLayout.FooterMargin)], FPointSeparatorSettings); Result := Format('x:Margin="%g"', [mmToIn(sheet.PageLayout.FooterMargin)], FPointSeparatorSettings);
if (AWorksheet.PageLayout.Footers[HEADER_FOOTER_INDEX_ALL] <> '') then if (sheet.PageLayout.Footers[HEADER_FOOTER_INDEX_ALL] <> '') then
Result := Result + ' x:Data="' + UTF8TextToXMLText(AWorksheet.PageLayout.Footers[HEADER_FOOTER_INDEX_ALL], true) + '"'; Result := Result + ' x:Data="' + UTF8TextToXMLText(sheet.PageLayout.Footers[HEADER_FOOTER_INDEX_ALL], true) + '"';
Result := '<Footer ' + result + '/>'; Result := '<Footer ' + result + '/>';
end; end;
function TsSpreadExcelXMLWriter.GetPageHeaderStr(AWorksheet: TsWorksheet): String; function TsSpreadExcelXMLWriter.GetPageHeaderStr(
AWorksheet: TsBasicWorksheet): String;
var
sheet: TsWorksheet absolute AWorksheet;
begin begin
Result := Format('x:Margin="%g"', [mmToIn(AWorksheet.PageLayout.HeaderMargin)], FPointSeparatorSettings); Result := Format('x:Margin="%g"', [mmToIn(sheet.PageLayout.HeaderMargin)], FPointSeparatorSettings);
if (AWorksheet.PageLayout.Headers[HEADER_FOOTER_INDEX_ALL] <> '') then if (sheet.PageLayout.Headers[HEADER_FOOTER_INDEX_ALL] <> '') then
Result := Result + ' x:Data="' + UTF8TextToXMLText(AWorksheet.PageLayout.Headers[HEADER_FOOTER_INDEX_ALL], true) + '"'; Result := Result + ' x:Data="' + UTF8TextToXMLText(sheet.PageLayout.Headers[HEADER_FOOTER_INDEX_ALL], true) + '"';
Result := '<Header ' + Result + '/>'; Result := '<Header ' + Result + '/>';
end; end;
function TsSpreadExcelXMLWriter.GetPageMarginStr(AWorksheet: TsWorksheet): String; function TsSpreadExcelXMLWriter.GetPageMarginStr(
AWorksheet: TsBasicWorksheet): String;
var
sheet: TsWorksheet absolute AWorksheet;
begin begin
Result := Format('x:Bottom="%g" x:Left="%g" x:Right="%g" x:Top="%g"', [ Result := Format('x:Bottom="%g" x:Left="%g" x:Right="%g" x:Top="%g"', [
mmToIn(AWorksheet.PageLayout.BottomMargin), mmToIn(sheet.PageLayout.BottomMargin),
mmToIn(AWorksheet.PageLayout.LeftMargin), mmToIn(sheet.PageLayout.LeftMargin),
mmToIn(AWorksheet.PageLayout.RightMargin), mmToIn(sheet.PageLayout.RightMargin),
mmToIn(AWorksheet.PageLayout.TopMargin) mmToIn(sheet.PageLayout.TopMargin)
], FPointSeparatorSettings); ], FPointSeparatorSettings);
Result := '<PageMargins ' + Result + '/>'; Result := '<PageMargins ' + Result + '/>';
end; end;
@ -366,7 +378,7 @@ begin
WriteLabel(AStream, ACell^.Row, ACell^.Col, ACell^.UTF8StringValue, ACell); WriteLabel(AStream, ACell^.Row, ACell^.Col, ACell^.UTF8StringValue, ACell);
end; end;
if FWorksheet.ReadComment(ACell) <> '' then if (FWorksheet as TsWorksheet).ReadComment(ACell) <> '' then
WriteComment(AStream, ACell); WriteComment(AStream, ACell);
end; end;
@ -380,11 +392,11 @@ var
begin begin
Unused(ARow, ACol); Unused(ARow, ACol);
ExcelDate := AValue; ExcelDate := AValue;
fmt := FWorkbook.GetPointerToCellFormat(ACell^.FormatIndex); fmt := (FWorkbook as TsWorkbook).GetPointerToCellFormat(ACell^.FormatIndex);
// Times have an offset of 1 day! // Times have an offset of 1 day!
if (fmt <> nil) and (uffNumberFormat in fmt^.UsedFormattingFields) then if (fmt <> nil) and (uffNumberFormat in fmt^.UsedFormattingFields) then
begin begin
nfp := FWorkbook.GetNumberFormat(fmt^.NumberFormatIndex); nfp := (FWorkbook as TsWorkbook).GetNumberFormat(fmt^.NumberFormatIndex);
if IsTimeIntervalFormat(nfp) or IsTimeFormat(nfp) then if IsTimeIntervalFormat(nfp) or IsTimeFormat(nfp) then
case FDateMode of case FDateMode of
dm1900: ExcelDate := AValue + DATEMODE_1900_BASE; dm1900: ExcelDate := AValue + DATEMODE_1900_BASE;
@ -461,8 +473,8 @@ begin
if Length(ACell^.RichTextParams) > 0 then if Length(ACell^.RichTextParams) > 0 then
begin begin
RichTextToHTML( RichTextToHTML(
FWorkbook, FWorkbook as TsWorkbook,
FWorksheet.ReadCellFont(ACell), (FWorksheet as TsWorksheet).ReadCellFont(ACell),
AValue, AValue,
ACell^.RichTextParams, ACell^.RichTextParams,
valueStr, // html-formatted rich text valueStr, // html-formatted rich text
@ -531,8 +543,10 @@ var
fill: TsFillPattern; fill: TsFillPattern;
cb: TsCellBorder; cb: TsCellBorder;
cbs: TsCellBorderStyle; cbs: TsCellBorderStyle;
book: TsWorkbook;
begin begin
deffnt := FWorkbook.GetDefaultFont; book := FWorkbook as TsWorkbook;
deffnt := book.GetDefaultFont;
if AIndex = 0 then if AIndex = 0 then
begin begin
AppendToStream(AStream, Format(INDENT2 + AppendToStream(AStream, Format(INDENT2 +
@ -551,7 +565,7 @@ begin
AppendToStream(AStream, Format(INDENT2 + AppendToStream(AStream, Format(INDENT2 +
'<Style ss:ID="s%d">' + LF, [AIndex + FMT_OFFSET])); '<Style ss:ID="s%d">' + LF, [AIndex + FMT_OFFSET]));
fmt := FWorkbook.GetPointerToCellFormat(AIndex); fmt := book.GetPointerToCellFormat(AIndex);
// Horizontal alignment // Horizontal alignment
fmtHor := ''; fmtHor := '';
@ -600,7 +614,7 @@ begin
// Font // Font
if (uffFont in fmt^.UsedFormattingFields) then if (uffFont in fmt^.UsedFormattingFields) then
begin begin
fnt := FWorkbook.GetFont(fmt^.FontIndex); fnt := book.GetFont(fmt^.FontIndex);
s := ''; s := '';
if fnt.FontName <> deffnt.FontName then if fnt.FontName <> deffnt.FontName then
s := s + Format('ss:FontName="%s" ', [fnt.FontName]); s := s + Format('ss:FontName="%s" ', [fnt.FontName]);
@ -624,7 +638,7 @@ begin
// Number Format // Number Format
if (uffNumberFormat in fmt^.UsedFormattingFields) then if (uffNumberFormat in fmt^.UsedFormattingFields) then
begin begin
nfp := FWorkbook.GetNumberFormat(fmt^.NumberFormatIndex); nfp := book.GetNumberFormat(fmt^.NumberFormatIndex);
AppendToStream(AStream, Format(INDENT3 + AppendToStream(AStream, Format(INDENT3 +
'<NumberFormat ss:Format="%s"/>' + LF, [UTF8TextToXMLText(nfp.NumFormatStr)])); '<NumberFormat ss:Format="%s"/>' + LF, [UTF8TextToXMLText(nfp.NumFormatStr)]));
end; end;
@ -685,12 +699,14 @@ var
begin begin
AppendToStream(AStream, INDENT1 + AppendToStream(AStream, INDENT1 +
'<Styles>' + LF); '<Styles>' + LF);
for i:=0 to FWorkbook.GetNumCellFormats-1 do WriteStyle(AStream, i); for i:=0 to (FWorkbook as TsWorkbook).GetNumCellFormats-1 do
WriteStyle(AStream, i);
AppendToStream(AStream, INDENT1 + AppendToStream(AStream, INDENT1 +
'</Styles>' + LF); '</Styles>' + LF);
end; end;
procedure TsSpreadExcelXMLWriter.WriteTable(AStream: TStream; AWorksheet: TsWorksheet); procedure TsSpreadExcelXMLWriter.WriteTable(AStream: TStream;
AWorksheet: TsBasicWorksheet);
var var
c, c1, c2: Cardinal; c, c1, c2: Cardinal;
r, r1, r2: Cardinal; r, r1, r2: Cardinal;
@ -700,27 +716,28 @@ var
styleStr: String; styleStr: String;
col: PCol; col: PCol;
row: PRow; row: PRow;
sheet: TsWorksheet absolute AWorksheet;
begin begin
r1 := 0; r1 := 0;
c1 := 0; c1 := 0;
r2 := AWorksheet.GetLastRowIndex; r2 := sheet.GetLastRowIndex;
c2 := AWorksheet.GetLastColIndex; c2 := sheet.GetLastColIndex;
AppendToStream(AStream, TABLE_INDENT + Format( AppendToStream(AStream, TABLE_INDENT + Format(
'<Table ss:ExpandedColumnCount="%d" ss:ExpandedRowCount="%d" ' + '<Table ss:ExpandedColumnCount="%d" ss:ExpandedRowCount="%d" ' +
'x:FullColumns="1" x:FullRows="1" ' + 'x:FullColumns="1" x:FullRows="1" ' +
'ss:DefaultColumnWidth="%.2f" ' + 'ss:DefaultColumnWidth="%.2f" ' +
'ss:DefaultRowHeight="%.2f">' + LF, 'ss:DefaultRowHeight="%.2f">' + LF,
[ [
AWorksheet.GetLastColIndex + 1, AWorksheet.GetLastRowIndex + 1, sheet.GetLastColIndex + 1, sheet.GetLastRowIndex + 1,
AWorksheet.ReadDefaultColWidth(suPoints), sheet.ReadDefaultColWidth(suPoints),
AWorksheet.ReadDefaultRowHeight(suPoints) sheet.ReadDefaultRowHeight(suPoints)
], ],
FPointSeparatorSettings FPointSeparatorSettings
)); ));
for c := c1 to c2 do for c := c1 to c2 do
begin begin
col := FWorksheet.FindCol(c); col := sheet.FindCol(c);
styleStr := ''; styleStr := '';
colWidthStr := ''; colWidthStr := '';
if Assigned(col) then if Assigned(col) then
@ -728,7 +745,7 @@ begin
// column width is needed in pts. // column width is needed in pts.
if col^.ColWidthType = cwtCustom then if col^.ColWidthType = cwtCustom then
colwidthStr := Format(' ss:Width="%0.2f" ss:AutoFitWidth="0"', colwidthStr := Format(' ss:Width="%0.2f" ss:AutoFitWidth="0"',
[FWorkbook.ConvertUnits(col^.Width, FWorkbook.Units, suPoints)], [(FWorkbook as TsWorkbook).ConvertUnits(col^.Width, FWorkbook.Units, suPoints)],
FPointSeparatorSettings); FPointSeparatorSettings);
// column style // column style
if col^.FormatIndex > 0 then if col^.FormatIndex > 0 then
@ -740,13 +757,13 @@ begin
for r := r1 to r2 do for r := r1 to r2 do
begin begin
row := FWorksheet.FindRow(r); row := sheet.FindRow(r);
styleStr := ''; styleStr := '';
// Row height is needed in pts. // Row height is needed in pts.
if Assigned(row) then if Assigned(row) then
begin begin
rowheightStr := Format(' ss:Height="%.2f"', rowheightStr := Format(' ss:Height="%.2f"',
[FWorkbook.ConvertUnits(row^.Height, FWorkbook.Units, suPoints)], [(FWorkbook as TsWorkbook).ConvertUnits(row^.Height, FWorkbook.Units, suPoints)],
FPointSeparatorSettings FPointSeparatorSettings
); );
if row^.RowHeightType = rhtCustom then if row^.RowHeightType = rhtCustom then
@ -760,10 +777,10 @@ begin
'<Row %s%s>' + LF, [rowheightStr, styleStr])); '<Row %s%s>' + LF, [rowheightStr, styleStr]));
for c := c1 to c2 do for c := c1 to c2 do
begin begin
cell := AWorksheet.FindCell(r, c); cell := sheet.FindCell(r, c);
if cell <> nil then if cell <> nil then
begin begin
if FWorksheet.IsMerged(cell) and not FWorksheet.IsMergeBase(cell) then if sheet.IsMerged(cell) and not sheet.IsMergeBase(cell) then
Continue; Continue;
WriteCellToStream(AStream, cell); WriteCellToStream(AStream, cell);
end; end;
@ -804,7 +821,7 @@ begin
end; end;
procedure TsSpreadExcelXMLWriter.WriteWorksheet(AStream: TStream; procedure TsSpreadExcelXMLWriter.WriteWorksheet(AStream: TStream;
AWorksheet: TsWorksheet); AWorksheet: TsBasicWorksheet);
var var
protectedStr: String; protectedStr: String;
begin begin
@ -827,7 +844,7 @@ begin
end; end;
procedure TsSpreadExcelXMLWriter.WriteWorksheetOptions(AStream: TStream; procedure TsSpreadExcelXMLWriter.WriteWorksheetOptions(AStream: TStream;
AWorksheet: TsWorksheet); AWorksheet: TsBasicWorksheet);
var var
footerStr, headerStr: String; footerStr, headerStr: String;
hideGridStr: String; hideGridStr: String;
@ -837,6 +854,7 @@ var
marginStr: String; marginStr: String;
selectedStr: String; selectedStr: String;
protectStr: String; protectStr: String;
sheet: TsWorksheet absolute AWorksheet;
begin begin
// Orientation, some PageLayout.Options // Orientation, some PageLayout.Options
layoutStr := GetLayoutStr(AWorksheet); layoutStr := GetLayoutStr(AWorksheet);
@ -864,7 +882,7 @@ begin
hideHeadersStr := INDENT3 + '<DoNotDisplayHeadings/>' + LF else hideHeadersStr := INDENT3 + '<DoNotDisplayHeadings/>' + LF else
hideHeadersStr := ''; hideHeadersStr := '';
if FWorkbook.ActiveWorksheet = AWorksheet then if (FWorkbook as TsWorkbook).ActiveWorksheet = AWorksheet then
selectedStr := INDENT3 + '<Selected/>' + LF else selectedStr := INDENT3 + '<Selected/>' + LF else
selectedStr := ''; selectedStr := '';
@ -899,9 +917,11 @@ end;
procedure TsSpreadExcelXMLWriter.WriteWorksheets(AStream: TStream); procedure TsSpreadExcelXMLWriter.WriteWorksheets(AStream: TStream);
var var
i: Integer; i: Integer;
book: TsWorkbook;
begin begin
for i:=0 to FWorkbook.GetWorksheetCount-1 do book := FWorkbook as TsWorkbook;
WriteWorksheet(AStream, FWorkbook.GetWorksheetByIndex(i)); for i:=0 to book.GetWorksheetCount-1 do
WriteWorksheet(AStream, book.GetWorksheetByIndex(i));
end; end;

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

File diff suppressed because it is too large Load Diff