fpspreadsheet: Add header/footer parser for conversion between Excel and ODS header/footer. Still some bugs.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4121 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-05-09 22:40:59 +00:00
parent 9253e59e67
commit 47db427771
8 changed files with 1263 additions and 366 deletions

View File

@ -7,8 +7,7 @@ uses
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, main, sHyperlinkForm, sNumFormatForm
{ you can add units after this };
Forms, main, sHyperlinkForm, sNumFormatForm;
{$R *.res}

View File

@ -0,0 +1,456 @@
unit fpsHeaderFooterParser;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpsTypes;
type
TsHeaderFooterToken = (hftText, hftNewLine,
hftSheetName, hftPath, hftFileName, hftDate, hftTime, hftPage, hftPageCount);
TsHeaderFooterFontStyle = (hfsBold, hfsItalic, hfsUnderline, hfsDblUnderline,
hfsStrikeout, hfsShadow, hfsOutline, hfsSubscript, hfsSuperScript);
TsHeaderFooterFontStyles = set of TsHeaderFooterFontStyle;
TsHeaderFooterFont = class(TObject)
FontName: String;
Size: Double;
Style: TsHeaderFooterFontStyles;
Color: TsColorValue;
constructor Create; overload;
constructor Create(AFont: TsFont); overload;
constructor Create(AFontName: String; ASize: Double;
AStyle: TsHeaderFooterFontStyles; AColor: TsColorValue); overload;
procedure Assign(AFont: TObject);
end;
TsHeaderFooterFontClass = class of TsHeaderFooterFont;
TsHeaderFooterElement = record
Token: TsHeaderFooterToken;
TextValue: String;
FontIndex: Integer;
end;
TsHeaderFooterSectionIndex = (hfsLeft, hfsCenter, hfsRight);
TsHeaderFooterSection = array of TsHeaderFooterElement;
TsHeaderFooterSections = array[TsHeaderFooterSectionIndex] of TsHeaderFooterSection;
TsHeaderFooterParser = class(TObject)
private
FParseText: String;
FToken: Char;
FCurrent: PChar;
FStart: PChar;
FEnd: PChar;
FCurrFont: TsHeaderFooterFont;
function NextToken: Char;
function PrevToken: Char;
procedure ScanFont;
procedure ScanFontColor;
procedure ScanFontSize;
procedure ScanNewLine;
procedure ScanSymbol;
protected
FSections: TsHeaderFooterSections;
FDefaultFont: TsHeaderFooterFont;
FCurrSection: TsHeaderFooterSectionIndex;
FStatus: Integer;
FFontList: TList;
FPointSeparatorSettings: TFormatSettings;
FCurrFontIndex: Integer;
FCurrText: String;
FFontClass: TsHeaderFooterFontClass;
procedure AddCurrTextElement;
procedure AddElement(AToken: TsHeaderFooterToken);
procedure AddFontStyle(AStyle: TsHeaderFooterFontStyle);
function FindCurrFont: Integer;
function GetCurrFontIndex: Integer; virtual;
procedure Parse; virtual;
procedure UseSection(AIndex: TsHeaderFooterSectionIndex); virtual;
public
constructor Create; overload;
constructor Create(AText: String; AFontList: TList;
ADefaultFont: TsHeaderFooterFont); overload;
destructor Destroy; override;
function BuildHeaderFooter: String;
end;
const
hfpsOK = 0;
implementation
uses
Math,
fpsUtils;
const
FONTSTYLE_SYMBOLS: array[TsHeaderFooterFontStyle] of char =
('B', 'I', 'U', 'E', 'S', 'H', 'O', 'X', 'Y');
constructor TsHeaderFooterFont.Create;
begin
inherited;
end;
constructor TsHeaderFooterFont.Create(AFontName: String; ASize: Double;
AStyle: TsHeaderFooterFontStyles; AColor: TsColorValue);
begin
FontName := AFontName;
Size := ASize;
Style := AStyle;
Color := AColor;
end;
constructor TsHeaderFooterFont.Create(AFont: TsFont);
begin
Create;
Assign(AFont);
end;
procedure TsHeaderFooterFont.Assign(AFont: TObject);
begin
if AFont is TsFont then
begin
FontName := TsFont(AFont).FontName;
Size := TsFont(AFont).Size;
Style := [];
if fssBold in TsFont(AFont).Style then Include(Style, hfsBold);
if fssItalic in TsFont(AFont).Style then Include(Style, hfsItalic);
if fssUnderline in TsFont(AFont).Style then Include(Style, hfsUnderline);
if fssStrikeout in TsFont(AFont).Style then Include(Style, hfsStrikeout);
Color := 0; // black --- to be replaced by TsFont.Color once it is no longer paletted
end else
if AFont is TsHeaderFooterFont then
begin
FontName := TsHeaderFooterFont(AFont).FontName;
Size := TsHeaderFooterFont(AFont).Size;
Style := TsHeaderFooterFont(AFont).Style;
Color := TsHeaderFooterFont(AFont).Color;
end else
raise Exception.Create('[TsHeaderFooterFont.Assign] Argument can only be a TsFont or a TsHeaderFooterFont');
end;
{ TsHeaderFooterParser }
constructor TsHeaderFooterParser.Create;
begin
FFontClass := TsHeaderFooterFont;
FPointSeparatorSettings := DefaultFormatSettings;
FPointSeparatorSettings.DecimalSeparator := '.';
FCurrSection := hfsCenter;
FCurrText := '';
end;
constructor TsHeaderFooterParser.Create(AText: String; AFontList: TList;
ADefaultFont: TsHeaderFooterFont);
begin
if AFontList = nil then
raise Exception.Create('[TsHeaderFooterParser.Create] FontList must not be nil.');
if ADefaultFont = nil then
raise Exception.Create('[TsHeaderFooterParser.Create] DefaultFont must not be nil.');
Create;
FFontList := AFontList;
FDefaultFont := ADefaultFont;
FCurrFont := TsHeaderFooterFont.Create;
FCurrFont.Assign(ADefaultFont);
FParseText := AText;
Parse;
end;
destructor TsHeaderFooterParser.Destroy;
begin
FCurrFont.Free;
inherited Destroy;
end;
procedure TsHeaderFooterParser.AddCurrTextElement;
begin
AddElement(hftText);
end;
procedure TsHeaderFooterParser.AddElement(AToken: TsHeaderFooterToken);
var
n: Integer;
begin
n := Length(FSections[FCurrSection]);
SetLength(FSections[FCurrSection], n+1);
with FSections[FCurrSection][n] do
begin
Token := AToken;
if Token = hftText then
begin
TextValue := FCurrText;
FCurrText := '';
end else
TextValue := '';
FontIndex := GetCurrFontIndex;
end;
end;
procedure TsHeaderFooterParser.AddFontStyle(AStyle: TsHeaderFooterFontStyle);
begin
if FCurrText <> '' then
AddCurrTextElement;
if AStyle in FCurrFont.Style then
Exclude(FCurrFont.Style, AStyle)
else
Include(FCurrFont.Style, AStyle);
end;
function TsHeaderFooterParser.BuildHeaderFooter: String;
var
sec: TsHeaderFooterSectionIndex;
element: TsHeaderFooterElement;
fnt, prevfnt: TsHeaderFooterFont;
fs: TsHeaderFooterFontStyle;
i: Integer;
begin
Result := '';
for sec := hfsLeft to hfsRight do
begin
prevfnt := FDefaultFont;
if Length(FSections[sec]) > 0 then
case sec of
hfsLeft : Result := Result + '&L';
hfsCenter : Result := Result + '&C';
hfsRight : Result := Result + '&R';
end;
for element in FSections[sec] do
begin
if (element.FontIndex > -1) and (element.FontIndex < FFontList.Count) then
begin
fnt := TsHeaderFooterFont(FFontList[element.FontIndex]);
if fnt.FontName = '' then fnt.FontName := FDefaultFont.FontName;
if not SameText(fnt.FontName, prevFnt.FontName) then
Result := Result + '&"' + fnt.FontName + '"';
if not SameValue(fnt.Size, prevfnt.Size, 1e-2) then
Result := Result + '&' + Format('%d', [round(fnt.Size)]); // Excel wants only integers!
for fs in TsHeaderFooterFontStyle do
if ((fs in fnt.Style) and not (fs in prevfnt.Style)) or
(not (fs in fnt.Style) and (fs in prevfnt.Style))
then
Result := Result + '&' + FONTSTYLE_SYMBOLS[fs];
if fnt.Color <> prevfnt.Color then
Result := Result + '&K' + ColorToHTMLColorStr(fnt.Color, true);
prevfnt := fnt;
end;
case element.Token of
hftText : for i:=1 to length(element.TextValue) do
if element.TextValue[i]='&'
then Result := Result + '&&'
else Result := Result + element.TextValue[i];
hftSheetName : Result := Result + '&A';
hftPath : Result := Result + '&Z';
hftFileName : Result := Result + '&F';
hftDate : Result := Result + '&D';
hftTime : Result := Result + '&T';
hftPage : Result := Result + '&P';
hftPageCount : Result := Result + '&N';
hftNewLine : Result := Result + LineEnding;
end;
end; // for element
end; // for sesc
end;
function TsHeaderFooterParser.FindCurrFont: Integer;
var
fnt: TsHeaderFooterFont;
begin
for Result := 0 to FFontList.Count-1 do
begin
fnt := TsHeaderFooterFont(FFontList[Result]);
if SameText(fnt.FontName, FCurrFont.FontName) and
SameValue(fnt.Size, FCurrFont.Size) and
(fnt.Style = FCurrFont.Style) and
(fnt.Color = FCurrFont.Color)
then
exit;
end;
Result := -1;
end;
function TsHeaderFooterParser.GetCurrFontIndex: Integer;
var
fnt: TsHeaderFooterFont;
begin
Result := FindCurrFont;
if Result = -1 then
begin
fnt := FFontClass.Create;
fnt.Assign(FCurrFont);
Result := FFontList.Add(fnt);
end;
end;
function TsHeaderFooterParser.NextToken: Char;
begin
if FCurrent < FEnd then begin
inc(FCurrent);
Result := FCurrent^;
end else
Result := #0;
end;
function TsHeaderFooterParser.PrevToken: Char;
begin
if FCurrent > nil then begin
dec(FCurrent);
Result := FCurrent^;
end else
Result := #0;
end;
procedure TsHeaderFooterParser.Parse;
begin
if FParseText = '' then
exit;
FStart := @FParseText[1];
FEnd := FStart + Length(FParseText);
FCurrent := FStart;
FToken := FCurrent^;
FCurrSection := hfsCenter;
while (FCurrent < FEnd) and (FStatus = hfpsOK) do begin
case FToken of
'&': ScanSymbol;
#13, #10: ScanNewLine;
else FCurrText := FCurrText + FToken;
end;
FToken := NextToken;
end;
if Length(FCurrText) > 0 then
AddCurrTextElement;
end;
procedure TsHeaderFooterParser.ScanFont;
var
s: String;
begin
s := '';
FToken := NextToken;
while (FCurrent < FEnd) and (FStatus = hfpsOK) and not (FToken in ['"', ',']) do
begin
// Excel allows to add a font-style identifier to the font name, separated
// by a comma. We do not support this feature because the font style
// identifier is a localized string! --> Skip text after the comma
if FToken = ',' then
begin
while (FCurrent < FEnd) and (FToken <> '"') do
FToken := NextToken;
break;
end else
begin
s := s + FToken;
FToken := NextToken;
end;
end;
FCurrFont.FontName := s;
end;
procedure TsHeaderFooterParser.ScanFontColor;
var
s: String;
begin
s := '#';
FToken := NextToken;
while (FCurrent < FEnd) and (FStatus = hfpsOK) and (FToken in ['0'..'9', 'A'..'F']) do
begin
s := s + FToken;
FToken := NextToken;
end;
FToken := PrevToken;
FCurrFont.Color := HTMLColorStrToColor(s);
end;
procedure TsHeaderFooterParser.ScanFontSize;
var
s: String;
begin
s := '';
while (FCurrent < FEnd) and (FStatus = hfpsOK) and (FToken in ['0'..'9','.']) do
begin
s := s + FToken;
FToken := NextToken;
end;
FToken := PrevToken;
FCurrFont.Size := StrToFloat(s, FPointSeparatorSettings);
end;
procedure TsHeaderFooterParser.ScanNewLine;
begin
case FToken of
#13: begin
AddElement(hftNewLine);
FToken := NextToken;
if FToken <> #10 then FToken := PrevToken;
end;
#10: AddElement(hftNewLine);
end;
end;
procedure TsHeaderFooterParser.ScanSymbol;
begin
FToken := NextToken;
if FToken = '&' then
FCurrText := FCurrText + '&'
else
begin
if FCurrText <> '' then
AddCurrTextElement;
case FToken of
'L': UseSection(hfsLeft);
'C': UseSection(hfsCenter);
'R': UseSection(hfsRight);
'A': AddElement(hftSheetName);
'F': AddElement(hftFileName);
'Z': AddElement(hftPath);
'D': AddElement(hftDate);
'T': AddElement(hftTime);
'P': AddElement(hftPage);
'N': AddElement(hftPageCount);
'"': ScanFont;
'0'..'9', '.': ScanFontSize;
'K': ScanFontColor;
'B': AddFontStyle(hfsBold);
'I': AddFontStyle(hfsItalic);
'U': AddFontStyle(hfsUnderline);
'E': AddFontStyle(hfsDblUnderline);
'S': AddFontStyle(hfsStrikeout);
'H': AddFontStyle(hfsShadow);
'O': AddFontStyle(hfsOutline);
'X': AddFontStyle(hfsSuperscript);
'Y': AddFontStyle(hfsSubscript);
end;
end;
end;
procedure TsHeaderFooterParser.UseSection(AIndex: TsHeaderFooterSectionIndex);
begin
if FCurrText <> '' then
AddCurrTextElement;
FCurrFont.FontName := FDefaultFont.FontName;
FCurrFont.Size := FDefaultFont.Size;
FCurrFont.Style := FDefaultFont.Style;
FCurrFont.Color := FDefaultFont.Color;
FCurrSection := AIndex;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -15,11 +15,11 @@ uses
type
TsSpreadXMLReader = class(TsCustomSpreadReader)
protected
function GetAttrValue(ANode : TDOMNode; AAttrName : string) : string;
function GetNodeValue(ANode: TDOMNode): String;
procedure ReadXMLFile(out ADoc: TXMLDocument; AFileName: String);
end;
function GetAttrValue(ANode : TDOMNode; AAttrName : string) : string;
function GetNodeValue(ANode: TDOMNode): String;
procedure UnzipFile(AZipFileName, AZippedFile, ADestFolder: String);
@ -35,7 +35,7 @@ uses
{ Gets value for the specified attribute. Returns empty string if attribute
not found. }
function TsSpreadXMLReader.GetAttrValue(ANode : TDOMNode; AAttrName : string) : string;
function {TsSpreadXMLReader.}GetAttrValue(ANode : TDOMNode; AAttrName : string) : string;
var
i: LongWord;
Found: Boolean;
@ -58,7 +58,7 @@ end;
{ Returns the text value of a node. Normally it would be sufficient to call
"ANode.NodeValue", but since the DOMParser needs to preserve white space
(for the spaces in date/time formats), we have to go more into detail. }
function TsSpreadXMLReader.GetNodeValue(ANode: TDOMNode): String;
function {TsSpreadXMLReader.}GetNodeValue(ANode: TDOMNode): String;
var
child: TDOMNode;
begin

