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

fpspreadsheet: Add writing of header/footer images to ods.

Browse Source 
Reorganize ods header/footer code. 
Fix writing of page margings for ods. 
Fix Excel failing to load file with footer image.
Add header/footer image and image demos.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4545 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-03-13 18:15:40 +00:00
parent 41c844a112
commit a5e8d60e81
9 changed files with 551 additions and 154 deletions
Download Patch File Download Diff File Expand all files Collapse all files

61
components/fpspreadsheet/examples/other/demo_write_headerfooter_images.lpi Normal file
View File

@ -0,0 +1,61 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<Flags>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="demo_write_headerfooter_images"/>
<UseAppBundle Value="False"/>
</General>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LazUtils"/>
</Item1>
</RequiredPackages>
<Units Count="1">
<Unit0>
<Filename Value="demo_write_headerfooter_images.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="demo_write_headerfooter_images"/>
</Target>
<SearchPaths>
<OtherUnitFiles Value="..\.."/>
<UnitOutputDirectory Value="..\..\lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
</CompilerOptions>
</CONFIG>

53
components/fpspreadsheet/examples/other/demo_write_headerfooter_images.lpr Normal file
View File

@ -0,0 +1,53 @@
program demo_write_headerfooter_images;
{$mode delphi}{$H+}
uses
Classes, SysUtils, fpstypes, fpspreadsheet, fpsallformats, fpsutils,
fpsPageLayout;
var
MyWorkbook: TsWorkbook;
MyWorksheet: TsWorksheet;
MyDir: string;
cell: PCell;
i, r, c: Integer;
const
image1 = '../../images/components/TSWORKBOOKSOURCE.png';
image2 = '../../images/components/TSWORKSHEETGRID.png';
image3 = '../../images/components/TSCELLEDIT.png';
begin
// Create the spreadsheet
MyWorkbook := TsWorkbook.Create;
MyWorkbook.Options := [boFileStream];
MyWorksheet := MyWorkbook.AddWorksheet('Sheet 1');
MyWorksheet.WriteText(0, 0, 'The header of this sheet contains an image');
MyWorksheet.Pagelayout.TopMargin := 30;
MyWorksheet.PageLayout.HeaderMargin := 10; //25;
MyWorksheet.PageLayout.Headers[HEADER_FOOTER_INDEX_ALL] := '&CHeader with image!';
// MyWorksheet.PageLayout.AddHeaderImage(HEADER_FOOTER_INDEX_ALL, hfsLeft, image1);
MyWorksheet := MyWorkbook.AddWorksheet('Sheet 2');
MyWorksheet.WriteText(0, 0, 'The footer of this sheet contains an image');
MyWorksheet.PageLayout.Footers[HEADER_FOOTER_INDEX_ALL] := '&CFooter with image!';
// MyWorksheet.PageLayout.AddFooterImage(HEADER_FOOTER_INDEX_ALL, hfsRight, image2);
// Save the spreadsheet to a file
MyDir := ExtractFilePath(ParamStr(0));
MyWorkbook.WriteToFile(MyDir + 'hfimg.xlsx', sfOOXML, true);
MyWorkbook.WriteToFile(MyDir + 'hfimg.ods', sfOpenDocument, true);
// MyWorkbook.WriteToFile(MyDir + 'hfimg.xls', sfExcel8, true);
// MyWorkbook.WriteToFile(MyDir + 'hfimg5.xls', sfExcel5, true);
// MyWorkbook.WriteToFile(MyDir + 'hfimg2.xls', sfExcel2, true);
if MyWorkbook.ErrorMsg <> '' then
begin
WriteLn(MyWorkbook.ErrorMsg);
end;
MyWorkbook.Free;
end.

61
components/fpspreadsheet/examples/other/demo_write_images.lpi Normal file
View File

@ -0,0 +1,61 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<Flags>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="demo_write_images"/>
<UseAppBundle Value="False"/>
</General>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LazUtils"/>
</Item1>
</RequiredPackages>
<Units Count="1">
<Unit0>
<Filename Value="demo_write_images.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="demo_write_images"/>
</Target>
<SearchPaths>
<OtherUnitFiles Value="..\.."/>
<UnitOutputDirectory Value="..\..\lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
</CompilerOptions>
</CONFIG>

54
components/fpspreadsheet/examples/other/demo_write_images.lpr Normal file
View File

