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

fpspreadsheet: Add headers and footers to the pagelayout record, implemented for all Excel formats (reading & writing).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4104 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-05-01 15:14:25 +00:00
parent 82117326a4
commit e66caefbe0
9 changed files with 402 additions and 151 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
components/fpspreadsheet/fpsopendocument.pas
View File

@ -877,6 +877,20 @@ begin
nodeName := node.NodeName;
if nodeName = 'style:page-layout-properties' then
begin
s := GetAttrValue(node, 'style:print-orientation');
if s = 'landscape' then
FPageLayout.Orientation := spoLandscape
else if s = 'portrait' then
FPageLayout.Orientation := spoPortrait;
s := GetAttrValue(node, 'fo:page-width');
if s <> '' then
FPageLayout.PageWidth := PtsToMM(HTMLLengthStrToPts(s));
s := GetAttrValue(node, 'fo:page-height');
if s <> '' then
FPageLayout.PageHeight := PtsToMM(HTMLLengthStrToPts(s));
s := GetAttrValue(node, 'fo:margin-top');
if s <> '' then
FPageLayout.TopMargin := PtsToMM(HTMLLengthStrToPts(s));

13
components/fpspreadsheet/fpspreadsheetctrls.pas
View File

@ -2923,6 +2923,19 @@ begin
AStrings.Add (' Start page number=automatic');
AStrings.Add(Format(' Scaling factor=%.0f%%', [ASheet.PageLayout.ScalingFactor]));
AStrings.Add(Format(' Copies=%d', [ASheet.PageLayout.Copies]));
if (ASheet.PageLayout.Options * [poDifferentOddEven, poDifferentFirst] <> []) then
begin
AStrings.Add(Format(' Header (first)=%s', [ASheet.PageLayout.Headers[0]]));
AStrings.Add(Format(' Header (odd)=%s', [ASheet.PageLayout.Headers[1]]));
AStrings.Add(Format(' Header (even)=%s', [ASheet.PageLayout.Headers[2]]));
AStrings.Add(Format(' Footer (first)=%s', [ASheet.PageLayout.Footers[0]]));
AStrings.Add(Format(' Footer (odd)=%s', [ASheet.PageLayout.Footers[1]]));
AStrings.Add(Format(' Footer (even)=%s', [ASheet.PageLayout.Footers[2]]));
end else
begin
AStrings.Add(Format(' Header=%s', [ASheet.PageLayout.Headers[1]]));
AStrings.Add(Format(' Footer=%s', [ASheet.PageLayout.Footers[1]]));
end;
s := '';
for po in TsPrintOption do
if po in ASheet.PageLayout.Options then s := s + '; ' + GetEnumName(typeInfo(TsPrintOption), ord(po));

39
components/fpspreadsheet/fpstypes.pas
View File

@ -668,20 +668,12 @@ type
cctError : (ErrorValue: TsErrorValue);
end;
{
TsPaperSize = (psUndefined, psLetter, psLetterSmall, psTabloid, psLedger,
psLegal, psStatement, psExecutive, psA3, psA4, psA4small, psA5, psB4, psB5,
psFolie, psQuarto, ps10x14, ps11x17, psNote, psEnvelope9, psEnvelope10,
psEnvelope11, psEnvelope12, psEnvelope14, psC, psD, psE, psEnvelopeDL,
psEnvelopeC5, psEnvelopeC3, psEnvelopeC4, psEnvelopeC6, psEnvelopeC6C5,
psB4ISO, psB5ISO, psB6ISO,
}
TsPageOrientation = (spoPortrait, spoLandscape);
TsPrintOption = (poPrintGridLines, poPrintHeaders, poPrintPagesByRows,
poMonochrome, poDraftQuality, poPrintCellComments, poDefaultOrientation,
poUseStartPageNumber, poCommentsAtEnd, poHorCentered, poVertCentered);
poUseStartPageNumber, poCommentsAtEnd, poHorCentered, poVertCentered,
poDifferentOddEven, poDifferentFirst);
TsPrintOptions = set of TsPrintOption;
@ -701,8 +693,35 @@ type
FitHeightToPages: Integer;
Copies: Integer;
Options: TsPrintOptions;
{ Headers and footers are in Excel syntax:
- left/center/right sections begin with &L / &C / &R
- page number: &P
- page count: &N
- current date: &D
- current time: &T
- sheet name: &A
- file name without path: &F
- file path without file name: &Z
- bold/italic/underlining/double underlining/strike out/shadowed/
outlined/superscript/subscript on/off:
&B / &I / &U / &E / &S / &H
&O / &X / &Y
There can be three headers/footers, for first ([0]) page and
odd ([1])/even ([2]) page numbers.
This is activated by Options poDifferentOddEven and poDifferentFirst.
Array index 1 contains the strings if these options are not used. }
Headers: array[0..2] of string;
Footers: array[0..2] of string;
end;
const
{@@ Indexes to be used for the various headers and footers }
HEADER_FOOTER_INDEX_FIRST = 0;
HEADER_FOOTER_INDEX_ODD = 1;
HEADER_FOOTER_INDEX_EVEN = 2;
HEADER_FOOTER_INDEX_ODDEVEN = 1;
HEADER_FOOTER_INDEX_ALL = 1;
function BuildFormatStringFromSection(const ASection: TsNumFormatSection): String;

4
components/fpspreadsheet/fpsutils.pas
View File

@ -2408,6 +2408,8 @@ end;
Initializes the fields of a TsPageLayout record
-------------------------------------------------------------------------------}
procedure InitPageLayout(out APageLayout: TsPageLayout);
var
i: Integer;
begin
with APageLayout do begin
Orientation := spoPortrait;
@ -2425,6 +2427,8 @@ begin
FitHeightToPages := 0;
Copies := 1;
Options := [];
for i:=0 to 2 do Headers[i] := '';
for i:=0 to 2 do Footers[i] := '';
end;
end;