View File

@ -28,7 +28,7 @@
This package is all you need if you don't want graphical components (like grids and charts)."/>
<License Value="LGPL with static linking exception. This is the same license as is used in the LCL (Lazarus Component Library)."/>
<Version Major="1" Minor="5"/>
<Files Count="33">
<Files Count="34">
<Item1>
<Filename Value="fpolestorage.pas"/>
<UnitName Value="fpolestorage"/>
@ -161,6 +161,10 @@ This package is all you need if you don't want graphical components (like grids
<Filename Value="fpsclasses.pas"/>
<UnitName Value="fpsclasses"/>
</Item33>
<Item34>
<Filename Value="fpsheaderfooterparser.pas"/>
<UnitName Value="fpsHeaderFooterParser"/>
</Item34>
</Files>
<RequiredPkgs Count="2">
<Item1>

View File

@ -13,7 +13,7 @@ uses
uvirtuallayer_ole_helpers, uvirtuallayer_ole_types, uvirtuallayer_stream,
fpolebasic, wikitable, fpsNumFormatParser, fpsfunc, fpsRPN, fpsStrings,
fpscsv, fpsCsvDocument, fpspatches, fpsTypes, xlsEscher, fpsReaderWriter,
fpsNumFormat, fpsclasses;
fpsNumFormat, fpsclasses, fpsHeaderFooterParser;
implementation

