You've already forked lazarus-ccr
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:
@ -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}
|
||||
|
||||
|
456
components/fpspreadsheet/fpsheaderfooterparser.pas
Normal file
456
components/fpspreadsheet/fpsheaderfooterparser.pas
Normal 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
@ -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
|
||||
|
@ -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>
|
||||
|
@ -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
|
||||
|
||||
|
@ -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;
|
||||
|
@ -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] :=
|
||||
'<his 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);
|
||||
|
||||
|
Reference in New Issue
Block a user