@ -0,0 +1,54 @@
program demo_write_images;
{$mode delphi}{$H+}
uses
Classes, SysUtils, fpstypes, fpspreadsheet, fpsallformats, fpsutils,
fpsPageLayout;
var
MyWorkbook: TsWorkbook;
MyWorksheet: TsWorksheet;
MyDir: string;
cell: PCell;
i, r, c: Integer;
const
image1 = '../../images/components/TSWORKBOOKSOURCE.png';
image2 = '../../images/components/TSWORKSHEETGRID.png';
image3 = '../../images/components/TSCELLEDIT.png';
begin
// Create the spreadsheet
MyWorkbook := TsWorkbook.Create;
MyWorkbook.Options := [boFileStream];
MyWorksheet := MyWorkbook.AddWorksheet('Sheet 1');
MyWorksheet.WriteText(0, 0, 'There are images in cells A3 and B3'); //
MyWorksheet.WriteImage(2, 0, image1);
MyWorksheet.WriteImage(3, 0, image2);
MyWorksheet := MyWorkbook.AddWorksheet('Sheet 2');
MyWorksheet.WriteText(0, 0, 'There is an image in cell B3');
MyWorksheet.WriteImage(2, 1, image3);
// MyWorksheet.WriteImage(0, 2, 'D:\Prog_Lazarus\svn\lazarus-ccr\components\fpspreadsheet\examples\read_write\ooxmldemo\laz_open.png');
// MyWorksheet.WriteHyperlink(0, 0, 'http://www.chip.de');
// MyWorksheet.PageLayout.AddHeaderImage(1, hfsLeft, 'D:\Prog_Lazarus\svn\lazarus-ccr\components\fpspreadsheet\examples\read_write\ooxmldemo\laz_open.png');
// MyWorksheet.PageLayout.Headers[1] := '&LThis is a header&R&G';
// Save the spreadsheet to a file
MyDir := ExtractFilePath(ParamStr(0));
MyWorkbook.WriteToFile(MyDir + 'img.xlsx', sfOOXML, true);
MyWorkbook.WriteToFile(MyDir + 'img.ods', sfOpenDocument, true);
// MyWorkbook.WriteToFile(MyDir + 'img.xls', sfExcel8, true);
// MyWorkbook.WriteToFile(MyDir + 'img5.xls', sfExcel5, true);
// MyWorkbook.WriteToFile(MyDir + 'img2.xls', sfExcel2, true);
if MyWorkbook.ErrorMsg <> '' then
begin
WriteLn(MyWorkbook.ErrorMsg);
end;
MyWorkbook.Free;
end.

27
components/fpspreadsheet/fpsheaderfooterparser.pas
View File

@ -182,7 +182,7 @@ end;
destructor TsHeaderFooterParser.Destroy;
begin
FCurrFont.Free;
if FCurrFont <> nil then FCurrFont.Free;
inherited Destroy;
end;
@ -215,10 +215,13 @@ begin
if FCurrText <> '' then
AddCurrTextElement;
if AStyle in FCurrFont.Style then
Exclude(FCurrFont.Style, AStyle)
else
Include(FCurrFont.Style, AStyle);
if not FIgnoreFonts then
begin
if AStyle in FCurrFont.Style then
Exclude(FCurrFont.Style, AStyle)
else
Include(FCurrFont.Style, AStyle);
end;
end;
procedure TsHeaderFooterParser.AddNewLine;
@ -313,8 +316,11 @@ function TsHeaderFooterParser.GetCurrFontIndex: Integer;
var
fnt: TsHeaderFooterFont;
begin
Result := -1;
if FIgnoreFonts then
exit;
Result := FindCurrFont;
if Result = -1 then
if (Result = -1) then
begin
fnt := FFontClass.Create;
fnt.Assign(FCurrFont);
@ -396,7 +402,8 @@ begin
FToken := NextToken;
end;
end;
FCurrFont.FontName := s;
if not FIgnoreFonts then
FCurrFont.FontName := s;
end;
procedure TsHeaderFooterParser.ScanFontColor;
@ -411,7 +418,8 @@ begin
FToken := NextToken;
end;
FToken := PrevToken;
FCurrFont.Color := HTMLColorStrToColor(s);
if not FIgnoreFonts then
FCurrFont.Color := HTMLColorStrToColor(s);
end;
procedure TsHeaderFooterParser.ScanFontSize;
@ -425,7 +433,8 @@ begin
FToken := NextToken;
end;
FToken := PrevToken;
FCurrFont.Size := StrToFloat(s, FPointSeparatorSettings);
if not FIgnoreFonts then
FCurrFont.Size := StrToFloat(s, FPointSeparatorSettings);
end;
procedure TsHeaderFooterParser.ScanNewLine;