View File

@ -480,7 +480,7 @@ begin
TestWorkbook := TsWorkbook.Create;
case UpperCase(ExtractFileExt(FileName)) of
'.XLSX': TestWorkbook.ReadFromFile(FileName, sfOOXML);
'.ODS': TestWorkbook.ReadFromFile(FileName, sfOpenDocument);
'.ODS' : TestWorkbook.ReadFromFile(FileName, sfOpenDocument);
// Excel XLS/BIFF
else TestWorkbook.ReadFromFile(FileName, sfExcel8);
end;

View File

@ -50,6 +50,10 @@ type
procedure TestWriteRead_BIFF2_HeaderFooterSymbols_2sheets;
procedure TestWriteRead_BIFF2_HeaderFooterSymbols_3sheets;
procedure TestWriteRead_BIFF2_HeaderFooterFontSymbols_1sheet;
procedure TestWriteRead_BIFF2_HeaderFooterFontSymbols_2sheets;
procedure TestWriteRead_BIFF2_HeaderFooterFontSymbols_3sheets;
// no BIFF2 page orientation tests because this info is not readily available in the file
@ -99,6 +103,14 @@ type
procedure TestWriteRead_BIFF5_HeaderFooterSymbols_2sheets;
procedure TestWriteRead_BIFF5_HeaderFooterSymbols_3sheets;
procedure TestWriteRead_BIFF5_HeaderFooterFontSymbols_1sheet;
procedure TestWriteRead_BIFF5_HeaderFooterFontSymbols_2sheets;
procedure TestWriteRead_BIFF5_HeaderFooterFontSymbols_3sheets;
procedure TestWriteRead_BIFF5_HeaderFooterFontColor_1sheet;
procedure TestWriteRead_BIFF5_HeaderFooterFontColor_2sheets;
procedure TestWriteRead_BIFF5_HeaderFooterFontColor_3sheets;
{ BIFF8 page layout tests }
procedure TestWriteRead_BIFF8_PageMargins_1sheet_0;
procedure TestWriteRead_BIFF8_PageMargins_1sheet_1;
@ -145,6 +157,14 @@ type
procedure TestWriteRead_BIFF8_HeaderFooterSymbols_2sheets;
procedure TestWriteRead_BIFF8_HeaderFooterSymbols_3sheets;
procedure TestWriteRead_BIFF8_HeaderFooterFontSymbols_1sheet;
procedure TestWriteRead_BIFF8_HeaderFooterFontSymbols_2sheets;
procedure TestWriteRead_BIFF8_HeaderFooterFontSymbols_3sheets;
procedure TestWriteRead_BIFF8_HeaderFooterFontColor_1sheet;
procedure TestWriteRead_BIFF8_HeaderFooterFontColor_2sheets;
procedure TestWriteRead_BIFF8_HeaderFooterFontColor_3sheets;
{ OOXML page layout tests }
procedure TestWriteRead_OOXML_PageMargins_1sheet_0;
procedure TestWriteRead_OOXML_PageMargins_1sheet_1;
@ -191,6 +211,14 @@ type
procedure TestWriteRead_OOXML_HeaderFooterSymbols_2sheets;
procedure TestWriteRead_OOXML_HeaderFooterSymbols_3sheets;
procedure TestWriteRead_OOXML_HeaderFooterFontSymbols_1sheet;
procedure TestWriteRead_OOXML_HeaderFooterFontSymbols_2sheets;
procedure TestWriteRead_OOXML_HeaderFooterFontSymbols_3sheets;
procedure TestWriteRead_OOXML_HeaderFooterFontColor_1sheet;
procedure TestWriteRead_OOXML_HeaderFooterFontColor_2sheets;
procedure TestWriteRead_OOXML_HeaderFooterFontColor_3sheets;
{ OpenDocument page layout tests }
procedure TestWriteRead_ODS_PageMargins_1sheet_0;
procedure TestWriteRead_ODS_PageMargins_1sheet_1;
@ -237,6 +265,13 @@ type
procedure TestWriteRead_ODS_HeaderFooterSymbols_2sheets;
procedure TestWriteRead_ODS_HeaderFooterSymbols_3sheets;
procedure TestWriteRead_ODS_HeaderFooterFontSymbols_1sheet;
procedure TestWriteRead_ODS_HeaderFooterFontSymbols_2sheets;
procedure TestWriteRead_ODS_HeaderFooterFontSymbols_3sheets;
procedure TestWriteRead_ODS_HeaderFooterFontColor_1sheet;
procedure TestWriteRead_ODS_HeaderFooterFontColor_2sheets;
procedure TestWriteRead_ODS_HeaderFooterFontColor_3sheets;
end;
implementation
@ -267,6 +302,8 @@ end;
3 ... header, footer }
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_PageMargins(
AFormat: TsSpreadsheetFormat; ANumSheets, AHeaderFooterMode: Integer);
const
EPS = 1e-6;
var
MyWorksheet: TsWorksheet;
MyWorkbook: TsWorkbook;
@ -324,16 +361,16 @@ begin
fail('Error in test code. Failed to get worksheet by index');
actualPageLayout := MyWorksheet.PageLayout;
CheckEquals(sollPageLayout.TopMargin, actualPageLayout.TopMargin, 'Top margin mismatch, sheet "'+MyWorksheet.Name+'"');
CheckEquals(sollPageLayout.BottomMargin, actualPageLayout.Bottommargin, 'Bottom margin mismatch, sheet "'+MyWorksheet.Name+'"');
CheckEquals(sollPageLayout.LeftMargin, actualPageLayout.LeftMargin, 'Left margin mismatch, sheet "'+MyWorksheet.Name+'"');
CheckEquals(sollPageLayout.RightMargin, actualPageLayout.RightMargin, 'Right margin mismatch, sheet "'+MyWorksheet.Name+'"');
CheckEquals(sollPageLayout.TopMargin, actualPageLayout.TopMargin, EPS, 'Top margin mismatch, sheet "'+MyWorksheet.Name+'"');
CheckEquals(sollPageLayout.BottomMargin, actualPageLayout.Bottommargin, EPS, 'Bottom margin mismatch, sheet "'+MyWorksheet.Name+'"');
CheckEquals(sollPageLayout.LeftMargin, actualPageLayout.LeftMargin, EPS, 'Left margin mismatch, sheet "'+MyWorksheet.Name+'"');
CheckEquals(sollPageLayout.RightMargin, actualPageLayout.RightMargin, EPS, 'Right margin mismatch, sheet "'+MyWorksheet.Name+'"');
if (AFormat <> sfExcel2) then // No header/footer margin in BIFF2
begin
if AHeaderFooterMode in [1, 3] then
CheckEquals(sollPageLayout.HeaderMargin, actualPageLayout.HeaderMargin, 'Header margin mismatch, sheet "'+MyWorksheet.Name+'"');
CheckEquals(sollPageLayout.HeaderMargin, actualPageLayout.HeaderMargin, EPS, 'Header margin mismatch, sheet "'+MyWorksheet.Name+'"');
if AHeaderFooterMode in [2, 3] then
CheckEquals(sollPageLayout.FooterMargin, actualPageLayout.FooterMargin, 'Footer margin mismatch, sheet "'+MyWorksheet.Name+'"');
CheckEquals(sollPageLayout.FooterMargin, actualPageLayout.FooterMargin, EPS, 'Footer margin mismatch, sheet "'+MyWorksheet.Name+'"');
end;
end;
@ -437,6 +474,38 @@ begin
Footers[HEADER_FOOTER_INDEX_ALL] := '&LSheet "&A"&C100&&';
end;
end;
8: // Header/footer font symbol test
begin
Headers[HEADER_FOOTER_INDEX_ALL] :=
'&LH&Y2&YO cm&X2&X'+
'&C&"Times New Roman"&18This is big'+
'&RThis is &Bbold&B,'+ LineEnding+'&Iitalic&I,'+LineEnding+
'&Uunderlined&U,'+LineEnding+'&Edouble underlined&E,'+
'&Sstriked-out&S,'+LineEnding+'&Ooutlined&O,'+LineEnding+
'&Hshadow&S';
Footers[HEADER_FOOTER_INDEX_ALL] :=
'&L&"Arial"&8Arial small'+
'&C&"Courier new"&32Courier big'+
'&R&"Times New Roman"&10Times standard';
case p of
0: Footers[HEADER_FOOTER_INDEX_ALL] := '';
1: Headers[HEADER_FOOTER_INDEX_ALL] := '';
end;
end;
9: // Header/footer font color test
begin
Headers[HEADER_FOOTER_INDEX_ALL] :=
'&L&KFF0000This is red'+
'&C&K00FF00This is green'+
'&R&K0000FFThis is blue';
Footers[HEADER_FOOTER_INDEX_ALL] :=
'&LThis is &"Times New Roman"&KFF0000red&K000000, &K00FF00green&K000000, &K0000FFblue&K000000.';
case p of
0: Footers[HEADER_FOOTER_INDEX_ALL] := '';
1: Headers[HEADER_FOOTER_INDEX_ALL] := '';
end;
end;
end;
end;
end;
@ -508,7 +577,7 @@ begin
CheckEquals(sollPageLayout[p].StartPageNumber, actualPageLayout.StartPageNumber,
'StartPageNumber value mismatch, sheet "' + MyWorksheet.Name + '"');
end;
6, 7: // Header/footer tests
6, 7, 8, 9: // Header/footer tests
begin
CheckEquals(sollPageLayout[p].Headers[1], actualPageLayout.Headers[1],
'Header value mismatch, sheet "' + MyWorksheet.Name + '"');
@ -622,6 +691,22 @@ begin
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_BIFF2_HeaderFooterFontSymbols_1sheet;
begin
TestWriteRead_PageLayout(sfExcel2, 1, 8);
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_BIFF2_HeaderFooterFontSymbols_2sheets;
begin
TestWriteRead_PageLayout(sfExcel2, 2, 8);
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_BIFF2_HeaderFooterFontSymbols_3sheets;
begin
TestWriteRead_PageLayout(sfExcel2, 3, 8);
end;
{ Tests for BIFF5 file format }
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_BIFF5_PageMargins_1sheet_0;
@ -815,6 +900,38 @@ begin
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_BIFF5_HeaderFooterFontSymbols_1sheet;
begin
TestWriteRead_PageLayout(sfExcel5, 1, 8);
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_BIFF5_HeaderFooterFontSymbols_2sheets;
begin
TestWriteRead_PageLayout(sfExcel5, 2, 8);
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_BIFF5_HeaderFooterFontSymbols_3sheets;
begin
TestWriteRead_PageLayout(sfExcel5, 3, 8);
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_BIFF5_HeaderFooterFontColor_1sheet;
begin
TestWriteRead_PageLayout(sfExcel5, 1, 9);
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_BIFF5_HeaderFooterFontColor_2sheets;
begin
TestWriteRead_PageLayout(sfExcel5, 2, 9);
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_BIFF5_HeaderFooterFontColor_3sheets;
begin
TestWriteRead_PageLayout(sfExcel5, 3, 9);
end;
{ Tests for BIFF8 file format }
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_BIFF8_PageMargins_1sheet_0;
@ -1008,6 +1125,38 @@ begin
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_BIFF8_HeaderFooterFontSymbols_1sheet;
begin
TestWriteRead_PageLayout(sfExcel8, 1, 8);
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_BIFF8_HeaderFooterFontSymbols_2sheets;
begin
TestWriteRead_PageLayout(sfExcel8, 2, 8);
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_BIFF8_HeaderFooterFontSymbols_3sheets;
begin
TestWriteRead_PageLayout(sfExcel8, 3, 8);
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_BIFF8_HeaderFooterFontColor_1sheet;
begin
TestWriteRead_PageLayout(sfExcel8, 1, 9);
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_BIFF8_HeaderFooterFontColor_2sheets;
begin
TestWriteRead_PageLayout(sfExcel8, 2, 9);
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_BIFF8_HeaderFooterFontColor_3sheets;
begin
TestWriteRead_PageLayout(sfExcel8, 3, 9);
end;
{ Tests for OOXML file format }
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_OOXML_PageMargins_1sheet_0;
@ -1201,6 +1350,38 @@ begin
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_OOXML_HeaderFooterFontSymbols_1sheet;
begin
TestWriteRead_PageLayout(sfOOXML, 1, 8);
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_OOXML_HeaderFooterFontSymbols_2sheets;
begin
TestWriteRead_PageLayout(sfOOXML, 2, 8);
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_OOXML_HeaderFooterFontSymbols_3sheets;
begin
TestWriteRead_PageLayout(sfOOXML, 3, 8);
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_OOXML_HeaderFooterFontColor_1sheet;
begin
TestWriteRead_PageLayout(sfOOXML, 1, 9);
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_OOXML_HeaderFooterFontColor_2sheets;
begin
TestWriteRead_PageLayout(sfOOXML, 2, 9);
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_OOXML_HeaderFooterFontColor_3sheets;
begin
TestWriteRead_PageLayout(sfOOXML, 3, 9);
end;
{ Tests for Open Document file format }
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_ODS_PageMargins_1sheet_0;
@ -1394,6 +1575,38 @@ begin
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_ODS_HeaderFooterFontSymbols_1sheet;
begin
TestWriteRead_PageLayout(sfOpenDocument, 1, 8);
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_ODS_HeaderFooterFontSymbols_2sheets;
begin
TestWriteRead_PageLayout(sfOpenDocument, 2, 8);
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_ODS_HeaderFooterFontSymbols_3sheets;
begin
TestWriteRead_PageLayout(sfOpenDocument, 3, 8);
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_ODS_HeaderFooterFontColor_1sheet;
begin
TestWriteRead_PageLayout(sfOpenDocument, 1, 9);
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_ODS_HeaderFooterFontColor_2sheets;
begin
TestWriteRead_PageLayout(sfOpenDocument, 2, 9);
end;
procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_ODS_HeaderFooterFontColor_3sheets;
begin
TestWriteRead_PageLayout(sfOpenDocument, 3, 9);
end;
initialization
RegisterTest(TSpreadWriteReadPageLayoutTests);