You've already forked lazarus-ccr
fpspreadsheet: Add PageLayout support to ExcelXML writer
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4348 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -4,7 +4,7 @@ Unit : xlsxml
|
|||||||
Implements a reader and writer for the SpreadsheetXML format.
|
Implements a reader and writer for the SpreadsheetXML format.
|
||||||
This document was introduced by Microsoft for Excel XP and 2003.
|
This document was introduced by Microsoft for Excel XP and 2003.
|
||||||
|
|
||||||
REFERENCE: https://msdn.microsoft.com/en-us/library/aa140066%28v=office.15%29.aspx
|
REFERENCE: http://msdn.microsoft.com/en-us/library/aa140066%28v=office.15%29.aspx
|
||||||
|
|
||||||
AUTHOR : Werner Pamler
|
AUTHOR : Werner Pamler
|
||||||
|
|
||||||
@ -39,11 +39,12 @@ type
|
|||||||
function GetIndexStr(AIndex: Integer): String;
|
function GetIndexStr(AIndex: Integer): String;
|
||||||
function GetMergeStr(ACell: PCell): String;
|
function GetMergeStr(ACell: PCell): String;
|
||||||
function GetStyleStr(ACell: PCell): String;
|
function GetStyleStr(ACell: PCell): String;
|
||||||
procedure WriteCells(AStream: TStream; AWorksheet: TsWorksheet);
|
|
||||||
procedure WriteExcelWorkbook(AStream: TStream);
|
procedure WriteExcelWorkbook(AStream: TStream);
|
||||||
procedure WriteStyle(AStream: TStream; AIndex: Integer);
|
procedure WriteStyle(AStream: TStream; AIndex: Integer);
|
||||||
procedure WriteStyles(AStream: TStream);
|
procedure WriteStyles(AStream: TStream);
|
||||||
|
procedure WriteTable(AStream: TStream; AWorksheet: TsWorksheet);
|
||||||
procedure WriteWorksheet(AStream: TStream; AWorksheet: TsWorksheet);
|
procedure WriteWorksheet(AStream: TStream; AWorksheet: TsWorksheet);
|
||||||
|
procedure WriteWorksheetOptions(AStream: TStream; AWorksheet: TsWorksheet);
|
||||||
procedure WriteWorksheets(AStream: TStream);
|
procedure WriteWorksheets(AStream: TStream);
|
||||||
|
|
||||||
protected
|
protected
|
||||||
@ -256,86 +257,6 @@ begin
|
|||||||
]));
|
]));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TsSpreadExcelXMLWriter.WriteCells(AStream: TStream; AWorksheet: TsWorksheet);
|
|
||||||
var
|
|
||||||
c, c1, c2: Cardinal;
|
|
||||||
r, r1, r2: Cardinal;
|
|
||||||
cell: PCell;
|
|
||||||
rowheightStr: String;
|
|
||||||
colwidthStr: String;
|
|
||||||
defFnt: TsFont;
|
|
||||||
col: PCol;
|
|
||||||
row: PRow;
|
|
||||||
cw_fact, rh_fact: Double;
|
|
||||||
begin
|
|
||||||
defFnt := FWorkbook.GetDefaultFont;
|
|
||||||
cw_fact := defFnt.Size * 0.5; // ColWidthFactor = Approx width of "0" character in pts
|
|
||||||
rh_fact := defFnt.Size; // RowHeightFactor = Height of a single line
|
|
||||||
|
|
||||||
r1 := 0;
|
|
||||||
c1 := 0;
|
|
||||||
r2 := AWorksheet.GetLastRowIndex;
|
|
||||||
c2 := AWorksheet.GetLastColIndex;
|
|
||||||
AppendToStream(AStream, TABLE_INDENT + Format(
|
|
||||||
'<Table ss:ExpandedColumnCount="%d" ss:ExpandedRowCount="%d" ' +
|
|
||||||
'x:FullColumns="1" x:FullRows="1" ' +
|
|
||||||
'ss:DefaultColumnWidth="%.2f" ' +
|
|
||||||
'ss:DefaultRowHeight="%.2f">' + LF,
|
|
||||||
[
|
|
||||||
AWorksheet.GetLastColIndex + 1, AWorksheet.GetLastRowIndex + 1,
|
|
||||||
FWorksheet.DefaultColWidth * cw_fact,
|
|
||||||
(FWorksheet.DefaultRowHeight + ROW_HEIGHT_CORRECTION) * rh_fact
|
|
||||||
],
|
|
||||||
FPointSeparatorSettings
|
|
||||||
));
|
|
||||||
|
|
||||||
for c := c1 to c2 do
|
|
||||||
begin
|
|
||||||
col := FWorksheet.FindCol(c);
|
|
||||||
// column width in the worksheet is in multiples of the "0" character width.
|
|
||||||
// In the xml file, it is needed in pts.
|
|
||||||
if Assigned(col) then
|
|
||||||
colwidthStr := Format(' ss:Width="%0.2f"',
|
|
||||||
[col^.Width * cw_fact],
|
|
||||||
FPointSeparatorSettings)
|
|
||||||
else
|
|
||||||
colwidthStr := '';
|
|
||||||
AppendToStream(AStream, COL_INDENT + Format(
|
|
||||||
'<Column ss:Index="%d" ss:AutoFitWidth="0"%s />' + LF, [c+1, colWidthStr]));
|
|
||||||
end;
|
|
||||||
|
|
||||||
for r := r1 to r2 do
|
|
||||||
begin
|
|
||||||
row := FWorksheet.FindRow(r);
|
|
||||||
// Row height in the worksheet is in multiples of the default font height
|
|
||||||
// In the xml file, it is needed in pts.
|
|
||||||
if Assigned(row) then
|
|
||||||
rowheightStr := Format(' ss:Height="%.2f"',
|
|
||||||
[(row^.Height + ROW_HEIGHT_CORRECTION) * rh_fact],
|
|
||||||
FPointSeparatorSettings
|
|
||||||
)
|
|
||||||
else
|
|
||||||
rowheightStr := '';
|
|
||||||
AppendToStream(AStream, ROW_INDENT + Format(
|
|
||||||
'<Row ss:AutoFitHeight="1"%s>' + LF, [rowheightStr]));
|
|
||||||
for c := c1 to c2 do
|
|
||||||
begin
|
|
||||||
cell := AWorksheet.FindCell(r, c);
|
|
||||||
if cell <> nil then
|
|
||||||
begin
|
|
||||||
if FWorksheet.IsMerged(cell) and not FWorksheet.IsMergeBase(cell) then
|
|
||||||
Continue;
|
|
||||||
WriteCellToStream(AStream, cell);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
AppendToStream(AStream, ROW_INDENT +
|
|
||||||
'</Row>' + LF);
|
|
||||||
end;
|
|
||||||
|
|
||||||
AppendToStream(AStream, TABLE_INDENT +
|
|
||||||
'</Table>' + LF);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TsSpreadExcelXMLWriter.WriteCellToStream(AStream: TStream; ACell: PCell);
|
procedure TsSpreadExcelXMLWriter.WriteCellToStream(AStream: TStream; ACell: PCell);
|
||||||
begin
|
begin
|
||||||
case ACell^.ContentType of
|
case ACell^.ContentType of
|
||||||
@ -651,6 +572,86 @@ begin
|
|||||||
'</Styles>' + LF);
|
'</Styles>' + LF);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TsSpreadExcelXMLWriter.WriteTable(AStream: TStream; AWorksheet: TsWorksheet);
|
||||||
|
var
|
||||||
|
c, c1, c2: Cardinal;
|
||||||
|
r, r1, r2: Cardinal;
|
||||||
|
cell: PCell;
|
||||||
|
rowheightStr: String;
|
||||||
|
colwidthStr: String;
|
||||||
|
defFnt: TsFont;
|
||||||
|
col: PCol;
|
||||||
|
row: PRow;
|
||||||
|
cw_fact, rh_fact: Double;
|
||||||
|
begin
|
||||||
|
defFnt := FWorkbook.GetDefaultFont;
|
||||||
|
cw_fact := defFnt.Size * 0.5; // ColWidthFactor = Approx width of "0" character in pts
|
||||||
|
rh_fact := defFnt.Size; // RowHeightFactor = Height of a single line
|
||||||
|
|
||||||
|
r1 := 0;
|
||||||
|
c1 := 0;
|
||||||
|
r2 := AWorksheet.GetLastRowIndex;
|
||||||
|
c2 := AWorksheet.GetLastColIndex;
|
||||||
|
AppendToStream(AStream, TABLE_INDENT + Format(
|
||||||
|
'<Table ss:ExpandedColumnCount="%d" ss:ExpandedRowCount="%d" ' +
|
||||||
|
'x:FullColumns="1" x:FullRows="1" ' +
|
||||||
|
'ss:DefaultColumnWidth="%.2f" ' +
|
||||||
|
'ss:DefaultRowHeight="%.2f">' + LF,
|
||||||
|
[
|
||||||
|
AWorksheet.GetLastColIndex + 1, AWorksheet.GetLastRowIndex + 1,
|
||||||
|
FWorksheet.DefaultColWidth * cw_fact,
|
||||||
|
(FWorksheet.DefaultRowHeight + ROW_HEIGHT_CORRECTION) * rh_fact
|
||||||
|
],
|
||||||
|
FPointSeparatorSettings
|
||||||
|
));
|
||||||
|
|
||||||
|
for c := c1 to c2 do
|
||||||
|
begin
|
||||||
|
col := FWorksheet.FindCol(c);
|
||||||
|
// column width in the worksheet is in multiples of the "0" character width.
|
||||||
|
// In the xml file, it is needed in pts.
|
||||||
|
if Assigned(col) then
|
||||||
|
colwidthStr := Format(' ss:Width="%0.2f"',
|
||||||
|
[col^.Width * cw_fact],
|
||||||
|
FPointSeparatorSettings)
|
||||||
|
else
|
||||||
|
colwidthStr := '';
|
||||||
|
AppendToStream(AStream, COL_INDENT + Format(
|
||||||
|
'<Column ss:Index="%d" ss:AutoFitWidth="0"%s />' + LF, [c+1, colWidthStr]));
|
||||||
|
end;
|
||||||
|
|
||||||
|
for r := r1 to r2 do
|
||||||
|
begin
|
||||||
|
row := FWorksheet.FindRow(r);
|
||||||
|
// Row height in the worksheet is in multiples of the default font height
|
||||||
|
// In the xml file, it is needed in pts.
|
||||||
|
if Assigned(row) then
|
||||||
|
rowheightStr := Format(' ss:Height="%.2f"',
|
||||||
|
[(row^.Height + ROW_HEIGHT_CORRECTION) * rh_fact],
|
||||||
|
FPointSeparatorSettings
|
||||||
|
)
|
||||||
|
else
|
||||||
|
rowheightStr := '';
|
||||||
|
AppendToStream(AStream, ROW_INDENT + Format(
|
||||||
|
'<Row ss:AutoFitHeight="1"%s>' + LF, [rowheightStr]));
|
||||||
|
for c := c1 to c2 do
|
||||||
|
begin
|
||||||
|
cell := AWorksheet.FindCell(r, c);
|
||||||
|
if cell <> nil then
|
||||||
|
begin
|
||||||
|
if FWorksheet.IsMerged(cell) and not FWorksheet.IsMergeBase(cell) then
|
||||||
|
Continue;
|
||||||
|
WriteCellToStream(AStream, cell);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
AppendToStream(AStream, ROW_INDENT +
|
||||||
|
'</Row>' + LF);
|
||||||
|
end;
|
||||||
|
|
||||||
|
AppendToStream(AStream, TABLE_INDENT +
|
||||||
|
'</Table>' + LF);
|
||||||
|
end;
|
||||||
|
|
||||||
{@@ ----------------------------------------------------------------------------
|
{@@ ----------------------------------------------------------------------------
|
||||||
Writes an ExcelXML document to the file
|
Writes an ExcelXML document to the file
|
||||||
-------------------------------------------------------------------------------}
|
-------------------------------------------------------------------------------}
|
||||||
@ -706,12 +707,62 @@ begin
|
|||||||
FWorksheet := AWorksheet;
|
FWorksheet := AWorksheet;
|
||||||
AppendToStream(AStream, Format(
|
AppendToStream(AStream, Format(
|
||||||
' <Worksheet ss:Name="%s">' + LF, [AWorksheet.Name]) );
|
' <Worksheet ss:Name="%s">' + LF, [AWorksheet.Name]) );
|
||||||
WriteCells(AStream, AWorksheet);
|
WriteTable(AStream, AWorksheet);
|
||||||
|
WriteWorksheetOptions(AStream, AWorksheet);
|
||||||
AppendToStream(AStream,
|
AppendToStream(AStream,
|
||||||
' </Worksheet>' + LF
|
' </Worksheet>' + LF
|
||||||
);
|
);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TsSpreadExcelXMLWriter.WriteWorksheetOptions(AStream: TStream;
|
||||||
|
AWorksheet: TsWorksheet);
|
||||||
|
const
|
||||||
|
ORIENTATION_NAME: Array[TsPageOrientation] of string = ('Portrait', 'Landscape');
|
||||||
|
var
|
||||||
|
footerStr, headerStr: String;
|
||||||
|
hcenterStr, vcenterStr: String;
|
||||||
|
startpageStr: String;
|
||||||
|
begin
|
||||||
|
if (AWorksheet.PageLayout.Headers[HEADER_FOOTER_INDEX_ALL] <> '') then
|
||||||
|
headerStr := ' x:Data="' + UTF8TextToXMLText(AWorksheet.PageLayout.Headers[HEADER_FOOTER_INDEX_ALL]) + '"' else
|
||||||
|
headerStr := '';
|
||||||
|
|
||||||
|
if (AWorksheet.PageLayout.Footers[HEADER_FOOTER_INDEX_ALL] <> '') then
|
||||||
|
footerStr := ' x:Data="' + UTF8TextToXMLText(AWorksheet.PageLayout.Footers[HEADER_FOOTER_INDEX_ALL]) + '"' else
|
||||||
|
footerStr := '';
|
||||||
|
|
||||||
|
if (poHorCentered in AWorksheet.PageLayout.Options) then
|
||||||
|
hcenterStr := ' x:CenterHorizontal="1"' else
|
||||||
|
hcenterStr := '';
|
||||||
|
|
||||||
|
if (poVertCentered in AWorksheet.PageLayout.Options) then
|
||||||
|
vcenterStr := ' x:CenterVertical="1"' else
|
||||||
|
vcenterStr := '';
|
||||||
|
|
||||||
|
if (poUseStartPageNumber in AWorksheet.PageLayout.Options) then
|
||||||
|
startpageStr := ' x:StartPageNumber="' + IntToStr(AWorksheet.PageLayout.StartPageNumber) + '"' else
|
||||||
|
startpageStr := '';
|
||||||
|
|
||||||
|
|
||||||
|
AppendToStream(AStream, INDENT2 + Format(
|
||||||
|
'<WorksheetOptions xmlns="urn:schemas-microsoft-com:office:excel">' + LF + INDENT3 +
|
||||||
|
'<PageSetup>' + LF + INDENT4 +
|
||||||
|
'<Layout x:Orientation="%s"%s%s%s/>' + LF + INDENT4 +
|
||||||
|
'<Header x:Margin="%g"%s/>' + LF + INDENT4 +
|
||||||
|
'<Footer x:Margin="%g"%s/>' + LF + INDENT4 +
|
||||||
|
'<PageMargins x:Bottom="%g" x:Left="%g" ' +
|
||||||
|
'x:Right="%g" x:Top="%g"/>' + LF + INDENT3 +
|
||||||
|
'</PageSetup>' + LF + INDENT2 +
|
||||||
|
'</WorksheetOptions>', [
|
||||||
|
ORIENTATION_NAME[AWorksheet.PageLayout.Orientation], hcenterStr, vcenterStr, startpageStr, // >Layout ..
|
||||||
|
mmToIn(AWorksheet.PageLayout.HeaderMargin), headerStr, // <Header ..
|
||||||
|
mmToIn(AWorksheet.PageLayout.FooterMargin), footerStr, // <Footer ...
|
||||||
|
mmToIn(AWorksheet.PageLayout.BottomMargin), mmToIn(AWorksheet.PageLayout.LeftMargin), // <PageMargins ..
|
||||||
|
mmToIn(AWorksheet.PageLayout.RightMargin), mmToIn(AWorksheet.PageLayout.TopMargin)
|
||||||
|
], FPointSeparatorSettings
|
||||||
|
));
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TsSpreadExcelXMLWriter.WriteWorksheets(AStream: TStream);
|
procedure TsSpreadExcelXMLWriter.WriteWorksheets(AStream: TStream);
|
||||||
var
|
var
|
||||||
i: Integer;
|
i: Integer;
|
||||||
|
|||||||
Reference in New Issue
Block a user