23
components/fpspreadsheet/xlsbiff2.pas
View File

@ -457,28 +457,30 @@ begin
INT_EXCEL_ID_BLANK : ReadBlank(AStream);
INT_EXCEL_ID_BOF : ;
INT_EXCEL_ID_BOOLERROR : ReadBool(AStream);
INT_EXCEL_ID_BOTTOMMARGIN: ReadBottomMargin(AStream);
INT_EXCEL_ID_BOTTOMMARGIN: ReadMargin(AStream, 3);
INT_EXCEL_ID_CODEPAGE : ReadCodePage(AStream);
INT_EXCEL_ID_COLWIDTH : ReadColWidth(AStream);
INT_EXCEL_ID_DEFCOLWIDTH : ReadDefColWidth(AStream);
INT_EXCEL_ID_EOF : BIFF2EOF := True;
INT_EXCEL_ID_FONT : ReadFont(AStream);
INT_EXCEL_ID_FONTCOLOR : ReadFontColor(AStream);
INT_EXCEL_ID_FOOTER : ReadHeaderFooter(AStream, false);
INT_EXCEL_ID_FORMAT : ReadFormat(AStream);
INT_EXCEL_ID_FORMULA : ReadFormula(AStream);
INT_EXCEL_ID_HEADER : ReadHeaderFooter(AStream, true);
INT_EXCEL_ID_INTEGER : ReadInteger(AStream);
INT_EXCEL_ID_IXFE : ReadIXFE(AStream);
INT_EXCEL_ID_LABEL : ReadLabel(AStream);
INT_EXCEL_ID_LEFTMARGIN : ReadLeftMargin(AStream);
INT_EXCEL_ID_LEFTMARGIN : ReadMargin(AStream, 0);
INT_EXCEL_ID_NOTE : ReadComment(AStream);
INT_EXCEL_ID_NUMBER : ReadNumber(AStream);
INT_EXCEL_ID_PANE : ReadPane(AStream);
INT_EXCEL_ID_PRINTGRID : ReadPrintGridLines(AStream);
INT_EXCEL_ID_PRINTHEADERS: ReadPrintHeaders(AStream);
INT_EXCEL_ID_RIGHTMARGIN : ReadRightMargin(AStream);
INT_EXCEL_ID_RIGHTMARGIN : ReadMargin(AStream, 1);
INT_EXCEL_ID_ROW : ReadRowInfo(AStream);
INT_EXCEL_ID_STRING : ReadStringRecord(AStream);
INT_EXCEL_ID_TOPMARGIN : ReadTopMargin(AStream);
INT_EXCEL_ID_TOPMARGIN : ReadMargin(AStream, 2);
INT_EXCEL_ID_DEFROWHEIGHT: ReadDefRowHeight(AStream);
INT_EXCEL_ID_WINDOW2 : ReadWindow2(AStream);
INT_EXCEL_ID_XF : ReadXF(AStream);
@ -1241,11 +1243,12 @@ begin
WriteFonts(AStream);
// Page settings block
WriteLeftMargin(AStream);
WriteRightMargin(AStream);
WriteTopMargin(AStream);
WriteBottomMargin(AStream);
// WritePageSetup(AStream); // does not exist in BIFF2
WriteHeaderFooter(AStream, true); // true = header
WriteHeaderFooter(AStream, false); // false = footer
WriteMargin(AStream, 0); // 0 = left margin
WriteMargin(AStream, 1); // 1 = right margin
WriteMargin(AStream, 2); // 2 = top margin
WriteMargin(AStream, 3); // 3 = bottom margin
WriteFormatCount(AStream);
WriteNumFormats(AStream);
@ -1264,7 +1267,7 @@ begin
WriteWindow1(AStream);
// { -- currently not working
WriteWindow2(AStream, FWorksheet);
WritePane(AStream, FWorksheet, false, pane); // false for "is not BIFF5 or BIFF8"
WritePane(AStream, FWorksheet, false, pane); // false = "is not BIFF5 or BIFF8"
WriteSelections(AStream, FWorksheet);
//}
WriteEOF(AStream);

20
components/fpspreadsheet/xlsbiff5.pas
View File