386
components/fpspreadsheet/fpsopendocument.pas
View File

@ -205,6 +205,8 @@ type
procedure AddBuiltinNumFormats; override;
procedure CreateStreams;
procedure DestroyStreams;
procedure GetHeaderFooterImageName(APageLayout: TsPageLayout; out AHeader, AFooter: String);
procedure GetHeaderFooterImagePosStr(APagelayout: TsPageLayout; out AHeader, AFooter: String);
procedure InternalWriteToStream(AStream: TStream);
procedure ListAllColumnStyles;
procedure ListAllHeaderFooterFonts;
@ -214,9 +216,9 @@ type
{ Routines to write those files }
procedure WriteContent;
procedure WriteMimetype;
procedure WriteMetaInfManifest;
procedure WriteMeta;
procedure WriteMimetype;
procedure WriteSettings;
procedure WriteStyles;
procedure WriteWorksheet(AStream: TStream; ASheetIndex: Integer);
@ -288,6 +290,7 @@ const
SCHEMAS_XMLNS_TABLE = 'urn:oasis:names:tc:opendocument:xmlns:table:1.0';
SCHEMAS_XMLNS_TEXT = 'urn:oasis:names:tc:opendocument:xmlns:text:1.0';
SCHEMAS_XMLNS_V = 'urn:schemas-microsoft-com:vml';
SCHEMAS_XMLNS_XLINK = 'http://www.w3.org/1999/xlink';
{%H-}SCHEMAS_XMLNS_NUMBER = 'urn:oasis:names:tc:opendocument:xmlns:datastyle:1.0';
{%H-}SCHEMAS_XMLNS_CHART = 'urn:oasis:names:tc:opendocument:xmlns:chart:1.0';
{%H-}SCHEMAS_XMLNS_DR3D = 'urn:oasis:names:tc:opendocument:xmlns:dr3d:1.0';
@ -512,8 +515,11 @@ begin
s := '<text:page-number>1</text:page-number>';
hftPageCount:
s := '<text:page-count>1</text:page-count>';
else
s := '';
end;
regionStr[sec] := regionStr[sec] + s;
if s <> '' then
regionStr[sec] := regionStr[sec] + s;
end; // for element
if regionStr[sec] <> '' then
regionStr[sec] := '<text:p>' + regionStr[sec] + '</text:p>';
@ -1298,7 +1304,7 @@ var
s: String;
data: TPageLayoutData;
isHeader: Boolean;
h: Double;
h, dist: Double;
fnt: TXMLHeaderFooterFont;
defFnt: TsFont;
fntName: String;
@ -1441,17 +1447,38 @@ begin
nodeName := child.NodeName;
if nodeName = 'style:header-footer-properties' then
begin
s := GetAttrValue(child, 'fo:min-height');
h := 0;
dist := 0;
s := GetAttrValue(child, 'svg:height');
if s <> '' then
h := PtsToMM(HTMLLengthStrToPts(s)) else h := 0;
h := PtsToMM(HTMLLengthStrToPts(s))
else begin
s := GetAttrValue(child, 'fo:min-height');
if s <> '' then
h := PtsToMM(HTMLLengthStrToPts(s)) else h := 0;
end;
if isHeader then
s := GetAttrValue(child, 'fo:margin-bottom') else
s := GetAttrValue(child, 'fo:margin-top');
if s <> '' then
dist := PtsToMM(HTMLLengthStrToPts(s));
if isHeader then
begin
data.PageLayout.HeaderMargin := h + dist;
// Note: TopMargin and HeaderMargin are not yet the same as in Excel
// Will be fixed in ReadMasterStyles where it will be known
// whether the header is displayed.
{
data.PageLayout.HeaderMargin := data.PageLayout.TopMargin;
data.PageLayout.TopMargin := data.PageLayout.HeaderMargin + h;
data.PageLayout.TopMargin := data.PageLayout.HeaderMargin + h + dist;
}
end else
begin
data.Pagelayout.FooterMargin := h + dist;
{
data.PageLayout.FooterMargin := data.PageLayout.BottomMargin;
data.PageLayout.BottomMargin := data.PageLayout.FooterMargin + h;
data.PageLayout.BottomMargin := data.PageLayout.FooterMargin + h + dist;
}
end;
end;
child := child.NextSibling;
@ -1489,6 +1516,7 @@ var
data: TMasterPageData;
pagelayout: TsPageLayout;
j: Integer;
h: Double;
begin
if AStylesNode = nil then
@ -1525,6 +1553,13 @@ begin
s := ReadHeaderFooterText(styleNode);
if s <> '' then
pageLayout.Headers[HEADER_FOOTER_INDEX_ODD] := s;
s := GetAttrValue(styleNode, 'style:display');
if s <> 'false' then
begin
h := pageLayout.HeaderMargin;
pagelayout.HeaderMargin := pageLayout.TopMargin;
pagelayout.TopMargin := pageLayout.TopMargin + h;
end;
end else
if nodeName = 'style:header-left' then
begin
@ -1536,13 +1571,25 @@ begin
end;
s := GetAttrValue(styleNode, 'style:display');
if s = 'false' then
with pageLayout do Options := Options - [poDifferentOddEven];
pageLayout.Options := pagelayout.Options - [poDifferentOddEven]
else begin
h := pageLayout.HeaderMargin;
pageLayout.HeaderMargin := pageLayout.TopMargin;
pagelayout.TopMargin := pageLayout.TopMargin + h;
end;
end else
if nodeName = 'style:footer' then
begin
s := ReadHeaderFooterText(styleNode);
if s <> '' then
pageLayout.Footers[HEADER_FOOTER_INDEX_ODD] := s;
s := GetAttrValue(styleNode, 'style:display');
if s <> 'false' then
begin
h := pageLayout.FooterMargin;
pageLayout.FooterMargin := pageLayout.BottomMargin;
pageLayout.BottomMargin := pageLayout.BottomMargin + h;
end;
end else
if nodeName = 'style:footer-left' then
begin
@ -1554,7 +1601,12 @@ begin
end;
s := GetAttrValue(styleNode, 'style:display');
if s = 'false' then
with pagelayout do Options := Options - [poDifferentOddEven];
pagelayout.Options := pagelayout.Options - [poDifferentOddEven]
else begin
h := pagelayout.FooterMargin;
pagelayout.FooterMargin := pagelayout.BottomMargin;
pagelayout.BottomMargin := pagelayout.BottomMargin + h;
end;
end;
styleNode := styleNode.NextSibling;
end;
@ -3907,6 +3959,57 @@ begin
DestroyTempStream(FSMetaInfManifest);
end;
procedure TsSpreadOpenDocWriter.GetHeaderFooterImageName(
APageLayout: TsPageLayout; out AHeader, AFooter: String);
var
sct: TsHeaderFooterSectionIndex;
img: TsHeaderFooterImage;
begin
AHeader := '';
AFooter := '';
if APageLayout.HasHeaderFooterImages then
begin
// ods supports only a single image per header/footer. We use the first one.
for sct in TsHeaderFooterSectionIndex do
if APageLayout.HeaderImages[sct].Index > -1 then
begin
img := APageLayout.HeaderImages[sct];
AHeader := IntToStr(img.Index+1) + ExtractFileExt(FWorkbook.GetEmbeddedStream(img.Index).Name);
break;
end;
for sct in TsHeaderFooterSectionIndex do
if APageLayout.FooterImages[sct].Index > -1 then
begin
img := APageLayout.FooterImages[sct];
AFooter := IntToStr(img.Index+1) + ExtractFileExt(FWorkbook.GetEmbeddedStream(img.Index).Name);
break;
end;
end;
end;
procedure TsSpreadOpenDocWriter.GetHeaderFooterImagePosStr(
APagelayout: TsPageLayout; out AHeader, AFooter: String);
function GetPosStr(tags: String): String;
begin
if tags[1] in ['L', 'x'] then
Result := 'left' else
if tags[2] in ['C', 'x'] then
Result := 'center' else
if tags[3] in ['R', 'x'] then
Result := 'right'
else
Result := '';
end;
var
hdrTags, ftrTags: String;
begin
APageLayout.GetImageSections(hdrTags, ftrTags);
AHeader := GetPosStr(hdrTags);
AFooter := GetPosStr(ftrTags);
end;
procedure TsSpreadOpenDocWriter.InternalWriteToStream(AStream: TStream);
var
FZip: TZipper;
@ -4186,13 +4289,6 @@ begin
'</office:automatic-styles>');
end;
procedure TsSpreadOpenDocWriter.WriteMimetype;
begin
AppendToStream(FSMimeType,
'application/vnd.oasis.opendocument.spreadsheet'
);
end;
procedure TsSpreadOpenDocWriter.WriteMetaInfManifest;
var
i: Integer;
@ -4242,6 +4338,13 @@ begin
'</office:document-meta>');
end;
procedure TsSpreadOpenDocWriter.WriteMimetype;
begin
AppendToStream(FSMimeType,
'application/vnd.oasis.opendocument.spreadsheet'
);
end;
procedure TsSpreadOpenDocWriter.ZipPictures(AZip: TZipper);
var
i: Integer;
@ -4322,6 +4425,7 @@ begin
'" xmlns:svg="' + SCHEMAS_XMLNS_SVG +
'" xmlns:table="' + SCHEMAS_XMLNS_TABLE +
'" xmlns:text="' + SCHEMAS_XMLNS_TEXT +
'" xmlns:xlink="' + SCHEMAS_XMLNS_XLINK +
'" xmlns:v="' + SCHEMAS_XMLNS_V + '">');
AppendToStream(FSStyles,
@ -4336,7 +4440,7 @@ begin
'<style:style style:name="Default" style:family="table-cell">',
WriteDefaultFontXMLAsString,
'</style:style>');
if FWorkbook.GetEmbeddedStreamCount > 0 then
if FWorkbook.HasEmbeddedSheetImages then
AppendToStream(FSStyles,
'<style:default-style style:family="graphic">',
WriteDefaultGraphicStyleXMLAsString,
@ -4788,23 +4892,44 @@ var
AStyleName, ADisplayName, APageLayoutName
]);
Result := Result +
if (APageLayout.Headers[1] <> '') then
Result := Result +
'<style:header>' +
HeaderFooterAsString(1, IS_HEADER, APageLayout) +
'</style:header>' +
'</style:header>'
else
Result := Result +
'<style:header style:display="false" />';
if (APageLayout.Footers[1] <> '') then
Result := Result +
'<style:footer>' +
HeaderFooterAsString(1, IS_FOOTER, APageLayout) +
'</style:footer>';
'</style:footer>'
else
Result := Result +
'<style:footer style:display="false" />';
if poDifferentOddEven in APageLayout.Options then
Result := Result +
'<style:header-left>' +
HeaderFooterAsString(2, IS_HEADER, APageLayout) +
'</style:header-left>' +
'<style:footer-left>' +
HeaderFooterAsString(2, IS_FOOTER, APageLayout) +
'</style:footer-left>';
begin
if (APageLayout.Headers[2] <> '') then
Result := Result +
'<style:header-left>' +
HeaderFooterAsString(2, IS_HEADER, APageLayout) +
'</style:header-left>'
else
Result := Result +
'<style:header-left style:display="false" />';
if (APageLayout.Footers[2] <> '') then
Result := Result +
'<style:footer-left>' +
HeaderFooterAsString(2, IS_FOOTER, APageLayout) +
'</style:footer-left>'
else
Result := Result +
'<style:footer-left display="false" />';
end;
Result := Result + '</style:master-page>';
end;
@ -5699,113 +5824,122 @@ end;
function TsSpreadOpenDocWriter.WritePageLayoutAsXMLString(AStyleName: String;
const APageLayout: TsPageLayout): String;
var
pageLayoutStr: String;
headerStyleStr: String;
footerStyleStr: String;
options: String;
i: Integer;
hasHeader, hasFooter: Boolean;
topmargin, bottommargin: Double;
h: Double;
begin
hasHeader := false;
hasFooter := false;
for i:=0 to 2 do
function CalcPageLayoutPropStr: String;
var
topmargin, bottommargin: Double;
options: String;
begin
if APageLayout.Headers[i] <> '' then hasHeader := true;
if APageLayout.Footers[i] <> '' then hasFooter := true;
topMargin := IfThen(APageLayout.HasHeader,
APageLayout.HeaderMargin, APageLayout.TopMargin);
bottomMargin := IfThen(APageLayout.HasFooter,
APageLayout.FooterMargin, APageLayout.BottomMargin);
Result := Format(
'fo:page-width="%.2fmm" fo:page-height="%.2fmm" '+
'fo:margin-top="%.2fmm" fo:margin-bottom="%.2fmm" '+
'fo:margin-left="%.2fmm" fo:margin-right="%.2fmm" ', [
APageLayout.PageWidth, APageLayout.PageHeight,
topmargin, bottommargin,
APageLayout.LeftMargin, APageLayout.RightMargin
], FPointSeparatorSettings);
if APageLayout.Orientation = spoLandscape then
Result := Result + 'style:print-orientation="landscape" ';
if poPrintPagesByRows in APageLayout.Options then
Result := Result + 'style:print-page-order="ltr" ';
if poUseStartPageNumber in APageLayout.Options then
Result := Result + 'style:first-page-number="' + IntToStr(APageLayout.StartPageNumber) +'" '
else
Result := Result + 'style:first-page-number="continue" ';
if APageLayout.Options * [poHorCentered, poVertCentered] = [poHorCentered, poVertCentered] then
Result := Result + 'style:table-centering="both" '
else if poHorCentered in APageLayout.Options then
Result := Result + 'style:table-centering="horizontal" '
else if poVertCentered in APageLayout.Options then
Result := Result + 'style:table-centering="vertical" ';
if poFitPages in APageLayout.Options then
begin
if APageLayout.FitWidthToPages > 0 then
Result := Result + 'style:scale-to-X="' + IntToStr(APageLayout.FitWidthToPages) + '" ';
if APageLayout.FitHeightToPages > 0 then
Result := Result + 'style:scale-to-Y="' + IntToStr(APageLayout.FitHeightToPages) + '" ';
end else
Result := Result + 'style:scale-to="' + IntToStr(APageLayout.ScalingFactor) + '%" ';
options := 'charts drawings objects zero-values';
if poPrintGridLines in APageLayout.Options then
options := options + ' grid';
if poPrintHeaders in APageLayout.Options then
options := options + ' headers';
if poPrintCellComments in APageLayout.Options then
options := options + ' annotations';
Result := Result + 'style:print="' + options + '" ';
end;
if hasHeader then
topMargin := APageLayout.HeaderMargin
else
topMargin := APageLayout.TopMargin;
if hasFooter then
bottomMargin := APageLayout.FooterMargin
else
bottomMargin := APageLayout.BottomMargin;
pageLayoutStr := Format(
'fo:page-width="%.2fmm" fo:page-height="%.2fmm" '+
'fo:margin-top="%.2fmm" fo:margin-bottom="%.2fmm" '+
'fo:margin-left="%.2fmm" fo:margin-right="%.2fmm" ', [
APageLayout.PageWidth, APageLayout.PageHeight,
topmargin, bottommargin,
APageLayout.LeftMargin, APageLayout.RightMargin
], FPointSeparatorSettings);
if APageLayout.Orientation = spoLandscape then
pageLayoutStr := pageLayoutStr + 'style:print-orientation="landscape" ';
if poPrintPagesByRows in APageLayout.Options then
pageLayoutStr := pageLayoutStr + 'style:print-page-order="ltr" ';
if poUseStartPageNumber in APageLayout.Options then
pageLayoutStr := pageLayoutStr + 'style:first-page-number="' + IntToStr(APageLayout.StartPageNumber) +'" '
else
pageLayoutStr := pageLayoutStr + 'style:first-page-number="continue" ';
if APageLayout.Options * [poHorCentered, poVertCentered] = [poHorCentered, poVertCentered] then
pageLayoutStr := pageLayoutStr + 'style:table-centering="both" '
else if poHorCentered in APageLayout.Options then
pageLayoutStr := pageLayoutStr + 'style:table-centering="horizontal" '
else if poVertCentered in APageLayout.Options then
pageLayoutStr := pageLayoutStr + 'style:table-centering="vertical" ';
if poFitPages in APageLayout.Options then
function CalcStyleStr(AName, AHeaderFooterImageStr: String;
APageMargin, AHeaderFooterMargin: Double): String;
var
h: Double;
marginKind: String;
begin
if APageLayout.FitWidthToPages > 0 then
pageLayoutStr := pageLayoutStr + 'style:scale-to-X="' + IntToStr(APageLayout.FitWidthToPages) + '" ';
if APageLayout.FitHeightToPages > 0 then
pageLayoutStr := pageLayoutStr + 'style:scale-to-Y="' + IntToStr(APageLayout.FitHeightToPages) + '" ';
end else
pageLayoutStr := pageLayoutStr + 'style:scale-to="' + IntToStr(APageLayout.ScalingFactor) + '%" ';
options := 'charts drawings objects zero-values';
if poPrintGridLines in APageLayout.Options then
options := options + ' grid';
if poPrintHeaders in APageLayout.Options then
options := options + ' headers';
if poPrintCellComments in APageLayout.Options then
options := options + ' annotations';
pageLayoutStr := pageLayoutStr + 'style:print="' + options + '" ';
h := PtsToMM(FWorkbook.GetDefaultFontSize);
if hasHeader then
headerStyleStr := Format(
'<style:header-style>'+
h := PtsToMM(FWorkbook.GetDefaultFontSize);
if AName = 'header' then marginKind := 'bottom' else marginKind := 'top';
Result := Format(
'<style:%s-style>' + // e.g. <style:header-style>
'<style:header-footer-properties ' +
'fo:margin-left="0mm" fo:margin-right="0mm" '+
'fo:min-height="%.2fmm" fo:margin-bottom="%.2fmm" '+
'/>'+
'</style:header-style>', [
APageLayout.TopMargin - APageLayout.HeaderMargin,
APageLayout.TopMargin - APageLayout.HeaderMargin - h], FPointSeparatorSettings)
else
headerStyleStr := '';
// 'fo:min-height="%.2fmm" fo:margin-%s="%.2fmm" ' + // margin-bottom or -top
'svg:height="%.2fmm" fo:margin-%s="%.2fmm" ' +
'fo:background-color="transparent">' +
'%s' +
'</style:header-footer-properties>' +
'</style:%s-style>', [
AName,
APageMargin - AHeaderFooterMargin, marginKind, 0.0, // - h, marginKind, h,
// AHeaderFooterMargin, marginKind, APageMargin-AHeaderFooterMargin-h,
// AHeaderFooterMargin-APageMargin-h, marginKind, AHeaderFooterMargin-APageMargin,
AHeaderFooterImageStr,
AName
], FPointSeparatorSettings);
end;
if hasFooter then
footerStyleStr := Format(
'<style:footer-style>'+
'<style:header-footer-properties ' +
'fo:margin-left="0mm" fo:margin-right="0mm" '+
'fo:min-height="%.2fmm" fo:margin-top="%.2fmm" '+
'/>'+
'</style:footer-style>', [
APageLayout.BottomMargin - APageLayout.FooterMargin,
APageLayout.BottomMargin - APageLayout.FooterMargin - h], FPointSeparatorSettings)
else
footerStyleStr := '';
procedure CalcHeaderFooterImageStr(out AHeaderImageStr, AFooterImageStr: String);
var
hdrImg, ftrImg, hdrImgPos, ftrImgPos: String;
begin
GetHeaderFooterImageName(APageLayout, hdrImg, ftrImg);
GetHeaderFooterImagePosStr(APageLayout, hdrImgPos, ftrImgPos);
Result := '<style:page-layout style:name="' + AStyleName + '">' +
'<style:page-layout-properties ' + pageLayoutStr + '/>'+
headerStyleStr +
footerStyleStr +
'</style:page-layout>';
AHeaderImageStr := IfThen((hdrImg = '') or (hdrImgPos = ''), '', Format(
'<style:background-image xlink:href="Pictures/%s" '+
'xlink:type="simple" xlink:actuate="onLoad" '+
'style:position="top %s" style:repeat="no-repeat" />',
[hdrImg, hdrImgPos] ));
AFooterImageStr := IfThen((ftrImg = '') or (ftrImgPos = ''), '', Format(
'<style:background-image xlink:href="Pictures/%s" '+
'xlink:type="simple" xlink:actuate="onLoad" '+
'style:position="center %s" style:repeat="no-repeat" />',
[ftrImg, ftrImgPos]));
end;
var
hdrImgStr: String = '';
ftrImgStr: String = '';
begin
CalcHeaderFooterImageStr(hdrImgStr, ftrImgStr);
Result :=
'<style:page-layout style:name="' + AStyleName + '">' +
'<style:page-layout-properties ' + CalcPageLayoutPropStr + '/>'+
CalcStyleStr('header', hdrImgStr, APageLayout.TopMargin, APageLayout.HeaderMargin) +
CalcStyleStr('footer', ftrImgStr, APageLayout.BottomMargin, APageLayout.FooterMargin) +
'</style:page-layout>';
end;
function TsSpreadOpenDocWriter.WritePrintRangesAsXMLString(ASheet: TsWorksheet): String;

