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

fpspreadsheet: Add support for frozen panes to ExcelXML writer.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4351 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-09-21 21:54:49 +00:00
parent 075b82257f
commit 32343a87a3
3 changed files with 144 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
components/fpspreadsheet/fpstypes.pas
View File

@ -454,17 +454,6 @@ type
{@@ Parameters describing formatting of text ranges in cell text }
TsRichTextParams = array of TsRichTextParam;
(*
{@@ Excel rich-text formatting run }
TsRichTextFormattingRun = packed record
FirstIndex: Integer;
FontIndex: Integer;
end;
{@@ Array of Excel rich-text formatting runs }
TsRichTextFormattingRuns = array of TsRichTextFormattingRun;
*)
{@@ Indicates the border for a cell. If included in the CellBorders set the
corresponding border is drawn in the style defined by the CellBorderStyle. }
TsCellBorder = (cbNorth, cbWest, cbEast, cbSouth, cbDiagUp, cbDiagDown);

21
components/fpspreadsheet/fpsutils.pas
View File

@ -119,8 +119,9 @@ function pxToPts(AValue, AScreenPixelsPerInch: Integer): Double; inline;
function PtsToPx(AValue: Double; AScreenPixelsPerInch: Integer): Integer; inline;
function HTMLLengthStrToPts(AValue: String; DefaultUnits: String = 'pt'): Double;
function UTF8TextToXMLText(AText: ansistring): ansistring;
function ValidXMLText(var AText: ansistring; ReplaceSpecialChars: Boolean = true): Boolean;
function UTF8TextToXMLText(AText: ansistring; ProcessLineEndings: Boolean = false): ansistring;
function ValidXMLText(var AText: ansistring; ReplaceSpecialChars: Boolean = true;
ProcessLineEndings: Boolean = false): Boolean;
function ColorToHTMLColorStr(AValue: TsColor; AExcelDialect: Boolean = false): String;
function HTMLColorStrToColor(AValue: String): TsColor;
@ -1587,10 +1588,13 @@ end;
Converts a string encoded in UTF8 to a string usable in XML. For this purpose,
some characters must be translated.
@param AText input string encoded as UTF8
@param AText Input string encoded as UTF8
@param ProcessLineEndings If TRUE line ending characters are replaced by
their HTML entities (e.g., #10 --> '
'
@return String usable in XML with some characters replaced by the HTML codes.
-------------------------------------------------------------------------------}
function UTF8TextToXMLText(AText: ansistring): ansistring;
function UTF8TextToXMLText(AText: ansistring;
ProcessLineEndings: Boolean = false): ansistring;
var
Idx: Integer;
AppoSt:ansistring;
@ -1620,6 +1624,8 @@ begin
'"': Result := Result + '"';
'''':Result := Result + ''';
'%': Result := Result + '%';
#10: if ProcessLineEndings then Result := Result + '
';
#13: if ProcessLineEndings then Result := Result + '
';
{ this breaks multi-line labels in xlsx
#10: begin
Result := Result + '<br />';
@ -1652,10 +1658,13 @@ end;
@param AText String to be checked. Is replaced by valid string.
@param ReplaceSpecialChars Special characters are replaced by their HTML
codes (e.g. '>' --> '&gt;')
@param ProcessLineEndings If TRUE line ending characters are replaced by
their HTML entities.
@return FALSE if characters < #32 were replaced, TRUE otherwise.
-------------------------------------------------------------------------------}
function ValidXMLText(var AText: ansistring;
ReplaceSpecialChars: Boolean = true): Boolean;
ReplaceSpecialChars: Boolean = true;
ProcessLineEndings: Boolean = false): Boolean;
const
BOX = #$E2#$8E#$95;
var
@ -1671,7 +1680,7 @@ begin
Result := false;
end;
if ReplaceSpecialChars then
AText := UTF8TextToXMLText(AText);
AText := UTF8TextToXMLText(AText, ProcessLineEndings);
end;

172
components/fpspreadsheet/xlsxml.pas
View File