@ -392,14 +392,16 @@ begin
INT_EXCEL_ID_BLANK : ReadBlank(AStream);
INT_EXCEL_ID_BOF : ;
INT_EXCEL_ID_BOOLERROR : ReadBool(AStream);
INT_EXCEL_ID_BOTTOMMARGIN : ReadBottomMargin(AStream);
INT_EXCEL_ID_BOTTOMMARGIN : ReadMargin(AStream, 3);
INT_EXCEL_ID_COLINFO : ReadColInfo(AStream);
INT_EXCEL_ID_DEFCOLWIDTH : ReadDefColWidth(AStream);
INT_EXCEL_ID_EOF : SectionEOF := True;
INT_EXCEL_ID_FOOTER : ReadHeaderFooter(AStream, false);
INT_EXCEL_ID_FORMULA : ReadFormula(AStream);
INT_EXCEL_ID_HEADER : ReadHeaderFooter(AStream, true);
INT_EXCEL_ID_HCENTER : ReadHCENTER(AStream);
INT_EXCEL_ID_LABEL : ReadLabel(AStream);
INT_EXCEL_ID_LEFTMARGIN : ReadLeftMargin(AStream);
INT_EXCEL_ID_LEFTMARGIN : ReadMargin(AStream, 0);
INT_EXCEL_ID_MULBLANK : ReadMulBlank(AStream);
INT_EXCEL_ID_MULRK : ReadMulRKValues(AStream);
INT_EXCEL_ID_NOTE : ReadComment(AStream);
@ -408,13 +410,13 @@ begin
INT_EXCEL_ID_PAGESETUP : ReadPageSetup(AStream);
INT_EXCEL_ID_PRINTGRID : ReadPrintGridLines(AStream);
INT_EXCEL_ID_PRINTHEADERS : ReadPrintHeaders(AStream);
INT_EXCEL_ID_RIGHTMARGIN : ReadRightMargin(AStream);
INT_EXCEL_ID_RIGHTMARGIN : ReadMargin(AStream, 1);
INT_EXCEL_ID_RK : ReadRKValue(AStream); //(RK) This record represents a cell that contains an RK value (encoded integer or floating-point value). If a floating-point value cannot be encoded to an RK value, a NUMBER record will be written. This record replaces the record INTEGER written in BIFF2.
INT_EXCEL_ID_ROW : ReadRowInfo(AStream);
INT_EXCEL_ID_RSTRING : ReadRichString(AStream); //(RSTRING) This record stores a formatted text cell (Rich-Text). In BIFF8 it is usually replaced by the LABELSST record. Excel still uses this record, if it copies formatted text cells to the clipboard.
INT_EXCEL_ID_SHAREDFMLA : ReadSharedFormula(AStream);
INT_EXCEL_ID_STANDARDWIDTH : ReadStandardWidth(AStream, FWorksheet);
INT_EXCEL_ID_TOPMARGIN : ReadTopMargin(AStream);
INT_EXCEL_ID_TOPMARGIN : ReadMargin(AStream, 2);
INT_EXCEL_ID_STRING : ReadStringRecord(AStream);
INT_EXCEL_ID_VCENTER : ReadVCENTER(AStream);
INT_EXCEL_ID_WINDOW2 : ReadWindow2(AStream);
@ -1044,12 +1046,14 @@ begin
WritePrintGridLines(AStream);
// Page settings block
WriteHeaderFooter(AStream, true);
WriteHeaderFooter(AStream, false);
WriteHCenter(AStream);
WriteVCenter(AStream);
WriteLeftMargin(AStream);
WriteRightMargin(AStream);
WriteTopMargin(AStream);
WriteBottomMargin(AStream);
WriteMargin(AStream, 0); // 0 = left margin
WriteMargin(AStream, 1); // 1 = right margin
WriteMargin(AStream, 2); // 2 = top margin
WriteMargin(AStream, 3); // 3 = bottom margin
WritePageSetup(AStream);
WriteColInfos(AStream, FWorksheet);

88
components/fpspreadsheet/xlsbiff8.pas
View File