23
components/fpspreadsheet/fpspagelayout.pas
View File

@ -54,6 +54,9 @@ type
constructor Create(AWorksheet: pointer);
procedure Assign(ASource: TsPageLayout);
function HasFooter: Boolean;
function HasHeader: Boolean;
{ Images embedded in header and/or footer }
procedure AddHeaderImage(AHeaderIndex: Integer;
ASection: TsHeaderFooterSectionIndex; const AFilename: String);
@ -295,9 +298,9 @@ begin
book.GetEmbeddedStream(idx).LoadFromFile(AFileName);
end;
FFooterImages[ASection].Index := idx;
SplitHeaderFooterText(FHeaders[AFooterIndex], s[hfsLeft], s[hfsCenter], s[hfsRight]);
SplitHeaderFooterText(FFooters[AFooterIndex], s[hfsLeft], s[hfsCenter], s[hfsRight]);
s[ASection] := s[ASection] + '&G';
FHeaders[AFooterIndex] := JoinHeaderFooterText(s[hfsLeft], s[hfsCenter], s[hfsRight]);
FFooters[AFooterIndex] := JoinHeaderFooterText(s[hfsLeft], s[hfsCenter], s[hfsRight]);
end;
{@@ ----------------------------------------------------------------------------
@ -416,6 +419,22 @@ begin
raise Exception.Create('[TsPageLayout.GetPrintRange] Illegal index.');
end;
{@@ ----------------------------------------------------------------------------
Checks whether the footer of the worksheet is enabled
-------------------------------------------------------------------------------}
function TsPageLayout.HasFooter: Boolean;
begin
Result := (FFooters[0] <> '') or (FFooters[1] <> '') or (FFooters[2] <> '');
end;
{@@ ----------------------------------------------------------------------------
Checks whether the header of the worksheet is enabled
-------------------------------------------------------------------------------}
function TsPageLayout.HasHeader: Boolean;
begin
Result := (FHeaders[0] <> '') or (FHeaders[1] <> '') or (FHeaders[2] <> '');
end;
{@@ ----------------------------------------------------------------------------
Checks whether the header or footer of the worksheet contains embedded images
-------------------------------------------------------------------------------}

19
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -769,6 +769,7 @@ type
function FindEmbeddedStream(const AName: String): Integer;
function GetEmbeddedStream(AIndex: Integer): TsEmbeddedStream;
function GetEmbeddedStreamCount: Integer;
function HasEmbeddedSheetImages: Boolean;
procedure RemoveAllEmbeddedStreams;
{ Utilities }
@ -8391,6 +8392,24 @@ begin
Result := FEmbeddedStreamList.Count;
end;
{@@ ----------------------------------------------------------------------------
Returns true if there is at least one worksheet with an embedded images.
-------------------------------------------------------------------------------}
function TsWorkbook.HasEmbeddedSheetImages: Boolean;
var
i: Integer;
sheet: TsWorksheet;
begin
Result := true;
for i:=0 to FWorksheets.Count-1 do
begin
sheet := TsWorksheet(FWorksheets.Items[i]);
if sheet.GetImageCount > 0 then
exit;
end;
Result := false;
end;
{@@ ----------------------------------------------------------------------------
Removes all embedded streams
-------------------------------------------------------------------------------}

21
components/fpspreadsheet/xlsxooxml.pas
View File

@ -2665,24 +2665,11 @@ end;
procedure TsSpreadOOXMLWriter.WriteHeaderFooter(AStream: TStream;
AWorksheet: TsWorksheet);
var
hasHeader: Boolean;
hasFooter: Boolean;
i: Integer;
s: String;
begin
hasHeader := false;
hasFooter := false;
with AWorksheet.PageLayout do
begin
for i:=HEADER_FOOTER_INDEX_FIRST to HEADER_FOOTER_INDEX_EVEN do
begin
if Headers[i] <> '' then
hasHeader := true;
if Footers[i] <> '' then
hasFooter := true;
end;
if not (hasHeader or hasFooter) then
if not (HasHeader or HasFooter) then
exit;
s := '';
@ -3723,8 +3710,8 @@ begin
AppendToStream(FSVmlDrawingsRels[fileIndex], Format(
' <Relationship Id="rId%d" Target="../media/image%d%s" '+
'Type="' + SCHEMAS_IMAGE + '" />' + LineEnding, [
rId, // Id="rID1"
imgIdx + 1, ExtractFileExt(imgName) // Target="../media/image1.png"
rId, // Id="rID1"
imgIdx + 1, ExtractFileExt(imgName) // Target="../media/image1.png"
]));
inc(rId);
end;
@ -3741,7 +3728,7 @@ begin
// e.g. "rId1" "..(media/image1.png"
'Type="' + SCHEMAS_IMAGE + '" />', [
rId,
imgIdx, ExtractFileExt(imgName)
imgIdx + 1, ExtractFileExt(imgName)
]));
inc(rId);
end;