@ -35,9 +35,14 @@ type
FPointSeparatorSettings: TFormatSettings;
function GetCommentStr(ACell: PCell): String;
function GetFormulaStr(ACell: PCell): String;
function GetFrozenPanesStr(AWorksheet: TsWorksheet; AIndent: String): String;
function GetHyperlinkStr(ACell: PCell): String;
function GetIndexStr(AIndex: Integer): String;
function GetLayoutStr(AWorksheet: TsWorksheet): String;
function GetMergeStr(ACell: PCell): String;
function GetPageFooterStr(AWorksheet: TsWorksheet): String;
function GetPageHeaderStr(AWorksheet: TsWorksheet): String;
function GetPageMarginStr(AWorksheet: TsWorksheet): String;
function GetStyleStr(ACell: PCell): String;
procedure WriteExcelWorkbook(AStream: TStream);
procedure WriteStyle(AStream: TStream; AIndex: Integer);
@ -87,20 +92,22 @@ uses
const
FMT_OFFSET = 61;
INDENT1 = ' ';
INDENT2 = ' ';
INDENT3 = ' ';
INDENT4 = ' ';
INDENT5 = ' ';
VALUE_INDENT = INDENT5;
CELL_INDENT = INDENT4;
TABLE_INDENT = INDENT2;
ROW_INDENT = INDENT3;
COL_INDENT = INDENT3;
TABLE_INDENT = INDENT2;
CELL_INDENT = INDENT4;
VALUE_INDENT = INDENT5;
LF = LineEnding;
const
{ TsFillStyle = (
{TsFillStyle = (
fsNoFill, fsSolidFill,
fsGray75, fsGray50, fsGray25, fsGray12, fsGray6,
fsStripeHor, fsStripeVert, fsStripeDiagUp, fsStripeDiagDown,
@ -119,7 +126,7 @@ const
'Top', 'Left', 'Right', 'Bottom', 'DiagonalRight', 'DiagonalLeft'
);
{ TsLineStyle = (
{TsLineStyle = (
lsThin, lsMedium, lsDashed, lsDotted, lsThick, lsDouble, lsHair,
lsMediumDash, lsDashDot, lsMediumDashDot, lsDashDotDot, lsMediumDashDotDot,
lsSlantDashDot) }
@ -192,6 +199,43 @@ begin
Result := '';
end;
function TsSpreadExcelXMLWriter.GetFrozenPanesStr(AWorksheet: TsWorksheet;
AIndent: String): String;
var
activePane: Integer;
begin
if (soHasFrozenPanes in AWorksheet.Options) then
begin
Result := AIndent +
'<FreezePanes/>' + LF + AIndent +
'<FrozenNoSplit/>' + LF;
if FWorksheet.LeftPaneWidth > 0 then
Result := Result + AIndent +
'<SplitVertical>1</SplitVertical>' + LF + AIndent +
'<LeftColumnRightPane>' + IntToStr(FWorksheet.LeftPaneWidth) + '</LeftColumnRightPane>' + LF;
if FWorksheet.TopPaneHeight > 0 then
Result := Result + AIndent +
'<SplitHorizontal>1</SplitHorizontal>' + LF + AIndent +
'<TopRowBottomPane>' + IntToStr(FWorksheet.TopPaneHeight) + '</TopRowBottomPane>' + LF;
if (FWorksheet.LeftPaneWidth = 0) and (FWorkSheet.TopPaneHeight = 0) then
activePane := 3
else
if (FWorksheet.LeftPaneWidth = 0) then
activePane := 2
else
if (FWorksheet.TopPaneHeight = 0) then
activePane := 1
else
activePane := 0;
Result := Result + AIndent +
'<ActivePane>' + IntToStr(activePane) + '</ActivePane>' + LF;
end else
Result := '';
end;
function TsSpreadExcelXMLWriter.GetHyperlinkStr(ACell: PCell): String;
var
hyperlink: PsHyperlink;
@ -207,6 +251,20 @@ begin
Result := Format(' ss:Index="%d"', [AIndex]);
end;
function TsSpreadExcelXMLWriter.GetLayoutStr(AWorksheet: TsWorksheet): String;
begin
Result := '';
if AWorksheet.PageLayout.Orientation = spoLandscape then
Result := Result + ' x:Orientation="Landscape"';
if (poHorCentered in AWorksheet.PageLayout.Options) then
Result := Result + ' x:CenterHorizontal="1"';
if (poVertCentered in AWorksheet.PageLayout.Options) then
Result := Result + ' x:CenterVertical="1"';
if (poUseStartPageNumber in AWorksheet.PageLayout.Options) then
Result := Result + ' x:StartPageNumber="' + IntToStr(AWorksheet.PageLayout.StartPageNumber) + '"';
Result := '<Layout' + Result + '/>';
end;
function TsSpreadExcelXMLWriter.GetMergeStr(ACell: PCell): String;
var
r1, c1, r2, c2: Cardinal;
@ -221,6 +279,33 @@ begin
end;
end;
function TsSpreadExcelXMLWriter.GetPageFooterStr(AWorksheet: TsWorksheet): String;
begin
Result := Format('x:Margin="%g"', [mmToIn(AWorksheet.PageLayout.FooterMargin)], FPointSeparatorSettings);
if (AWorksheet.PageLayout.Footers[HEADER_FOOTER_INDEX_ALL] <> '') then
Result := Result + ' x:Data="' + UTF8TextToXMLText(AWorksheet.PageLayout.Footers[HEADER_FOOTER_INDEX_ALL], true) + '"';
Result := '<Footer ' + result + '/>';
end;
function TsSpreadExcelXMLWriter.GetPageHeaderStr(AWorksheet: TsWorksheet): String;
begin
Result := Format('x:Margin="%g"', [mmToIn(AWorksheet.PageLayout.HeaderMargin)], FPointSeparatorSettings);
if (AWorksheet.PageLayout.Headers[HEADER_FOOTER_INDEX_ALL] <> '') then
Result := Result + ' x:Data="' + UTF8TextToXMLText(AWorksheet.PageLayout.Headers[HEADER_FOOTER_INDEX_ALL], true) + '"';
Result := '<Header ' + Result + '/>';
end;
function TsSpreadExcelXMLWriter.GetPageMarginStr(AWorksheet: TsWorksheet): String;
begin
Result := Format('x:Bottom="%g" x:Left="%g" x:Right="%g" x:Top="%g"', [
mmToIn(AWorksheet.PageLayout.BottomMargin),
mmToIn(AWorksheet.PageLayout.LeftMargin),
mmToIn(AWorksheet.PageLayout.RightMargin),
mmToIn(AWorksheet.PageLayout.TopMargin)
], FPointSeparatorSettings);
Result := '<PageMargins ' + Result + '/>';
end;
function TsSpreadExcelXMLWriter.GetStyleStr(ACell: PCell): String;
begin
Result := '';
@ -370,7 +455,7 @@ begin
end else
begin
valueStr := AValue;
if not ValidXMLText(valueStr) then
if not ValidXMLText(valueStr, true, true) then
Workbook.AddErrorMsg(
rsInvalidCharacterInCell, [
GetCellString(ARow, ACol)
@ -552,8 +637,8 @@ begin
end;
if s <> '' then
AppendToStream(AStream, INDENT3 +
' <Borders>' + LF + s +
' </Borders>' + LF);
'<Borders>' + LF + s + INDENT3 +
'</Borders>' + LF);
end;
AppendToStream(AStream, INDENT2 +
@ -716,62 +801,63 @@ 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;
hideGridStr: String;
hideHeadersStr: String;
frozenStr: String;
layoutStr: String;
marginStr: String;
selectedStr: String;
begin
if (AWorksheet.PageLayout.Headers[HEADER_FOOTER_INDEX_ALL] <> '') then
headerStr := ' x:Data="' + UTF8TextToXMLText(AWorksheet.PageLayout.Headers[HEADER_FOOTER_INDEX_ALL]) + '"' else
headerStr := '';
// Orientation, some PageLayout.Options
layoutStr := GetLayoutStr(AWorksheet);
if layoutStr <> '' then layoutStr := INDENT4 + layoutStr + LF;
if (AWorksheet.PageLayout.Footers[HEADER_FOOTER_INDEX_ALL] <> '') then
footerStr := ' x:Data="' + UTF8TextToXMLText(AWorksheet.PageLayout.Footers[HEADER_FOOTER_INDEX_ALL]) + '"' else
footerStr := '';
// Header
headerStr := GetPageHeaderStr(AWorksheet);
if headerStr <> '' then headerStr := INDENT4 + headerStr + LF;
if (poHorCentered in AWorksheet.PageLayout.Options) then
hcenterStr := ' x:CenterHorizontal="1"' else
hcenterStr := '';
// Footer
footerStr := GetPageFooterStr(AWorksheet);
if footerStr <> '' then footerStr := INDENT4 + footerStr + LF;
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 := '';
// Page margins
marginStr := GetPageMarginStr(AWorksheet);
if marginStr <> '' then marginStr := INDENT4 + marginStr + LF;
// Show/hide grid lines
if not (soShowGridLines in AWorksheet.Options) then
hideGridStr := INDENT3 + '<DoNotDisplayGridlines/>' + LF else
hideGridStr := '';
// Show/hide column/row headers
if not (soShowHeaders in AWorksheet.Options) then
hideHeadersStr := INDENT3 + '<DoNotDisplayHeadings/>' + LF else
hideHeadersStr := '';
AppendToStream(AStream, INDENT2 + Format(
if FWorkbook.ActiveWorksheet = AWorksheet then
selectedStr := INDENT3 + '<Selected/>' + LF else
selectedStr := '';
// Frozen panes
frozenStr := GetFrozenPanesStr(AWorksheet, INDENT3);
// Put it all together...
AppendToStream(AStream, INDENT2 +
'<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 +
layoutStr +
headerStr +
footerStr +
marginStr + INDENT3 +
'</PageSetup>' + LF +
selectedStr +
frozenStr +
hideGridStr +
hideHeadersStr + 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
));
'</WorksheetOptions>' + LF
);
end;
procedure TsSpreadExcelXMLWriter.WriteWorksheets(AStream: TStream);