@ -87,6 +87,7 @@ type
procedure ReadCONTINUE(const AStream: TStream);
procedure ReadFONT(const AStream: TStream);
procedure ReadFORMAT(AStream: TStream); override;
procedure ReadHeaderFooter(AStream: TStream; AIsHeader: Boolean); override;
procedure ReadHyperLink(AStream: TStream);
procedure ReadHyperlinkToolTip(AStream: TStream);
procedure ReadLABEL(AStream: TStream); override;
@ -130,12 +131,13 @@ type
procedure WriteEOF(AStream: TStream);
procedure WriteFont(AStream: TStream; AFont: TsFont);
procedure WriteFonts(AStream: TStream);
procedure WriteIndex(AStream: TStream);
procedure WriteHeaderFooter(AStream: TStream; AIsHeader: Boolean); override;
procedure WriteHyperlink(AStream: TStream; AHyperlink: PsHyperlink;
AWorksheet: TsWorksheet);
procedure WriteHyperlinks(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteHyperlinkToolTip(AStream: TStream; const ARow, ACol: Cardinal;
const ATooltip: String);
procedure WriteIndex(AStream: TStream);
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override;
procedure WriteMergedCells(AStream: TStream; AWorksheet: TsWorksheet);
@ -679,18 +681,20 @@ begin
INT_EXCEL_ID_BLANK : ReadBlank(AStream);
INT_EXCEL_ID_BOF : ;
INT_EXCEL_ID_BOOLERROR : ReadBool(AStream);
INT_EXCEL_ID_BOTTOMMARGIN : ReadBottomMargin(AStream);
INT_EXCEL_ID_BOTTOMMARGIN : ReadMargin(AStream, 3);
INT_EXCEL_ID_COLINFO : ReadColInfo(AStream);
INT_EXCEL_ID_CONTINUE : ReadCONTINUE(AStream);
INT_EXCEL_ID_DEFCOLWIDTH : ReadDefColWidth(AStream);
INT_EXCEL_ID_EOF : SectionEOF := True;
INT_EXCEL_ID_FOOTER : ReadHeaderFooter(AStream, false);
INT_EXCEL_ID_FORMULA : ReadFormula(AStream);
INT_EXCEL_ID_HCENTER : ReadHCENTER(AStream);
INT_EXCEL_ID_HEADER : ReadHeaderFooter(AStream, true);
INT_EXCEL_ID_HLINKTOOLTIP : ReadHyperlinkToolTip(AStream);
INT_EXCEL_ID_HYPERLINK : ReadHyperlink(AStream);
INT_EXCEL_ID_LABEL : ReadLabel(AStream);
INT_EXCEL_ID_LABELSST : ReadLabelSST(AStream);
INT_EXCEL_ID_LEFTMARGIN : ReadLeftMargin(AStream);
INT_EXCEL_ID_LEFTMARGIN : ReadMargin(AStream, 0);
INT_EXCEL_ID_MERGEDCELLS : ReadMergedCells(AStream);
INT_EXCEL_ID_MULBLANK : ReadMulBlank(AStream);
INT_EXCEL_ID_MULRK : ReadMulRKValues(AStream);
@ -701,7 +705,7 @@ begin
INT_EXCEL_ID_PANE : ReadPane(AStream);
INT_EXCEL_ID_PRINTGRID : ReadPrintGridLines(AStream);
INT_EXCEL_ID_PRINTHEADERS : ReadPrintHeaders(AStream);
INT_EXCEL_ID_RIGHTMARGIN : ReadRightMargin(AStream);
INT_EXCEL_ID_RIGHTMARGIN : ReadMargin(AStream, 1);
INT_EXCEL_ID_ROW : ReadRowInfo(AStream);
//(RSTRING) This record stores a formatted text cell (Rich-Text).
@ -717,7 +721,7 @@ begin
INT_EXCEL_ID_SHAREDFMLA : ReadSharedFormula(AStream);
INT_EXCEL_ID_STRING : ReadStringRecord(AStream);
INT_EXCEL_ID_TOPMARGIN : ReadTopMargin(AStream);
INT_EXCEL_ID_TOPMARGIN : ReadMargin(AStream, 2);
INT_EXCEL_ID_TXO : ReadTXO(AStream);
INT_EXCEL_ID_VCENTER : ReadVCENTER(AStream);
INT_EXCEL_ID_WINDOW2 : ReadWindow2(AStream);
@ -1444,6 +1448,30 @@ begin
NumFormatList[fmtIndex] := fmtString;
end;
{@@ ----------------------------------------------------------------------------
Reads the header/footer to be used for printing.
Overriden for BIFF8 because of wide strings
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Reader.ReadHeaderFooter(AStream: TStream;
AIsHeader: Boolean);
var
s: widestring;
len: word;
begin
if RecordSize = 0 then
exit;
len := WordLEToN(AStream.ReadWord);
s := ReadWideString(AStream, len);
if AIsHeader then
FWorksheet.PageLayout.Headers[1] := UTF8Encode(s)
else
FWOrksheet.PageLayout.Footers[1] := UTF8Encode(s);
{ Options poDifferentFirst and poDifferentOddEvent are not used, BIFF supports
only common headers/footers }
end;
{@@ ----------------------------------------------------------------------------
Reads a HYPERLINK record
-------------------------------------------------------------------------------}
@ -1725,12 +1753,14 @@ begin
//WriteSheetPR(AStream);
// Page setting block
WriteHeaderFooter(AStream, true);
WriteHeaderFooter(AStream, false);
WriteHCenter(AStream);
WriteVCenter(AStream);
WriteLeftMargin(AStream);
WriteRightMargin(AStream);
WriteTopMargin(AStream);
WriteBottomMargin(AStream);
WriteMargin(AStream, 0); // 0 = left margin
WriteMargin(AStream, 1); // 1 = right margin
WriteMargin(AStream, 2); // 2 = top margin
WriteMargin(AStream, 3); // 3 = bottom margin
WritePageSetup(AStream);
WriteColInfos(AStream, FWorksheet);
@ -2384,6 +2414,46 @@ begin
{ OBS: It seems to be no problem just ignoring this part of the record }
end;
{@@ ----------------------------------------------------------------------------
Writes an Excel 8 HEADER or FOOTER record, depending on AIsHeader.
Overridden because of wide string
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteHeaderFooter(AStream: TStream;
AIsHeader: Boolean);
var
wideStr: WideString;
len: Integer;
id: Word;
begin
with FWorksheet.PageLayout do
if AIsHeader then
begin
if (Headers[HEADER_FOOTER_INDEX_ALL] = '') then
exit;
wideStr := UTF8Decode(Headers[HEADER_FOOTER_INDEX_ALL]);
id := INT_EXCEL_ID_HEADER;
end else
begin
if (Footers[HEADER_FOOTER_INDEX_ALL] = '') then
exit;
wideStr := UTF8Decode(Footers[HEADER_FOOTER_INDEX_ALL]);
id := INT_EXCEL_ID_FOOTER;
end;
len := Length(wideStr);
{ BIFF record header }
WriteBiffHeader(AStream, id, 3 + len*sizeOf(wideChar));
{ 16-bit string length }
AStream.WriteWord(WordToLE(len));
{ Widestring flags, 1=regular unicode LE string }
AStream.WriteByte(1);
{ Characters }
AStream.WriteBuffer(WideStringToLE(wideStr)[1], len * SizeOf(WideChar));
end;
{@@ ----------------------------------------------------------------------------
Writes an Excel 8 HYPERLINK record
-------------------------------------------------------------------------------}

195
components/fpspreadsheet/xlscommon.pas
View File

@ -17,6 +17,8 @@ uses
const
{ RECORD IDs which didn't change across versions 2-8 }
INT_EXCEL_ID_EOF = $000A;
INT_EXCEL_ID_HEADER = $0014;
INT_EXCEL_ID_FOOTER = $0015;
INT_EXCEL_ID_NOTE = $001C;
INT_EXCEL_ID_SELECTION = $001D;
INT_EXCEL_ID_DATEMODE = $0022;
@ -365,7 +367,6 @@ type
// Read a blank cell
procedure ReadBlank(AStream: TStream); override;
procedure ReadBool(AStream: TStream); override;
procedure ReadBottomMargin(AStream: TStream);
procedure ReadCodePage(AStream: TStream);
// Read column info
procedure ReadColInfo(const AStream: TStream);
@ -382,7 +383,8 @@ type
// Read FORMULA record
procedure ReadFormula(AStream: TStream); override;
procedure ReadHCENTER(AStream: TStream);
procedure ReadLeftMargin(AStream: TStream);
procedure ReadHeaderFooter(AStream: TStream; AIsHeader: Boolean); virtual;
procedure ReadMargin(AStream: TStream; AMargin: Integer);
// Read multiple blank cells
procedure ReadMulBlank(AStream: TStream);
// Read multiple RK cells
@ -397,7 +399,6 @@ type
procedure ReadPane(AStream: TStream);
procedure ReadPrintGridLines(AStream: TStream);
procedure ReadPrintHeaders(AStream: TStream);
procedure ReadRightMargin(AStream: TStream);
// Read an RK value cell
procedure ReadRKValue(AStream: TStream);
// Read the row, column, and XF index at the current stream position
@ -420,7 +421,6 @@ type
ASharedFormulaBase: PCell = nil): Boolean;
function ReadRPNTokenArraySize(AStream: TStream): word; virtual;
procedure ReadSharedFormula(AStream: TStream);
procedure ReadTopMargin(AStream: TStream);
// Helper function for reading a string with 8-bit length
function ReadString_8bitLen(AStream: TStream): String; virtual;
@ -460,8 +460,6 @@ type
// Write out BOOLEAN cell record
procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: Boolean; ACell: PCell); override;
// Writes out bottom page margin for printing
procedure WriteBottomMargin(AStream: TStream);
// Writes out used codepage for character encoding
procedure WriteCodePage(AStream: TStream; ACodePage: String); virtual;
// Writes out column info(s)
@ -481,8 +479,9 @@ type
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override;
procedure WriteHCenter(AStream: TStream);
// Writes out left page margin for printing
procedure WriteLeftMargin(AStream: TStream);
procedure WriteHeaderFooter(AStream: TStream; AIsHeader: Boolean); virtual;
// Writes out page margin for printing
procedure WriteMARGIN(AStream: TStream; AMargin: Integer);
// Writes out a FORMAT record
procedure WriteNumFormat(AStream: TStream; ANumFormatStr: String;
ANumFormatIndex: Integer); virtual;
@ -500,8 +499,6 @@ type
// Writes out whether grid lines are printed
procedure WritePrintGridLines(AStream: TStream);
procedure WritePrintHeaders(AStream: TStream);
// Writes out right page margin for printing
procedure WriteRightMargin(AStream: TStream);
// Writes out a ROW record
procedure WriteRow(AStream: TStream; ASheet: TsWorksheet;
ARowIndex, AFirstColIndex, ALastColIndex: Cardinal; ARow: PRow); virtual;
@ -537,8 +534,6 @@ type
*)
procedure WriteSheetPR(AStream: TStream);
procedure WriteStringRecord(AStream: TStream; AString: String); virtual;
// Writes out the top page margin used when printing
procedure WriteTopMargin(AStream: TStream);
procedure WriteVCenter(AStream: TStream);
// Writes cell content received by workbook in OnNeedCellData event
procedure WriteVirtualCells(AStream: TStream);
@ -978,18 +973,6 @@ begin
Workbook.OnReadCellData(Workbook, r, c, cell);
end;
{@@ ----------------------------------------------------------------------------
Reads the bottom page margin of the current worksheet (for printing).
The file value is in inches.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFReader.ReadBottomMargin(AStream: TStream);
var
dbl: Double;
begin
AStream.ReadBuffer(dbl, SizeOf(dbl));
FWorksheet.PageLayout.BottomMargin := InToMM(dbl);
end;
{@@ ----------------------------------------------------------------------------
Reads the code page used in the xls file
In BIFF8 it seams to always use the UTF-16 codepage
@ -1291,17 +1274,50 @@ begin
if w = 1 then Include(FWorksheet.PageLayout.Options, poHorCentered);
end;
{@@ ----------------------------------------------------------------------------
Reads the header/footer to be used for printing.
Valid for BIFF2-BIFF5, override for BIFF8
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFReader.ReadHeaderFooter(AStream: TStream;
AIsHeader: Boolean);
var
s: ansistring;
len: Byte;
begin
if RecordSize = 0 then
exit;
Len := AStream.ReadByte;
SetLength(s, len*SizeOf(ansichar));
AStream.ReadBuffer(s[1], len*SizeOf(ansichar));
if AIsHeader then
begin
FWorksheet.PageLayout.Headers[1] := ConvertEncoding(s, FCodePage, 'utf8');
FWorksheet.PageLayout.Headers[2] := '';
end else
begin
FWorksheet.PageLayout.Footers[1] := ConvertEncoding(s, FCodePage, 'utf8');
FWorksheet.PageLayout.Footers[2] := '';
end;
Exclude(FWorksheet.PageLayout.Options, poDifferentOddEven);
end;
{@@ ----------------------------------------------------------------------------
Reads the left page margin of the current worksheet (for printing).
Reads a page margin of the current worksheet (for printing). The margin is
identified by the parameter "AMargin" (0=left, 1=right, 2=top, 3=bottom)
The file value is in inches.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFReader.ReadLeftMargin(AStream: TStream);
procedure TsSpreadBIFFReader.ReadMargin(AStream: TStream; AMargin: Integer);
var
dbl: Double;
begin
AStream.ReadBuffer(dbl, SizeOf(dbl));
FWorksheet.PageLayout.LeftMargin := InToMM(dbl);
case AMargin of
0: FWorksheet.PageLayout.LeftMargin := InToMM(dbl);
1: FWorksheet.PageLayout.RightMargin := InToMM(dbl);
2: FWorksheet.PageLayout.TopMargin := InToMM(dbl);
3: FWorksheet.PageLayout.BottomMargin := InToMM(dbl);
end;
end;
{@@ ----------------------------------------------------------------------------
@ -1589,18 +1605,6 @@ begin
AXF := WordLEtoN(AStream.ReadWord);
end;
{@@ ----------------------------------------------------------------------------
Reads the right page margin of the current worksheet (for printing).
The file value is in inches.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFReader.ReadRightMargin(AStream: TStream);
var
dbl: Double;
begin
AStream.ReadBuffer(dbl, SizeOf(dbl));
FWorksheet.PageLayout.RightMargin := InToMM(dbl);
end;
{@@ ----------------------------------------------------------------------------
Reads an RK value cell from the stream
Valid since BIFF3.
@ -2064,18 +2068,6 @@ begin
Unused(AStream);
end;
{@@ ----------------------------------------------------------------------------
Reads the top page margin of the current worksheet (for printing).
The file value is in inches.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFReader.ReadTopMargin(AStream: TStream);
var
dbl: Double;
begin
AStream.ReadBuffer(dbl, SizeOf(dbl));
FWorksheet.PageLayout.TopMargin := InToMM(dbl);
end;
{@@ ----------------------------------------------------------------------------
Reads whether the page is to be centered vertically for printing
-------------------------------------------------------------------------------}
@ -2298,21 +2290,6 @@ begin
AStream.WriteBuffer(rec, SizeOf(rec));
end;
{@@ ----------------------------------------------------------------------------
Write the bottom margin of the printed page (in inches)
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFWriter.WriteBottomMargin(AStream: TStream);
var
dbl: double;
begin
{ BIFF record header }
WriteBIFFHeader(AStream, INT_EXCEL_ID_BOTTOMMARGIN, SizeOf(Double));
{ Page margin value, written in inches }
dbl := mmToIn(FWorksheet.PageLayout.BottomMargin);
AStream.WriteBuffer(dbl, SizeOf(dbl));
end;
{@@ ----------------------------------------------------------------------------
Writes the code page identifier defined by the workbook to the stream.
BIFF2 has to be overridden because is uses cp1252, but has a different
@ -2536,17 +2513,26 @@ begin
end;
{@@ ----------------------------------------------------------------------------
Write the left margin of the printed page (in inches)
Writes the a margin record for printing (margin is in inches).
The margin is identified by the parameter AMargin:
0=left, 1=right, 2=top, 3=bottom
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFWriter.WriteLeftMargin(AStream: TStream);
procedure TsSpreadBIFFWriter.WriteMargin(AStream: TStream; AMargin: Integer);
var
dbl: double;
begin
{ BIFF record header }
WriteBIFFHeader(AStream, INT_EXCEL_ID_LEFTMARGIN, SizeOf(Double));
WriteBIFFHeader(AStream, INT_EXCEL_ID_LEFTMARGIN + AMargin, SizeOf(Double));
// the MARGIN IDs are consecutive beginning with the one for left margin
{ Page margin value, written in inches }
dbl := mmToIn(FWorksheet.PageLayout.LeftMargin);
case AMargin of
0: dbl := FWorksheet.PageLayout.LeftMargin;
1: dbl := FWorksheet.PageLayout.RightMargin;
2: dbl := FWorksheet.PageLayout.TopMargin;
3: dbl := FWorksheet.PageLayout.Bottommargin;
end;
dbl := mmToIn(dbl);
AStream.WriteBuffer(dbl, SizeOf(dbl));
end;
@ -2619,6 +2605,44 @@ begin
AStream.WriteWord(WordToLE(w));
end;
{@@ ----------------------------------------------------------------------------
Writes an Excel HEADER or FOOTER record, depending on AIsHeader.
Valid for BIFF2-5. Override for BIFF7 because of WideStrings
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFWriter.WriteHeaderFooter(AStream: TStream;
AIsHeader: Boolean);
var
s: AnsiString;
len: Integer;
id: Word;
begin
with FWorksheet.PageLayout do
if AIsHeader then
begin
if (Headers[HEADER_FOOTER_INDEX_ALL] = '') then
exit;
s := ConvertEncoding(Headers[HEADER_FOOTER_INDEX_ALL], 'utf8', FCodePage);
id := INT_EXCEL_ID_HEADER;
end else
begin
if (Footers[HEADER_FOOTER_INDEX_ALL] = '') then
exit;
s := ConvertEncoding(Footers[HEADER_FOOTER_INDEX_ALL], 'utf8', FCodePage);
id := INT_EXCEL_ID_FOOTER;
end;
len := Length(s);
{ BIFF record header }
WriteBiffHeader(AStream, id, 1 + len*sizeOf(AnsiChar));
{ 8-bit string length }
AStream.WriteByte(len);
{ Characters }
AStream.WriteBuffer(s[1], len * SizeOf(AnsiChar));
end;
{@@ ----------------------------------------------------------------------------
Writes a 64-bit floating point NUMBER record.
Valid for BIFF5 and BIFF8 (BIFF2 has a different record structure).
@ -3254,22 +3278,6 @@ begin
AStream.WriteWord(WordToLE(ASize));
end;
{@@ ----------------------------------------------------------------------------
Writes the right margin of the printed page (in inches)
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFWriter.WriteRightMargin(AStream: TStream);
var
dbl: double;
begin
{ BIFF record header }
WriteBIFFHeader(AStream, INT_EXCEL_ID_RIGHTMARGIN, SizeOf(Double));
{ Page margin value, written in inches }
dbl := mmToIn(FWorksheet.PageLayout.RightMargin);
AStream.WriteBuffer(dbl, SizeOf(dbl));
end;
{@@ ----------------------------------------------------------------------------
Writes an Excel 3-8 ROW record
Valid for BIFF3-BIFF8
@ -3563,21 +3571,6 @@ begin
Unused(AStream, AString);
end;
{@@ ----------------------------------------------------------------------------
Write the top margin of the printed page (in inches)
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFWriter.WriteTopMargin(AStream: TStream);
var
dbl: double;
begin
{ BIFF record header }
WriteBIFFHeader(AStream, INT_EXCEL_ID_TOPMARGIN, SizeOf(Double));
{ Page margin value, written in inches }
dbl := mmToIn(FWorksheet.PageLayout.TopMargin);
AStream.WriteBuffer(dbl, SizeOf(dbl));
end;
{@@ ----------------------------------------------------------------------------
Writes an Excel VCENTER record which determines whether the page is to be
centered vertically for printing

157
components/fpspreadsheet/xlsxooxml.pas
View File

@ -28,7 +28,8 @@ AUTHORS: Felipe Monteiro de Carvalho, Reinier Olislagers, Werner Pamler
unit xlsxooxml;
{$ifdef fpc}
{$mode delphi}
{$mode objfpc}{$H+}
// {$mode delphi}
{$endif}
interface
@ -74,10 +75,12 @@ type
procedure ReadFills(ANode: TDOMNode);
procedure ReadFont(ANode: TDOMNode);
procedure ReadFonts(ANode: TDOMNode);
procedure ReadHeaderFooter(ANode: TDOMNode; AWorksheet: TsWorksheet);
procedure ReadHyperlinks(ANode: TDOMNode);
procedure ReadMergedCells(ANode: TDOMNode; AWorksheet: TsWorksheet);
procedure ReadNumFormats(ANode: TDOMNode);
procedure ReadPageMargins(ANode: TDOMNode; AWorksheet: TsWorksheet);
procedure ReadPageSetup(ANode: TDOMNode; AWorksheet: TsWorksheet);
procedure ReadPalette(ANode: TDOMNode);
procedure ReadPrintOptions(ANode: TDOMNode; AWorksheet: TsWorksheet);
procedure ReadRowHeight(ANode: TDOMNode; AWorksheet: TsWorksheet);
@ -127,6 +130,7 @@ type
procedure WriteDimension(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteFillList(AStream: TStream);
procedure WriteFontList(AStream: TStream);
procedure WriteHeaderFooter(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteHyperlinks(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteMergedCells(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteNumFormatList(AStream: TStream);
@ -799,7 +803,7 @@ begin
if (s1 <> '') and (s2 <> '0') then
begin
fillIndex := StrToInt(s1);
fillData := FFillList[fillIndex];
fillData := TFillListData(FFillList[fillIndex]);
if (fillData <> nil) and (fillData.PatternType <> 'none') then begin
fmt.Background.FgColor := fillData.FgColor;
fmt.Background.BgColor := fillData.BgColor;
@ -818,7 +822,7 @@ begin
if (s1 <> '') and (s2 <> '0') then
begin
borderIndex := StrToInt(s1);
borderData := FBorderList[borderIndex];
borderData := TBorderListData(FBorderList[borderIndex]);
if (borderData <> nil) then
begin
fmt.BorderStyles := borderData.BorderStyles;
@ -1182,6 +1186,40 @@ begin
end;
end;
procedure TsSpreadOOXMLReader.ReadHeaderFooter(ANode: TDOMNode;
AWorksheet: TsWorksheet);
var
node: TDOMNode;
nodeName: String;
s: String;
begin
if ANode = nil then
exit;
s := GetAttrValue(ANode, 'differentOddEven');
if s = '1' then
Include(AWorksheet.PageLayout.Options, poDifferentOddEven);
s := GetAttrValue(ANode, 'differentFirst');
if s = '1' then
Include(AWorksheet.PageLayout.Options, poDifferentFirst);
node := ANode.FirstChild;
while node <> nil do
begin
nodeName := node.NodeName;
case nodeName of
'firstHeader': AWorksheet.PageLayout.Headers[0] := GetNodeValue(node);
'oddHeader' : AWorksheet.PageLayout.Headers[1] := GetNodeValue(node);
'evenHeader' : AWorksheet.PageLayout.Headers[2] := GetNodeValue(node);
'firstFooter': AWorksheet.PageLayout.Footers[0] := GetNodeValue(node);
'oddFooter' : AWorksheet.PageLayout.Footers[1] := GetNodeValue(node);
'evenFooter' : AWorksheet.PageLayout.Footers[2] := GetNodeValue(node);
end;
node := node.NextSibling;
end;
end;
procedure TsSpreadOOXMLReader.ReadHyperlinks(ANode: TDOMNode);
var
node: TDOMNode;
@ -1340,6 +1378,33 @@ begin
AWorksheet.PageLayout.FooterMargin := PtsToMM(HtmlLengthStrToPts(s, 'in'));
end;
procedure TsSpreadOOXMLReader.ReadPageSetup(ANode: TDOMNode;
AWorksheet: TsWorksheet);
var
s: String;
n: Integer;
begin
if ANode = nil then
exit;
s := GetAttrValue(ANode, 'paperSize');
if s <> '' then
begin
n := StrToInt(s);
if (n >= 0) and (n <= High(PAPER_SIZES)) then
begin
AWorksheet.PageLayout.PageWidth := PAPER_SIZES[n, 0];
AWorksheet.PageLayout.PageHeight := PAPER_SIZES[n, 1];
end;
end;
s:= GetAttrValue(ANode, 'orientation');
if s = 'portrait' then
AWorksheet.PageLayout.Orientation := spoPortrait
else if s = 'landscape' then
AWorksheet.PageLayout.Orientation := spoLandscape;
end;
procedure TsSpreadOOXMLReader.ReadPalette(ANode: TDOMNode);
var
node, colornode: TDOMNode;
@ -1726,6 +1791,8 @@ begin
ReadHyperlinks(Doc.DocumentElement.FindNode('hyperlinks'));
ReadPrintOptions(Doc.DocumentElement.FindNode('printOptions'), FWorksheet);
ReadPageMargins(Doc.DocumentElement.FindNode('pageMargins'), FWorksheet);
ReadPageSetup(Doc.DocumentElement.FindNode('pageSetup'), FWorksheet);
ReadHeaderFooter(Doc.DocumentElement.FindNode('headerFooter'), FWorksheet);
FreeAndNil(Doc);
@ -1817,7 +1884,7 @@ var
fmt: PsCellFormat;
begin
// No cell, or border-less --> index 0
if (AFormat = nil) or not (uffBorder in AFormat.UsedFormattingFields) then begin
if (AFormat = nil) or not (uffBorder in AFormat^.UsedFormattingFields) then begin
Result := 0;
exit;
end;
@ -1991,8 +2058,9 @@ begin
for i:=1 to High(FBorderList) do begin
diag := '';
if (cbDiagUp in FBorderList[i].Border) then diag := diag + ' diagonalUp="1"';
if (cbDiagDown in FBorderList[i].Border) then diag := diag + ' diagonalDown="1"';
if (cbDiagUp in FBorderList[i]^.Border) then
diag := diag + ' diagonalUp="1"';
if (cbDiagDown in FBorderList[i]^.Border) then diag := diag + ' diagonalDown="1"';
AppendToStream(AStream,
'<border' + diag + '>');
WriteBorderStyle(AStream, FBorderList[i], cbWest, 'left');
@ -2026,7 +2094,7 @@ begin
if col <> nil then
AppendToStream(AStream, Format(
'<col min="%d" max="%d" width="%g" customWidth="1" />',
[c+1, c+1, col.Width], FPointSeparatorSettings)
[c+1, c+1, col^.Width], FPointSeparatorSettings)
);
end;
@ -2133,7 +2201,7 @@ begin
fc := 'auto="1"'
else
fc := Format('rgb="%s"', [Copy(Workbook.GetPaletteColorAsHTMLStr(FFillList[i]^.Background.FgColor), 2, 255)]);
if FFillList[i].Background.BgColor = scTransparent then
if FFillList[i]^.Background.BgColor = scTransparent then
bc := 'auto="1"'
else
bc := Format('rgb="%s"', [Copy(Workbook.GetPaletteColorAsHTMLStr(FFillList[i]^.Background.BgColor), 2, 255)]);
@ -2198,6 +2266,68 @@ begin
'</fonts>');
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
exit;
s := '';
if poDifferentFirst in Options then
s := s + ' differentFirst="1"';
if poDifferentOddEven in Options then
s := s + ' differentOddEven="1"';
AppendToStream(AStream,
'<headerFooter' + s);
if Headers[HEADER_FOOTER_INDEX_ODD] <> '' then
AppendToStream(AStream,
'<oddHeader>' + Headers[HEADER_FOOTER_INDEX_ODD] + '</oddHeader>');
if Footers[HEADER_FOOTER_INDEX_ODD] <> '' then
AppendToStream(AStream,
'<oddFooter>' + Footers[HEADER_FOOTER_INDEX_ODD] + '</oddFooter>');
if poDifferentFirst in AWorksheet.PageLayout.Options then
begin
if Headers[HEADER_FOOTER_INDEX_FIRST] <> '' then
AppendToStream(AStream,
'<firstHeader>' + Headers[HEADER_FOOTER_INDEX_FIRST] + '</firstHeader>');
if Footers[HEADER_FOOTER_INDEX_FIRST] <> '' then
AppendToStream(AStream,
'<firstFooter>' + Footers[HEADER_FOOTER_INDEX_FIRST] + '</firstFooter>');
end;
if poDifferentOddEven in Options then
begin
AppendToStream(AStream,
'<evenHeader>' + Headers[HEADER_FOOTER_INDEX_EVEN] + '</evenHeader>');
AppendToStream(AStream,
'<evenFooter>' + Footers[HEADER_FOOTER_INDEX_EVEN] + '</evenFooter>');
end;
AppendToStream(AStream,
'</headerFooter>');
end;
end;
procedure TsSpreadOOXMLWriter.WriteHyperlinks(AStream: TStream;
AWorksheet: TsWorksheet);
var
@ -2258,7 +2388,7 @@ begin
'<mergeCells count="%d">', [n]) );
for rng in AWorksheet.MergedCells do
AppendToStream(AStream, Format(
'<mergeCell ref="%s" />', [GetCellRangeString(rng.Row1, rng.Col1, rng.Row2, rng.Col2)]));
'<mergeCell ref="%s" />', [GetCellRangeString(rng^.Row1, rng^.Col1, rng^.Row2, rng^.Col2)]));
AppendToStream(AStream,
'</mergeCells>');
end;
@ -2662,7 +2792,7 @@ begin
{ Text alignment }
if (uffHorAlign in fmt^.UsedFormattingFields) and (fmt^.HorAlignment <> haDefault)
then
case fmt.HorAlignment of
case fmt^.HorAlignment of
haLeft : sAlign := sAlign + 'horizontal="left" ';
haCenter: sAlign := sAlign + 'horizontal="center" ';
haRight : sAlign := sAlign + 'horizontal="right" ';
@ -2670,7 +2800,7 @@ begin
if (uffVertAlign in fmt^.UsedFormattingFields) and (fmt^.VertAlignment <> vaDefault)
then
case fmt.VertAlignment of
case fmt^.VertAlignment of
vaTop : sAlign := sAlign + 'vertical="top" ';
vaCenter: sAlign := sAlign + 'vertical="center" ';
vaBottom: sAlign := sAlign + 'vertical="bottom" ';
@ -2680,7 +2810,7 @@ begin
sAlign := sAlign + 'wrapText="1" ';
{ Fill }
if (uffBackground in fmt.UsedFormattingFields) then
if (uffBackground in fmt^.UsedFormattingFields) then
begin
fillID := FindFillInList(fmt);
if fillID = -1 then fillID := 0;
@ -2913,7 +3043,7 @@ procedure TsSpreadOOXMLWriter.WriteContent;
var
i, counter: Integer;
begin
{ --- WorkbookRels ---
{ --- WorkbookRels --- }
{ Workbook relations - Mark relation to all sheets }
counter := 0;
AppendToStream(FSWorkbookRels,
@ -3052,6 +3182,7 @@ begin
WritePrintOptions(FSSheets[FCurSheetNum], AWorksheet);
WritePageMargins(FSSheets[FCurSheetNum], AWorksheet);
WritePageSetup(FSSheets[FCurSheetNum], AWorksheet);
WriteHeaderFooter(FSSheets[FCurSheetNum], AWorksheet);
// Footer
if AWorksheet.Comments.Count > 0 then