paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-27 15:25:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

fpvectorial: Patch from Michael Thompson, adds support for tables and reworks the list styles

Browse Source 
git-svn-id: trunk@42695 -
This commit is contained in:
sekelsenmat 2013-09-09 08:38:58 +00:00
parent e9ab40821e
commit a0bda77827
5 changed files with 1270 additions and 236 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

666
components/fpvectorial/docxvectorialwriter.pas
View File

@ -2,6 +2,9 @@
docxvectorialwriter.pas
License: The same modified LGPL as the Free Pascal RTL
See the file COPYING.modifiedLGPL for more details
THIS IS A UNIT CURRENTLY UNDER DEVELOPEMENT
Current Functionality
@ -10,10 +13,10 @@ THIS IS A UNIT CURRENTLY UNDER DEVELOPEMENT
- Supports Section Breaks (via PageSequences)
- Supports Header and Footer
- Supports Portrait/Landscape
- Support Tables
TODO
- Add following to both FPVectorial AND DOCXWriter
- Add Table Support
- Add Image Support (From file and from Stream, in Paragraph and in Table)
- Add simple Work Fields (NumPage, PageCount, Filename (Full, part), DatePrinted)
- Add TOC support
@ -25,15 +28,20 @@ An OOXML document is a compressed ZIP file with the following files inside:
[Content_Types].xml - An index of all files, defines their content format
_rels\.rels - Relationships between high level documents
word\document.xml - this is the main document. Conforms to WordprocessingML
word\_rels\document.xml.rels - defines relationships to files required by document.xml (ie styles.xml)
word\document.xml - this is the main document. Conforms to WordprocessingML
word\styles.xml - The Style Library
word\header%d.xml - One file per header
word\footer%d.xml - One file per footer
word\numbering.xml - Header and List numbering details
media\*.[png, jpg, etc] - Images
Specifications obtained from:
Specifications and examples obtained from:
http://openxmldeveloper.org/default.aspx
Office Open XML Part 4 - Markup Language Reference.docx
- First edition, downloaded from http://www.ecma-international.org/publications/standards/Ecma-376.htm
http://officeopenxml.com/
http://www.ecma-international.org/publications/standards/Ecma-376.htm
- Office Open XML Part 4 - Markup Language Reference.docx (First edition)
AUTHORS: Mike Thompson, Felipe Monteiro de Carvalho
@ -65,6 +73,14 @@ Change History
- Significant refactoring of code, and formatted code with Jedi Code Format.
I intend to Jedi Code Format before each Patch from here on
- Added support for Alignment to Styles
0.5 - Support TvParagraph margins
- Added numbering.xml
0.6 - Changed #11 (vert tab) to #09 (horiz tab, what it always should have been)
- Added Table Support
- Bug fix - Margin support in Styles fixed...
0.7 - Added experimental LocalAlignment support to TvParagraph
}
Unit docxvectorialwriter;
@ -77,21 +93,25 @@ Uses
Classes, SysUtils,
zipper, {NOTE: might require zipper from FPC 2.6.2+ }
fpimage, fpcanvas,
fpvectorial, fpvutils, lazutf8;
fpvectorial, fpvutils, lazutf8, Math;
Type
TIndentOption = (indInc, indDec, indNone);
{ TIndentedStringList }
// Here to just to ensure the resulting xml files are pretty :-)
{ TODO : Replace this with a genuine XML handler }
TIndentedStringList = Class(TStringList)
Private
FIndent: String;
FIndentSteps: String;
Public
Constructor Create;
Function Add(indBefore: TIndentOption = indNone; S: String = '';
indAfter: TIndentOption = indNone): Integer;
Function Add(Const S: String): Integer; Override;
Function Add(bIndent: Boolean; Const S: String): Integer;
Function Add(Const S: String; indAfter: TIndentOption): Integer;
Procedure IncIndent;
Procedure DecIndent;
@ -114,7 +134,7 @@ Type
MentionedIn: TFileTypes;
XML: TIndentedStringList; // Free'd internally;
//Image : TFPImage; { TODO : How are we going to handle images? }
//Image : TFPImage; { TODO: How are we going to handle images? }
Constructor Create;
Destructor Destroy; Override;
@ -128,8 +148,6 @@ Type
// This creates a TSream, Call .FreeStream to free
End;
{ TODO : Can this be tidied with Generics? }
{ TFileList }
TFileList = Class(TObject)
@ -161,7 +179,9 @@ Type
Function PrepareDocRelationships: String;
Procedure PrepareDocument;
Procedure PrepareStyles;
Procedure PrepareStyles; // Only created if FData has Styles defined
Procedure PrepareNumbering; // Only created if Numbered Styles exist
Procedure PrepareTextRunStyle(ADoc: TIndentedStringList; AStyle: TvStyle);
Function StyleNameToStyleID(AStyle: TvStyle): String;
Public
@ -172,10 +192,6 @@ Type
Procedure WriteToStream(AStream: TStream; AData: TvVectorialDocument); Override;
End;
// Generic Helper Units
Function PointsToTwipsS(APoints: Double): String;
Function mmToTwipsS(AMillimetres: Double): String;
Implementation
Uses
@ -193,18 +209,21 @@ Const
OOXML_PATH_STYLES = 'word/styles.xml';
OOXML_PATH_HEADER = 'word/header%d.xml'; // Use Format(OOXML_PATH_HEADER, [Index]);
OOXML_PATH_FOOTER = 'word/footer%d.xml'; // Use Format(OOXML_PATH_HEADER, [Index]);
OOXML_PATH_NUMBERING = 'word/numbering.xml';
OOXML_RELS = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships';
OOXML_TYPE_DOCUMENT = OOXML_RELS + '/officeDocument';
OOXML_TYPE_STYLES = OOXML_RELS + '/styles';
OOXML_TYPE_HEADER = OOXML_RELS + '/header';
OOXML_TYPE_FOOTER = OOXML_RELS + '/footer';
OOXML_TYPE_NUMBERING = OOXML_RELS + '/numbering';
OOXML_CONTENTTYPE = 'application/vnd.openxmlformats-officedocument.wordprocessingml';
OOXML_CONTENTTYPE_DOCUMENT = OOXML_CONTENTTYPE + '.document.main+xml';
OOXML_CONTENTTYPE_STYLES = OOXML_CONTENTTYPE + '.styles+xml';
OOXML_CONTENTTYPE_HEADER = OOXML_CONTENTTYPE + '.header+xml';
OOXML_CONTENTTYPE_FOOTER = OOXML_CONTENTTYPE + '.footer+xml';
OOXML_CONTENTTYPE_NUMBERING = OOXML_CONTENTTYPE + '.numbering+xml';
// Shared between document.xml and each header.xml/footer.xml
OOXML_DOCUMENT_NAMESPACE =
@ -214,18 +233,69 @@ Const
TAG_HEADER = 'hdr';
TAG_FOOTER = 'ftr';
// Lookups...
LU_ALIGN: Array [TvStyleAlignment] Of String =
('left', 'right', 'both', 'center');
LU_KIND: Array [TvListStyleKind] Of String =
('bullet', 'decimal', 'lowerLetter', 'lowerRoman',
'upperLetter', 'upperRoman');
LU_ON_OFF: Array[Boolean] Of String = ('off', 'on');
LU_BORDERTYPE: Array[TvTableBorderType] Of String =
('single', 'dashed', 'double', 'none', 'default');
LU_V_ALIGN: Array[TvVerticalAlignment] Of String = ('top', 'bottom', 'center', 'both');
//ONE_POINT_IN_MM = 0.35278;
// Generic Helper Units
Function PointsToTwipsS(APoints: Double): String;
Begin
// 1 Twip = 1/20 of a point
Result := IntToStr(Round(20 * APoints));
End;
Function mmToPointS(AMillimetres: Double): String;
Begin
Result := IntToStr(Round((0.0393701 * 1440 * AMillimetres) / 20));
End;
Function mmToTwipsS(AMillimetres: Double): String;
Begin
// 1 Twip = 1 / 1440 of an inch - sigh...
Result := IntToStr(Round(0.0393701 * 1440 * AMillimetres));
End;
Function DimAttribs(ADimension: TvDimension; AValueTag: String = 'w:w';
ATypeTag: String = 'w:type'): String;
Var
iValue: Integer;
sType: String;
Begin
Case ADimension.Units Of
dimMillimeter:
Begin
iValue := Round(0.0393701 * 1440 * ADimension.Value);
sType := 'dxa'; // most values in docx must be in twips
End;
dimPercent:
Begin
iValue := Round(50 * ADimension.Value);
sType := 'pct'; // 50ths of a percent
End;
dimPoint:
Begin
iValue := Round(20 * ADimension.Value);
sType := 'dxa'; // most values in docx must be in twips
End;
End;
Result := Format(' %s="%d" %s="%s" ', [AValueTag, iValue, ATypeTag, sType]);
End;
{ TFileInformation }
Constructor TFileInformation.Create;
@ -345,20 +415,30 @@ Begin
FIndentSteps := ' ';
End;
Function TIndentedStringList.Add(indBefore: TIndentOption; S: String;
indAfter: TIndentOption): Integer;
Begin
If indBefore = indInc Then
IncIndent
Else If indAfter = indDec Then
DecIndent;
Result := Inherited Add(FIndent + S);
If indAfter = indInc Then
IncIndent
Else If indBefore = indDec Then
DecIndent;
End;
Function TIndentedStringList.Add(Const S: String): Integer;
Begin
Result := Inherited Add(FIndent + S);
End;
Function TIndentedStringList.Add(bIndent: Boolean; Const S: String): Integer;
Function TIndentedStringList.Add(Const S: String; indAfter: TIndentOption): Integer;
Begin
If bIndent Then
IncIndent;
Result := Inherited Add(FIndent + S);
If Not bIndent Then
DecIndent;
Result := Add(indNone, S, indAfter);
End;
Procedure TIndentedStringList.DecIndent;
@ -447,19 +527,7 @@ Var
// Generally this is document.xml, may also be header.xml or footer.xml though..
oDocXML: TIndentedStringList;
Procedure AddParagraphProperties(AStyle: TvStyle);
Begin
oDocXML.Add(True, '<w:pPr>');
oDocXML.Add(' <w:pStyle w:val="' + StyleNameToStyleID(AStyle) + '"/>');
oDocXML.Add(False, '</w:pPr>');
End;
Procedure AddRunProperties(AStyle: TvStyle);
Begin
oDocXML.Add(True, '<w:rPr>');
oDocXML.Add(' <w:rStyle w:val="' + StyleNameToStyleID(AStyle) + '"/>');
oDocXML.Add(False, '</w:rPr>');
End;
Procedure ProcessRichText(ARichText: TvRichText); Forward;
Procedure AddTextRun(sText: String; AStyle: TvStyle);
Var
@ -477,31 +545,35 @@ Var
// and render the Tabs and CRs appropriately
While i <= iLen Do
Begin
If (sText[i] In [#10, #11, #13]) Or (i = iLen) Then
If (sText[i] In [#10, #09, #13]) Or (i = iLen) Then
Begin
// Add the text before this point into a single Text Run
If i > iStart Then
Begin
// If end of line AND end of line isn't a special char, then
// inc(i) to ensure the math in the Copy works :-)
If (i = iLen) And Not (sText[i] In [#10, #11, #13]) Then
If (i = iLen) And Not (sText[i] In [#10, #09, #13]) Then
Inc(i);
sTemp := Copy(sText, iStart, i - iStart);
oDocXML.Add(True, '<w:r>');
oDocXML.Add(indInc, '<w:r>');
If Assigned(AStyle) Then
AddRunProperties(AStyle);
Begin
oDocXML.Add(indInc, '<w:rPr>');
oDocXML.Add(' <w:rStyle w:val="' + StyleNameToStyleID(AStyle) + '"/>');
oDocXML.Add(indDec, '</w:rPr>');
End;
oDocXML.Add(' <w:t>' + EscapeHTML(sTemp) + '</w:t>');
oDocXML.Add(False, '</w:r>');
oDocXML.Add(indDec, '</w:r>');
End;
// Deal with the Tabs, LF and CRs appropriately
If sText[i] = #11 Then
If sText[i] = #09 Then
oDocXML.Add(' <w:r><w:tab/></w:r>')
Else If sText[i] In [#10, #13] Then
Else If sText[i] In [#10, #11, #13] Then
Begin
oDocXML.Add(' <w:r><w:br/></w:r>');
@ -525,10 +597,27 @@ Var
oEntity: TvEntity;
sTemp: String;
Begin
oDocXML.Add(True, '<w:p>');
oDocXML.Add(indInc, '<w:p>');
// Add the Paragraph Properties
oDocXML.Add(indInc, '<w:pPr>', indInc);
If Assigned(AParagraph.Style) Then
AddParagraphProperties(AParagraph.Style);
oDocXML.Add(Format('<w:pStyle w:val="%s"/>',
[StyleNameToStyleID(AParagraph.Style)]));
If AParagraph.UseLocalAlignment Then
oDocXML.Add('<w:jc w:val="' + LU_ALIGN[AParagraph.LocalAlignment] + '"/>');
If Assigned(AParagraph.ListStyle) Then
Begin
oDocXML.Add('<w:numPr>');
oDocXML.Add(indInc, Format('<w:ilvl w:val="%d"/>', [AParagraph.ListStyle.Level]));
oDocXML.Add(indDec, '<w:numId w:val="1"/>'); // wtf is numID??
oDocXML.Add('</w:numPr>');
End;
oDocXML.Add(indDec, '</w:pPr>', indDec);
For i := 0 To AParagraph.GetEntitiesCount - 1 Do
Begin
@ -554,20 +643,25 @@ Var
Raise Exception.Create('Unsupported Entity: ' + oEntity.ClassName);
End;
oDocXML.Add(False, '</w:p>');
oDocXML.Add(indDec, '</w:p>');
End;
Procedure ProcessRichText(ARichText: TvRichText);
Procedure ProcessBulletList(ABulletList: TvBulletList);
Var
i: Integer;
oEntity: TvEntity;
Begin
For i := 0 To ARichText.GetEntitiesCount - 1 Do
For i := 0 To ABulletList.GetEntitiesCount - 1 Do
Begin
oEntity := ARichText.GetEntity(i);
oEntity := ABulletList.GetEntity(i);
If oEntity Is TvParagraph Then
ProcessParagraph(TvParagraph(oEntity))
Begin
If Not Assigned(TvParagraph(oEntity).Style) Then
TvParagraph(oEntity).Style := ABulletList.Style;
ProcessParagraph(TvParagraph(oEntity));
End
Else
Raise Exception.Create('Unsupported entity ' + oEntity.ClassName);
End;
@ -624,12 +718,11 @@ Var
// For the final pagesequence only w:sectPr shouldn't be wrapped inside w:p or w:pPr
If Not ALastPage Then
Begin
oDocXML.Add(True, '<w:p>');
oDocXML.Add(True, '<w:pPr>');
oDocXML.Add(indInc, '<w:p>');
oDocXML.Add(indInc, '<w:pPr>');
End;
oDocXML.Add(True, '<w:sectPr>');
oDocXML.IncIndent;
oDocXML.Add(indInc, '<w:sectPr>', indInc);
ProcessHeaderFooter(APageSequence.Header, TAG_HEADER);
ProcessHeaderFooter(APageSequence.Footer, TAG_FOOTER);
@ -660,21 +753,215 @@ Var
//<w:pgMar w:top="1440" w:right="1440" w:bottom="1440" w:left="1440" w:header="708" w:footer="708" w:gutter="0"/>
//<w:cols w:space="708"/>
//<w:docGrid w:linePitch="360"/>
oDocXML.DecIndent;
oDocXML.Add(False, '</w:sectPr>');
oDocXML.Add(indDec, '</w:sectPr>', indDec);
If Not ALastPage Then
Begin
oDocXML.Add(False, '</w:pPr>');
oDocXML.Add(False, '</w:p>');
oDocXML.Add(indDec, '</w:pPr>');
oDocXML.Add(indDec, '</w:p>');
End;
End;
Procedure AddTableBorderProperty(ATag: String; ABorder: TvTableBorder);
Var
sAttrib: String;
Begin
If ABorder.LineType <> tbtDefault Then
Begin
sAttrib := '';
If ABorder.LineType <> tbtNone Then
sAttrib := sAttrib + 'w:val="' + LU_BORDERTYPE[ABorder.LineType] + '" ';
sAttrib := sAttrib + 'w:space="' + mmToPointS(ABorder.Spacing) + '" ';
If ABorder.Width <> 0 Then
// Eights of a Point?? Really, they're just making this up...
sAttrib := sAttrib + 'w:sz="' + mmToPointS(Min(96, Max(2, 8 * ABorder.Width))) + '" '
Else
// 4 is the minimum
sAttrib := sAttrib + 'w:sz="4" ';
If ABorder.Color <> FPColor(0, 0, 0, 0) Then
sAttrib := sAttrib + 'w:color="' + FPColorToRGBHexString(ABorder.Color) + '" '
Else
sAttrib := sAttrib + 'w:color="auto" ';
oDocXML.Add(Format('<%s %s/>', [ATag, Trim(sAttrib)]));
End;
End;
Procedure ProcessTable(ATable: TvTable);
Var
i, j, k: Integer;
oRow: TvTableRow;
oCell: TvTableCell;
//sTemp : String;
Begin
oDocXML.Add(indInc, '<w:tbl>');
// Add the table properties
oDocXML.Add(indInc, '<w:tblPr>', indInc);
If ATable.PreferredWidth.Value <> 0 Then
oDocXML.Add(Format('<w:tblW %s />', [DimAttribs(ATable.PreferredWidth)]));
oDocXML.Add(indNone, '<w:tblBorders>', indInc);
AddTableBorderProperty('w:left', ATable.Borders.Left);
AddTableBorderProperty('w:right', ATable.Borders.Right);
AddTableBorderProperty('w:top', ATable.Borders.Top);
AddTableBorderProperty('w:bottom', ATable.Borders.Bottom);
AddTableBorderProperty('w:insideH', ATable.Borders.InsideHoriz);
AddTableBorderProperty('w:insideV', ATable.Borders.InsideVert);
oDocXML.Add(indNone, '</w:tblBorders>', indDec);
If Assigned(ATable.Style) Then
oDocXML.Add('<w:tblStyle w:val="' + StyleNameToStyleID(ATable.Style) + '" />');
If ATable.CellSpacing <> 0 Then
oDocXML.Add('<w:tblCellSpacing w:w="' + mmToTwipsS(ATable.CellSpacing) +
'" w:type="dxa" />');
If ATable.BackgroundColor <> FPColor(0, 0, 0, 0) Then
oDocXML.Add(Format('<w:shd w:val="clear" w:color="auto" w:fill="%s"/>',
[FPColorToRGBHexString(ATable.BackgroundColor)]));
oDocXML.Add(indDec, '</w:tblPr>', indDec);
// Define the grid. Grid is used to determine cell widths
// and boundaries
oDocXML.Add(indInc, '<w:tblGrid>', indInc);
// Percent cannot be set here, only absolutes
If ATable.ColWidthsUnits = dimMillimeter Then
For k := Low(ATable.ColWidths) To High(ATable.ColWidths) Do
oDocXML.Add(Format('<w:gridCol w:w="%s" />', [mmToTwipsS(ATable.ColWidths[k])]))
Else If ATable.ColWidthsUnits = dimPoint Then
For k := Low(ATable.ColWidths) To High(ATable.ColWidths) Do
oDocXML.Add(Format('<w:gridCol w:w="%s" />',
[IntToStr(Round(20 * ATable.ColWidths[k]))]));
oDocXML.Add(indDec, '</w:tblGrid>', indDec);
For i := 0 To ATable.GetRowCount - 1 Do
Begin
oRow := ATable.GetRow(i);
oDocXML.Add(indInc, '<w:tr>');
// Add the Row Properties
oDocXML.Add(indInc, '<w:trPr>', indInc);
If oRow.Header Then
oDocXML.Add('<w:tblHeader />');
If Not oRow.AllowSplitAcrossPage Then
oDocXML.Add('<w:cantSplit />');
If oRow.CellSpacing <> 0 Then
oDocXML.Add('<w:tblCellSpacing w:w="' + mmToTwipsS(oRow.CellSpacing) +
'" w:type="dxa" />');
{ TODO : w:hRule="exact", "auto" }
If oRow.Height <> 0 Then
oDocXML.Add('<w:trHeight w:val="' + mmToTwipsS(oRow.Height) +
'" w:hRule="atLeast"/>');
// Row Background Colour can't be applied here, have to apply to each cell in turn...
oDocXML.Add(indDec, '</w:trPr>', indDec);
For j := 0 To oRow.GetCellCount - 1 Do
Begin
oCell := oRow.GetCell(j);
oDocXML.Add(indInc, '<w:tc>');
// Add the Cell Properties
oDocXML.Add(indInc, '<w:tcPr>', indInc);
oDocXML.Add(indNone, '<w:tcBorders>', indInc);
AddTableBorderProperty('w:left', oCell.Borders.Left);
AddTableBorderProperty('w:right', oCell.Borders.Right);
AddTableBorderProperty('w:top', oCell.Borders.Top);
AddTableBorderProperty('w:bottom', oCell.Borders.Bottom);
oDocXML.Add(indNone, '</w:tcBorders>', indDec);
// Row background color can't be applied at the row level, so we'll
// apply it to each cell in turn (only if the cell doesn't have it's
// own value assigned)
If oCell.BackgroundColor <> FPColor(0, 0, 0, 0) Then
oDocXML.Add(Format('<w:shd w:val="clear" w:color="auto" w:fill="%s"/>',
[FPColorToRGBHexString(oCell.BackgroundColor)]))
Else If oRow.BackgroundColor <> FPColor(0, 0, 0, 0) Then
oDocXML.Add(Format('<w:shd w:val="clear" w:color="auto" w:fill="%s"/>',
[FPColorToRGBHexString(oRow.BackgroundColor)]));
// Either use Cell Preferred Width, or ColWidths if defined as %
If oCell.PreferredWidth.Value <> 0 Then
oDocXML.Add(Format('<w:tcW %s />', [DimAttribs(oCell.PreferredWidth)]))
Else If (j <= High(ATable.ColWidths)) Then
oDocXML.Add(Format('<w:tcW %s />',
[DimAttribs(Dimension(ATable.ColWidths[j],
ATable.ColWidthsUnits))]));
If ATable.ColWidthsUnits <> dimPercent Then
oDocXML.Add('<w:gridSpan w:val="' + IntToStr(oCell.SpannedCols) + '" />');
oDocXML.Add('<w:vAlign w:val="' + LU_V_ALIGN[oCell.VerticalAlignment] + '" />');
oDocXML.Add(indDec, '</w:tcPr>', indDec);
ProcessRichText(oCell);
oDocXML.Add(indDec, '</w:tc>');
End;
oDocXML.Add(indDec, '</w:tr>');
End;
oDocXML.Add(indDec, '</w:tbl>');
End;
(*
Procedure ProcessImage(AImage : TvImage);
begin
end;
*)
Procedure ProcessRichText(ARichText: TvRichText);
Var
i: Integer;
oEntity: TvEntity;
Begin
For i := 0 To ARichText.GetEntitiesCount - 1 Do
Begin
oEntity := ARichText.GetEntity(i);
If oEntity Is TvParagraph Then
ProcessParagraph(TvParagraph(oEntity))
Else If oEntity Is TvBulletList Then
ProcessBulletList(TvBulletList(oEntity))
Else If oEntity Is TvTable Then
ProcessTable(TvTable(oEntity))
Else If oEntity Is TvRichText Then
ProcessRichText(TvRichText(oEntity))
(*
Else If oEntity Is TvImage Then
ProcessImage(TvImage(oEntity))
*)
Else
Raise Exception.Create('Unsupported entity ' + oEntity.ClassName);
End;
End;
Var
oPage: TvPage;
oPageSequence: TvTextPageSequence;
oPageEntity: TvEntity;
iPage, i: Integer;
iPage: Integer;
oFile: TFileInformation;
Begin
oFile := FFiles.AddXMLFile(OOXML_CONTENTTYPE_DOCUMENT, OOXML_PATH_DOCUMENT,
@ -686,7 +973,7 @@ Begin
oDocXML.Add(Format('<w:document %s>', [OOXML_DOCUMENT_NAMESPACE +
'xml:space="preserve"']));
oDocXML.Add(True, '<w:body>');
oDocXML.Add(indInc, '<w:body>');
For iPage := 0 To FData.GetPageCount - 1 Do
Begin
@ -696,26 +983,14 @@ Begin
Begin
oPageSequence := TvTextPageSequence(oPage);
// Process the page contents
For i := 0 To oPageSequence.GetEntitiesCount - 1 Do
Begin
oPageEntity := oPageSequence.GetEntity(i);
If oPageEntity Is TvParagraph Then
ProcessParagraph(TvParagraph(oPageEntity))
Else If oPageEntity Is TvRichText Then
ProcessRichText(TvRichText(oPageEntity))
Else
{ TODO : What other entities in TvTextPageSequence do we need to process? }
Raise Exception.Create('Unsupported Entity: ' + oPageEntity.ClassName);
End;
ProcessRichText(oPageSequence.MainText);
// Add any dimensions, headers, footers etc
FinalisePage(oPageSequence, iPage = FData.GetPageCount - 1);
End;
End;
oDocXML.Add(False, '</w:body>');
oDocXML.Add(indDec, '</w:body>');
oDocXML.Add('</w:document>');
End;
@ -732,12 +1007,11 @@ End;
Procedure TvDOCXVectorialWriter.PrepareTextRunStyle(ADoc: TIndentedStringList;
AStyle: TvStyle);
Const
BoolAsString: Array[Boolean] Of String = ('off', 'on');
Var
sTemp: String;
Begin
ADoc.Add(True, '<w:rPr>');
ADoc.IncIndent;
ADoc.Add(indInc, '<w:rPr>', indInc);
If (spbfFontName In AStyle.SetElements) And (AStyle.Font.Name <> '') Then
ADoc.Add('<w:rFonts w:ascii="' + AStyle.Font.Name + '" w:hAnsi="' +
@ -748,16 +1022,16 @@ Begin
ADoc.Add('<w:sz w:val="' + IntToStr(2 * AStyle.Font.Size) + '"/>');
If spbfFontBold In AStyle.SetElements Then
ADoc.Add('<w:b w:val="' + BoolAsString[AStyle.Font.Bold] + '"/>');
ADoc.Add('<w:b w:val="' + LU_ON_OFF[AStyle.Font.Bold] + '"/>');
If spbfFontItalic In AStyle.SetElements Then
ADoc.Add('<w:i w:val="' + BoolAsString[AStyle.Font.Italic] + '"/>');
ADoc.Add('<w:i w:val="' + LU_ON_OFF[AStyle.Font.Italic] + '"/>');
If spbfFontUnderline In AStyle.SetElements Then
ADoc.Add('<w:u w:val="' + BoolAsString[AStyle.Font.Underline] + '"/>');
ADoc.Add('<w:u w:val="' + LU_ON_OFF[AStyle.Font.Underline] + '"/>');
If spbfFontStrikeThrough In AStyle.SetElements Then
ADoc.Add('<w:strike w:val="' + BoolAsString[AStyle.Font.StrikeThrough] + '"/>');
ADoc.Add('<w:strike w:val="' + LU_ON_OFF[AStyle.Font.StrikeThrough] + '"/>');
If CompareColors(AStyle.Font.Color, FPColor(0, 0, 0, 0)) <> 0 Then
ADoc.Add('<w:color w:val="' + FPColorToRGBHexString(AStyle.Font.Color) + '"/>');
@ -769,7 +1043,7 @@ Begin
// Don't bother adding an empty tag..
If ADoc[ADoc.Count - 1] <> '<w:rPr>' Then
ADoc.Add(False, '</w:rPr>')
ADoc.Add(indDec, '</w:rPr>')
Else
Begin
ADoc.Delete(ADoc.Count - 1);
@ -779,107 +1053,172 @@ End;
Procedure TvDOCXVectorialWriter.PrepareStyles;
Var
oStyleXML: TIndentedStringList;
Procedure PrepareParagraphStyle(AStyle: TvStyle; AType: String);
Const
AlignmentAsString: Array [TvStyleAlignment] Of String =
('left', 'right', 'both', 'center');
Var
sTemp: String;
Begin
oStyleXML.Add(True, '<w:style w:type="' + AType + '" w:styleId="' +
StyleNameToStyleID(AStyle) + '">');
// Add the name and inheritance values
oStyleXML.Add(' <w:name w:val="' + AStyle.Name + '"/>');
If Assigned(AStyle.Parent) Then
oStyleXML.Add(' <w:basedOn w:val="' + StyleNameToStyleID(
AStyle.Parent) + '"/> ');
{ TODO : <w:qFormat/> doesn't always need to be set, but I don't yet understand the rules... }
oStyleXML.Add(' <w:qFormat/> '); // Latent Style Primary Style Setting.
{ TODO : Specification states you CANNOT redeclare a identical property
declared in a parent. At the moment code is relying on Styles
correctly defined up through hierarchy }
If AType = 'paragraph' Then
Begin
// Add the Paragraph Properties
oStyleXML.Add(True, '<w:pPr>');
oStyleXML.IncIndent;
sTemp := '';
If AStyle.MarginTop <> 0 Then
sTemp := sTemp + ' w:before="' + mmToTwipsS(AStyle.MarginTop) + '"';
If AStyle.MarginBottom <> 0 Then
sTemp := sTemp + ' w:after="' + mmToTwipsS(AStyle.MarginBottom) + '"';
If sTemp <> '' Then
oStyleXML.Add('<w:spacing' + sTemp + '/>');
sTemp := '';
If AStyle.MarginLeft <> 0 Then
sTemp := sTemp + ' w:left="' + mmToTwipsS(AStyle.MarginLeft) + '"';
If AStyle.MarginRight <> 0 Then
sTemp := sTemp + ' w:right="' + mmToTwipsS(AStyle.MarginRight) + '"';
If sTemp <> '' Then
oStyleXML.Add('<w:ind' + sTemp + '/>');
If spbfAlignment In AStyle.SetElements Then
oStyleXML.Add('<w:jc w:val="' + AlignmentAsString[AStyle.Alignment] + '"/>');
oStyleXML.DecIndent;
If oStyleXML[oStyleXML.Count - 1] <> '<w:pPr>' Then
oStyleXML.Add(False, '</w:pPr>')
Else
Begin
oStyleXML.Delete(oStyleXML.Count - 1);
oStyleXML.DecIndent;
End;
End;
// Now add the actual formatting (rPr = Run Properties).
PrepareTextRunStyle(oStyleXML, AStyle);
oStyleXML.Add(False, '</w:style> ');
End;
Var
sType, sTemp: String;
i: Integer;
oXML: TIndentedStringList;
oStyle: TvStyle;
oFile: TFileInformation;
Begin
// Only add this file if there are any styles defined...
If FData.GetStyleCount > 0 Then
Begin
oFile := FFiles.AddXMLFile(OOXML_CONTENTTYPE_STYLES, OOXML_PATH_STYLES,
OOXML_TYPE_STYLES, [ftContentTypes, ftDocRelationships]);
oStyleXML := oFile.XML;
oXML := oFile.XML;
oStyleXML.Clear;
oStyleXML.Add(XML_HEADER);
oStyleXML.Add(Format('<w:styles %s>', [OOXML_DOCUMENT_NAMESPACE]));
oXML.Clear;
oXML.Add(XML_HEADER);
oXML.Add(Format('<w:styles %s>', [OOXML_DOCUMENT_NAMESPACE]));
For i := 0 To FData.GetStyleCount - 1 Do
Begin
oStyle := FData.GetStyle(i);
If oStyle.GetKind In [vskTextBody, vskHeading] Then
PrepareParagraphStyle(oStyle, 'paragraph')
sType := 'paragraph'
Else If oStyle.GetKind In [vskTextSpan] Then
PrepareParagraphStyle(oStyle, 'character')
sType := 'character'
Else
{ TODO : handle the other StyleKinds }
Raise Exception.Create('Unsupported StyleKind in ' + oStyle.Name);
oXML.Add(indInc, '<w:style w:type="' + sType + '" w:styleId="' +
StyleNameToStyleID(oStyle) + '">');
// Add the name and inheritance values
oXML.Add(' <w:name w:val="' + oStyle.Name + '"/>');
If Assigned(oStyle.Parent) Then
oXML.Add(' <w:basedOn w:val="' + StyleNameToStyleID(
oStyle.Parent) + '"/> ');
{ TODO : <w:qFormat/> doesn't always need to be set, but I don't yet understand the rules... }
oXML.Add(' <w:qFormat/> '); // Latent Style Primary Style Setting.
{ TODO : Specification states you CANNOT redeclare a identical property
declared in a parent. At the moment code is relying on Styles
correctly defined up through hierarchy }
If sType = 'paragraph' Then
Begin
// Add the Paragraph Properties
oXML.Add(indInc, '<w:pPr>', indInc);
// Define Before and After spacing
If (sseMarginTop In oStyle.SetElements) Or
(sseMarginBottom In oStyle.SetElements) Then
Begin
sTemp := '';
If sseMarginTop In oStyle.SetElements Then
sTemp := sTemp + ' w:before="' + mmToTwipsS(oStyle.MarginTop) + '"';
If sseMarginBottom In oStyle.SetElements Then
sTemp := sTemp + ' w:after="' + mmToTwipsS(oStyle.MarginBottom) + '"';
oXML.Add(Format('<w:spacing %s/>', [sTemp]));
End;
If (sseMarginLeft In oStyle.SetElements) Or
(sseMarginRight In oStyle.SetElements) Then
Begin
sTemp := '';
If sseMarginLeft In oStyle.SetElements Then
sTemp := sTemp + ' w:left="' + mmToTwipsS(oStyle.MarginLeft) + '"';
If sseMarginRight In oStyle.SetElements Then
sTemp := sTemp + ' w:right="' + mmToTwipsS(oStyle.MarginRight) + '"';
oXML.Add(Format('<w:ind %s/>', [sTemp]));
End;
// Alignment
If spbfAlignment In oStyle.SetElements Then
oXML.Add('<w:jc w:val="' + LU_ALIGN[oStyle.Alignment] + '"/>');
// Suppress Spacing between identical paragraphs...
If oStyle.SuppressSpacingBetweenSameParagraphs Then
oXML.Add('<w:contextualSpacing/>');
oXML.DecIndent;
If oXML[oXML.Count - 1] <> '<w:pPr>' Then
oXML.Add(indDec, '</w:pPr>')
Else
Begin
oXML.Delete(oXML.Count - 1);
oXML.DecIndent;
End;
End;
// Now add the actual formatting (rPr = Run Properties).
PrepareTextRunStyle(oXML, oStyle);
oXML.Add(indDec, '</w:style> ');
End;
oStyleXML.Add('</w:styles>');
oXML.Add('</w:styles>');
End;
End;
Procedure TvDOCXVectorialWriter.PrepareNumbering;
Var
oXML: TIndentedStringList;
oStyle: TvListStyle;
oFile: TFileInformation;
i: Integer;
Begin
// Only add this file if there are any List styles defined...
If FData.GetListStyleCount > 0 Then
Begin
oFile := FFiles.AddXMLFile(OOXML_CONTENTTYPE_NUMBERING,
OOXML_PATH_NUMBERING, OOXML_TYPE_NUMBERING, [ftContentTypes, ftDocRelationships]);
oXML := oFile.XML;
oXML.Clear;
oXML.Add(XML_HEADER);
oXML.Add(Format('<w:numbering %s>', [OOXML_DOCUMENT_NAMESPACE]));
// wtf is abstractNumId??
oXML.Add(indInc, '<w:abstractNum w:abstractNumId="0">', indInc);
// Optional
//oXML.Add('<w:multiLevelType w:val="hybridMultilevel"/>');
For i := 0 To FData.GetListStyleCount - 1 Do
Begin
oStyle := FData.GetListStyle(i);
oXML.Add(Format('<w:lvl w:ilvl="%d">', [oStyle.Level]), indInc);
oXML.Add('<w:start w:val="1"/>'); // Numbered lists only
oXML.Add('<w:numFmt w:val="' + LU_KIND[oStyle.Kind] + '"/>');
oXML.Add('<w:lvlText w:val="' + oStyle.Prefix + '"/>');
oXML.Add('<w:lvlJc w:val="' + LU_ALIGN[oStyle.Alignment] + '"/>');
oXML.Add('<w:pPr>');
oXML.Add(Format(' <w:ind w:left="%s" w:hanging="%s"/>',
[mmToTwipsS(oStyle.MarginLeft), mmToTwipsS(oStyle.HangingIndent)]));
oXML.Add('</w:pPr>');
oXML.Add('<w:rPr>');
oXML.Add(Format(' <w:rFonts w:ascii="%s" w:hAnsi="%s"/>',
[oStyle.PrefixFontName, oStyle.PrefixFontName]));
oXML.Add('</w:rPr>');
oXML.Add('</w:lvl>', indDec);
End;
oXML.Add(indDec, '</w:abstractNum>', indDec);
// wtf is abstrctNumID??
// obviously related to w:abstractNum above...
oXML.Add(indInc, '<w:num w:numId="1">');
oXML.Add(' <w:abstractNumId w:val="0"/>');
oXML.Add(indDec, '</w:num>');
oXML.Add('</w:numbering>');
End;
End;
@ -910,6 +1249,7 @@ Begin
PrepareStyles;
PrepareDocument;
PrepareNumbering;
// These documents need building up with details of all included files,
// not worth the overhead of handling as StringLists

11
components/fpvectorial/examples/fpvtextwritetest2.lpi
View File

@ -1,4 +1,4 @@
<?xml version="1.0"?>
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
@ -39,12 +39,17 @@
<DefaultFilename Value="..\fpvectorialpkg.lpk" Prefer="True"/>
</Item1>
</RequiredPackages>
<Units Count="1">
<Units Count="2">
<Unit0>
<Filename Value="fpvtextwritetest2.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpvtextwritetest2"/>
</Unit0>
<Unit1>
<Filename Value="..\odtxmlvectorialwriter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="odtxmlvectorialwriter"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
@ -55,10 +60,12 @@
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value=".."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Other>
<CompilerMessages>
<IgnoredMessages idx5024="True"/>
<UseMsgFile Value="True"/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>

320
components/fpvectorial/examples/fpvtextwritetest2.pas
View File

@ -1,7 +1,8 @@
{
FPVectorial example application for writing a text document file to disk.
Author: Felipe Monteiro de Carvalho
Author: Mike Thompson
Felipe Monteiro de Carvalho
License: Public Domain
}
@ -14,16 +15,30 @@ Uses
odtvectorialwriter,
fpvutils,
fpvectorialpkg,
SysUtils;
docxvectorialwriter,
SysUtils, FPImage;
{$R *.res}
Const
ONE_POINT_IN_MM = 0.35278;
Var
Vec: TvVectorialDocument;
Page: TvTextPageSequence;
CurParagraph: TvParagraph;
BoldStyle: TvStyle;
CenterStyle: TvStyle;
BoldTextStyle: TvStyle;
CenterParagraphStyle, Center2: TvStyle;
BulletList : TvBulletList;
dtTime : TDateTime;
CurText : TvText;
CurTable : TvTable;
CurRow : TvTableRow;
CurCell : TvTableCell;
i, j, iMax : Integer;
Begin
Vec := TvVectorialDocument.Create;
Try
@ -31,22 +46,25 @@ Begin
Vec.Width := 210;
Vec.Height := 297;
Vec.AddStandardODTTextDocumentStyles();
// Until there is a need, we will stick with supporting ODT styles
Vec.AddStandardTextDocumentStyles(vfODT);
Vec.StyleTextBody.MarginRight:=10;
Vec.StyleTextBody.SetElements:= Vec.StyleTextBody.SetElements + [sseMarginRight];
// Until a Template is available, create the Bold Style ourselves
BoldStyle := Vec.AddStyle();
BoldTextStyle := Vec.AddStyle();
// This implies this style should not be applied to Paragraphs
BoldStyle.Kind := vskTextSpan;
BoldStyle.Name := 'Bold';
BoldStyle.Font.Bold := True;
BoldStyle.SetElements := BoldStyle.SetElements + [spbfFontBold];
BoldTextStyle.Kind := vskTextSpan; // This implies this style should not be applied to Paragraphs
BoldTextStyle.Name := 'Bold';
BoldTextStyle.Font.Bold := True;
BoldTextStyle.SetElements := BoldTextStyle.SetElements + [spbfFontBold];
CenterStyle := Vec.AddStyle();
CenterStyle.ApplyOver(Vec.StyleTextBody);
CenterStyle.Name := 'Text Body Centered';
CenterStyle.Alignment := vsaCenter;
CenterStyle.SetElements := CenterStyle.SetElements + [spbfAlignment];
CenterParagraphStyle := Vec.AddStyle();
CenterParagraphStyle.ApplyOver(Vec.StyleTextBody);
CenterParagraphStyle.Name := 'Text Body Centered';
CenterParagraphStyle.Alignment := vsaCenter;
CenterParagraphStyle.SetElements := CenterParagraphStyle.SetElements + [spbfAlignment];
// First page sequence
Page := Vec.AddTextPageSequence();
@ -55,15 +73,15 @@ Begin
// Set the Header
CurParagraph := Page.Header.AddParagraph;
CurParagraph.Style := CenterStyle;
CurParagraph.AddText('Introduction to Lazarus and FreePascal').Style := BoldStyle;
CurParagraph.Style := CenterParagraphStyle;
CurParagraph.AddText('Introduction to Lazarus and FreePascal').Style := BoldTextStyle;
// Set the Footer
CurParagraph := Page.Footer.AddParagraph;
CurParagraph.Style := CenterStyle;
CurParagraph.AddText('Confidential' + #11 + 'Page x of y' + #11 +
CurParagraph.Style := CenterParagraphStyle;
CurParagraph.AddText('Confidential' + #09 + 'Page x of y' + #09 +
DateTimeToStr(Now)).Style :=
BoldStyle;
BoldTextStyle;
// Title
CurParagraph := Page.AddParagraph();
@ -75,7 +93,7 @@ Begin
CurParagraph.Style := Vec.StyleTextBody;
With CurParagraph Do
Begin
AddText('Lazarus ').Style := BoldStyle;
AddText('Lazarus ').Style := BoldTextStyle;
// Adding the Paragraph as a long string
AddText('is a free and open source development tool for the ' +
'Free Pascal compiler, which is also free and open source.');
@ -98,12 +116,12 @@ Begin
// Adding the Paragraph as a series of TvText's
// trailing space required
// Each TvText gets added as it's own text run inside the Word Doc
AddText('Lazarus ').Style := BoldStyle;
AddText('Lazarus ').Style := BoldTextStyle;
AddText('is a free cross-platform visual integrated development ');
AddText('environment (IDE) for rapid application development (RAD) ');
AddText('using the Free Pascal compiler supported dialects of Object ');
AddText('Pascal. Developers use ');
AddText('Lazarus ').Style := BoldStyle;
AddText('Lazarus ').Style := BoldTextStyle;
AddText('to create native code console ');
AddText('and graphical user interface (GUI) applications for the desktop ');
AddText('along with mobile devices, web applications, web services, ');
@ -112,6 +130,22 @@ Begin
AddText('compiler supports( Mac, Unix, Linux, Windows, etc). ');
End;
BulletList := Page.AddBulletList();
BulletList.Style := Vec.StyleList;
BulletList.AddItem(0, 'A What You See Is What You Get (WYSIWYG) visual windows layout designer');
BulletList.AddItem(1, 'An extensive set of GUI widgets or visual components such as edit boxes, buttons, dialogs, menus, etc.');
BulletList.AddItem(2, 'An extensive set of non visual components for common behaviors such as persistence of application settings');
BulletList.AddItem(3, 'A set of data connectivity components for MySQL, PostgresSQL, FireBird, Oracle, SQL Lite, Sybase, and others');
BulletList.AddItem(4, 'Data aware widget set that allows the developer to see data in visual components in the designer to assist with development');
BulletList.AddItem(5, 'Interactive code debugger');
BulletList.AddItem(5, 'Code completion');
BulletList.AddItem(4, 'Code templates');
BulletList.AddItem(3, 'Syntax highlighting');
BulletList.AddItem(2, 'Context sensitive help');
BulletList.AddItem(1, 'Text resource manager for internationalization');
BulletList.AddItem(0, 'Automatic code formatting');
BulletList.AddItem(0, 'The ability to create custom components');
// Empty line
CurParagraph := Page.AddParagraph();
CurParagraph.Style := Vec.StyleTextBody;
@ -124,27 +158,255 @@ Begin
// Set the Header
CurParagraph := Page.Header.AddParagraph;
CurParagraph.Style := CenterStyle;
CurParagraph.AddText('Testing Concepts').Style := BoldStyle;
CurParagraph.Style := CenterParagraphStyle;
CurParagraph.AddText('Testing Concepts').Style := BoldTextStyle;
// Title
CurParagraph := Page.AddParagraph();
CurParagraph.Style := Vec.StyleHeading2;
CurParagraph.AddText('Testing Strings');
// Test for XML tags
CurParagraph := Page.AddParagraph();
CurParagraph.Style := Vec.StyleTextBody;
CurText := CurParagraph.AddText('');
// Adding to the Paragraph by extending the TStringList inside a single TvText
// Each line will be added inside a new text run inside the Word Doc
// with a Soft Return inserted at the end of each line
With CurParagraph.AddText('').Value Do
With CurText.Value Do
Begin
Add(#11 + '<test>&"This shouldn''t break the resulting document."</test>' + #11);
Add(#11 + '<test>!@#$%^&*()_+=-~`;:{}[],./|\?</test>' + #11);
Add(#09 + '<test>&"This shouldn''t break the resulting document."</test>' + #09);
Add(#09 + '<test>!@#$%^&*()_+=-~`;:{}[],./|\?</test>' + #09);
End;
// Third page sequence
Page := Vec.AddTextPageSequence();
Page.Height := 297; // back to Portrait
Page.Width := 210;
// Set the Header
CurParagraph := Page.Header.AddParagraph;
CurParagraph.Style := CenterParagraphStyle;
CurParagraph.AddText('Testing Tables').Style := BoldTextStyle;
// Title
CurParagraph := Page.AddParagraph();
CurParagraph.Style := Vec.StyleHeading2;
CurParagraph.AddText('Manual Table');
CurTable := Page.AddTable;
CurTable.PreferredWidth := Dimension(100, dimPercent);
CurTable.CellSpacing := 0;
CurTable.Borders.Left.Width := 2 * ONE_POINT_IN_MM;
CurTable.Borders.Right.Width := 2 * ONE_POINT_IN_MM;
CurTable.Borders.Top.Width := 2 * ONE_POINT_IN_MM;
CurTable.Borders.Bottom.Width := 2 * ONE_POINT_IN_MM;
CurTable.Borders.InsideHoriz.LineType:=tbtSingle;
CurTable.Borders.InsideVert.LineType :=tbtDashed;
CurRow := CurTable.AddRow;
CurRow.BackgroundColor := RGBToFPColor(192, 192, 192);
CurRow.Header := True;
CurCell := CurRow.AddCell;
CurParagraph := CurCell.AddParagraph;
CurParagraph.AddText('First Cell, First Row');
CurCell := CurRow.AddCell;
CurParagraph := CurCell.AddParagraph;
CurParagraph.AddText('Second Cell, First Row');
CurCell := CurRow.AddCell;
CurParagraph := CurCell.AddParagraph;
CurParagraph.AddText('Third Cell, First Row');
CurRow := CurTable.AddRow;
CurRow.CellSpacing := ONE_POINT_IN_MM;
CurCell := CurRow.AddCell;
CurParagraph := CurCell.AddParagraph;
CurParagraph.AddText('First Cell, Second Row');
CurCell := CurRow.AddCell;
CurCell.Borders.Left.LineType := tbtDouble;
CurCell.Borders.Left.Color := RGBToFPColor(255, 0, 0);
CurCell.Borders.Right.LineType := tbtDouble;
CurCell.Borders.Right.Color := RGBToFPColor(255, 0, 0);
CurCell.Borders.Top.LineType := tbtDouble;
CurCell.Borders.Top.Color := RGBToFPColor(255, 0, 0);
CurCell.Borders.Bottom.LineType := tbtDouble;
CurCell.Borders.Bottom.Color := RGBToFPColor(255, 0, 0);
CurCell.VerticalAlignment:=vaCenter;
CurParagraph := CurCell.AddParagraph;
CurParagraph.Style := CenterParagraphStyle;
CurParagraph.AddText('Second Cell, Second Row'+#13+'This should have a red double border');
CurCell := CurRow.AddCell;
CurParagraph := CurCell.AddParagraph;
CurParagraph.AddText('Third Cell, Second Row');
CurRow := CurTable.AddRow;
CurCell := CurRow.AddCell;
CurParagraph := CurCell.AddParagraph;
CurParagraph.AddText('First Cell, Third Row');
CurCell := CurRow.AddCell;
CurParagraph := CurCell.AddParagraph;
CurParagraph.AddText('Second Cell, Third Row');
CurCell := CurRow.AddCell;
CurParagraph := CurCell.AddParagraph;
CurParagraph.AddText('Third Cell, Third Row');
// Style for Subsequent Tables
Center2 := Vec.AddStyle();
Center2.Name := 'Table Body Centered';
Center2.Font.Name := 'Verdana';
Center2.Font.Size := 8;
Center2.Alignment := vsaCenter;
Center2.MarginTop:=2*ONE_POINT_IN_MM;
Center2.MarginBottom:=2*ONE_POINT_IN_MM;
Center2.SetElements := [spbfFontSize, spbfFontName, spbfAlignment, sseMarginTop, sseMarginBottom];
// Title
CurParagraph := Page.AddParagraph();
CurParagraph := Page.AddParagraph();
CurParagraph.Style := Vec.StyleHeading2;
CurParagraph.AddText('Coded Table #1');
// Second Table
CurTable := Page.AddTable;
CurTable.PreferredWidth := Dimension(100, dimPercent);
For i := 0 To 20 do
Begin
CurRow := CurTable.AddRow;
// Header Row
If i=0 Then
Begin
CurRow.BackgroundColor := RGBToFPColor(192, 192, 192);
CurRow.Header := True;
end;
for j := 0 to 4 Do
begin
CurCell := CurRow.AddCell;
CurParagraph := CurCell.AddParagraph;
CurParagraph.Style := Center2;
If i=0 Then
CurParagraph.AddText(Format('Header %d', [j])).Style := BoldTextStyle
Else
CurParagraph.AddText(Format('%d x %d', [i, j]));
end;
end;
CurParagraph := Page.AddParagraph();
CurParagraph := Page.AddParagraph();
CurParagraph.Style := Vec.StyleHeading2;
CurParagraph.AddText('Coded Table #2');
// Third Table
CurTable := Page.AddTable;
CurTable.PreferredWidth := Dimension(100, dimPercent);
CurTable.ColWidthsUnits:=dimMillimeter;
CurTable.AddColWidth(15);
CurTable.AddColWidth(20);
CurTable.AddColWidth(20);
CurTable.AddColWidth(20);
CurTable.AddColWidth(79.5); // For Word (and possibly odt), this only has to be close.
// Table.Width=100% means last col is autocalculated
// Added a close value for other renderers such as Wordpad that
// might not support the autocalculation
// Header Row
CurRow := CurTable.AddRow;
CurRow.BackgroundColor := RGBToFPColor($64, $95, $ED);
CurRow.Header := True;
for j := 0 to 4 Do
begin
CurCell := CurRow.AddCell;
CurParagraph := CurCell.AddParagraph;
CurParagraph.Style := Center2;
Case j of
0: CurParagraph.LocalAlignment := vsaLeft;
1: CurParagraph.LocalAlignment := vsaRight;
end;
CurParagraph.AddText(Format('Header %d', [j])).Style := BoldTextStyle
End;
// Data Rows
For i := 1 To 20 do
Begin
CurRow := CurTable.AddRow;
if (i Mod 2 = 1) Then
CurRow.BackgroundColor := RGBToFPColor(224, 224, 224);
If (i mod 5 <> 1) Then
iMax := 4
Else
//iMax := 4;
iMax := 3;
for j := 0 to iMax Do
begin
CurCell := CurRow.AddCell;
CurParagraph := CurCell.AddParagraph;
CurParagraph.Style := Center2;
Case j of
0: CurParagraph.LocalAlignment := vsaLeft;
1: CurParagraph.LocalAlignment := vsaRight;
end;
If (iMax=3) And (j=3) Then
Begin
CurCell.SpannedCols := 2;
CurParagraph.AddText(Format('Merged Cells (%d x %d) & (%d x %d)', [i, j, i, j+1]));
end
Else
CurParagraph.AddText(Format('(%d x %d)', [i, j]));
end;
end;
(*
// Fourth page sequence
Page := Vec.AddTextPageSequence();
Page.Height := 297;
Page.Width := 210;
// Set the Header
CurParagraph := Page.Header.AddParagraph;
CurParagraph.Style := CenterParagraphStyle;
CurParagraph.AddText('Testing Images').Style := BoldTextStyle;
// Title
CurParagraph := Page.AddParagraph();
CurParagraph.Style := Vec.StyleHeading2;
CurParagraph.AddText('Image 1');
*)
dtTime := Now;
Vec.WriteToFile('text_output.docx', vfDOCX);
WriteLn('Native docx writer: '+Format('%.1f msec', [24*60*60*1000*(Now-dtTime)]));
dtTime := Now;
Vec.WriteToFile('text_output.odt', vfODT);
WriteLn('Native odt writer: '+Format('%.1f msec', [24*60*60*1000*(Now-dtTime)]));
Finally
Vec.Free;
End;

411
components/fpvectorial/fpvectorial.pas
View File

@ -30,6 +30,7 @@ uses
Classes, SysUtils, Math, TypInfo,
// FCL-Image
fpcanvas, fpimage,
// LCL
lazutf8
{$ifdef USE_LCL_CANVAS}
@ -88,6 +89,8 @@ const
STR_FPVECTORIAL_TEXT_HEIGHT_SAMPLE = 'Ćą';
NUM_MAX_LISTSTYLES = 8;
type
TvCustomVectorialWriter = class;
TvCustomVectorialReader = class;
@ -163,16 +166,18 @@ type
Kind: TvStyleKind;
Alignment: TvStyleAlignment;
HeadingLevel: Integer;
ListLevel: Integer; // Only utilized if it is inside a TvBulletList. zero is the first level, 1 the second, and so on
//
Pen: TvPen;
Brush: TvBrush;
Font: TvFont;
//
MarginTop, MarginBottom, MarginLeft, MarginRight: Double; // in mm
SuppressSpacingBetweenSameParagraphs : Boolean;
//
SetElements: TvSetStyleElements;
//
Constructor Create;
function GetKind: TvStyleKind; // takes care of parenting
procedure Clear();
procedure CopyFrom(AFrom: TvStyle);
@ -180,6 +185,25 @@ type
function CreateStyleCombinedWithParent: TvStyle;
end;
TvListStyleKind = (vlskBullet,
vlskDecimal, // 0, 1, 2, 3...
vlskLowerLetter, // a, b, c, d...
vlsLowerRoman, // i, ii, iii, iv....
vlskUpperLetter, // A, B, C, D...
vlsUpperRoman // I, II, III, IV....
);
TvListStyle = Class
Kind : TvListStyleKind;
Level : Integer;
// Start : Integer; // For numbered lists ??
Prefix : String; // Suspect this can be more complex than a single char
PrefixFontName : String; // Not used by odt...
MarginLeft : Double; // mm
HangingIndent : Double; //mm
Alignment : TvStyleAlignment;
end;
{ Coordinates and polyline segments }
T3DPoint = record
@ -837,9 +861,14 @@ type
{ TvParagraph }
TvParagraph = class(TvEntityWithSubEntities)
public
FLocalAlignment : TvStyleAlignment; // Provides localised overwrite of style alignment
private
procedure SetLocalAlignment(AValue: TvStyleAlignment);
public // TODO: LocalAlignment subject to approval by Felipe
UseLocalAlignment : Boolean; // Provides localised overwrite of style alignment
Width, Height: Double;
AutoExpand: TvRichTextAutoExpand;
ListStyle : TvListStyle; // For Bulleted or Numbered Lists...
constructor Create(APage: TvPage); override;
destructor Destroy; override;
function AddText(AText: string): TvText;
@ -847,6 +876,8 @@ type
procedure Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
Property LocalAlignment : TvStyleAlignment Read FLocalAlignment Write SetLocalAlignment;
end;
{@@
@ -863,7 +894,7 @@ type
TvBulletList = class(TvEntityWithSubEntities)
public
constructor Create(APage: TvPage);
constructor Create(APage: TvPage); override; // MJT 31/08 added override;
destructor Destroy; override;
function AddItem(ALevel: Integer; ASimpleText: string): TvParagraph;
{function TryToSelect(APos: TPoint; var ASubpart: Cardinal): TvFindEntityResult; override;
@ -879,6 +910,12 @@ type
of elements will be all adjusted to fit the TvRichText area
}
// Forward reference as Table Cells are TvRichText which in turn
// can also contain tables...
TvTable = Class;
(*
TvImage = Class;
*)
{ TvRichText }
TvRichText = class(TvEntityWithSubEntities)
@ -890,6 +927,8 @@ type
// Data writing methods
function AddParagraph: TvParagraph;
function AddBulletList: TvBulletList;
function AddTable: TvTable;
//function AddImage: TvImage;
//
function TryToSelect(APos: TPoint; var ASubpart: Cardinal): TvFindEntityResult; override;
procedure Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
@ -897,6 +936,129 @@ type
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
end;
(* Support for Adding Tables to the document
Each Cell is a TvRichText to allow full formatted text contents
*)
TvUnits = (dimMillimeter, dimPercent, dimPoint);
TvDimension = record
Value : Double;
Units : TvUnits;
end;
// Use tbtDefault if you don't want the Border settings to be written out
TvTableBorderType = (tbtSingle, tbtDashed, tbtDouble, tbtNone, tbtDefault);
TvTableBorder = record
LineType : TvTableBorderType;
Spacing : Double; // mm, default 0
Color : TFPColor; // Ignored if (0, 0, 0, 0)
Width : Double; // mm, default 0. Should really be in point for fine control
end;
// Can be applied to Tables AND Cells
TvTableBorders = record
Left : TvTableBorder;
Right : TvTableBorder;
Top : TvTableBorder;
Bottom : TvTableBorder;
InsideHoriz : TvTableBorder; // InsideXXX not normally applied to cells
InsideVert : TvTableBorder; // (MS Word Table Styles has an exception)
end;
{ TvTableCell }
TvVerticalAlignment = (vaTop, vaBottom, vaCenter, cvaBoth);
// Horizontal alignment taken from Paragraph Style
TvTableCell = Class(TvRichText)
Public
// MJT to Felipe: It may be that Borders can be
// added to TvRichText if odt supports paragraph
// borders, in which case we can refactor a little and
// rename TvTableBorders
Borders : TvTableBorders; // Defaults to be ignored (tbtDefault)
PreferredWidth : TvDimension; // Optional
VerticalAlignment : TvVerticalAlignment; // Defaults to vaTop
BackgroundColor : TFPColor; // Optional
SpannedCols : Integer; // For merging horiz cells. Default 1.
// See diagram above TvTable Class
constructor Create(APage: TvPage); override;
end;
{ TvTableRow }
TvTableRow = Class(TvNamedEntity)
private
Cells : TFPList;
Public
Height : Double; // Units mm. Use 0 for default height
CellSpacing : Double; // Units mm. Gap between Cells.
Header : Boolean; // Repeat row across pages
AllowSplitAcrossPage : Boolean; // Can this Row split across multiple pages?
BackgroundColor : TFPColor; // Optional
constructor create(APage : TvPage); override;
destructor destroy; override;
function AddCell : TvTableCell;
function GetCellCount: Integer;
function GetCell(AIndex: Integer) : TvTableCell;
end;
(*
Note on the grid used for the table
For the table shown below, three ColWidths must be defined.
First row should only have 2 cells. First cell spans 2 columns.
Second row should only have 2 cells. Second cell spans 2 columns.
Third row should have 3 cells. Each cell only spans 1 column (default)
+-----+------+---------+
| | |
+-----+----------------+
| | |
+-----+------+---------+
| | | |
+-----+------+---------+
*)
// TvTable.Style should be a Table Style, not a Paragraph Style
// and is optional.
TvTable = class(TvEntityWithStyle)
private
Rows: TFPList;
public
ColWidths: array of Double; // Can be left empty for simple tables
// MUST be fully defined for merging cells
ColWidthsUnits : TvUnits; // Cannot mix ColWidth Units.
Borders : TvTableBorders; // Defaults: single/black/inside and out
PreferredWidth : TvDimension; // Optional. Units mm.
CellSpacing : Double; // Units mm. Gap between Cells.
BackgroundColor : TFPColor; // Optional. Units mm.
constructor create(APage : TvPage); override;
destructor destroy; override;
function AddRow : TvTableRow;
function GetRowCount : Integer;
function GetRow(AIndex: Integer) : TvTableRow;
function AddColWidth(AValue : Double) : Integer;
end;
(*
TvImage = class(TvEntityWithStyle) // ClassName subject to change...
public
Filename : String;
Width, Height : Double; // mm
end;
*)
{ TvVectorialDocument }
TvVectorialDocument = class
@ -904,6 +1066,7 @@ type
FOnProgress: TvProgressEvent;
FPages: TFPList;
FStyles: TFPList;
FListStyles: TFPList;
FCurrentPageIndex: Integer;
function CreateVectorialWriter(AFormat: TvVectorialFormat): TvCustomVectorialWriter;
function CreateVectorialReader(AFormat: TvVectorialFormat): TvCustomVectorialReader;
@ -918,7 +1081,8 @@ type
SelectedElement: TvEntity;
// List of common styles, for conveniently finding them
StyleTextBody, StyleHeading1, StyleHeading2, StyleHeading3: TvStyle;
StyleBulletList1, StyleBulletList2, StyleBulletList3: TvStyle;
StyleList : TvStyle;
ListStyles : Array[0..NUM_MAX_LISTSTYLES-1] Of TvListStyle;
{ Base methods }
constructor Create; virtual;
destructor Destroy; override;
@ -948,11 +1112,15 @@ type
function AddTextPageSequence(): TvTextPageSequence;
{ Style methods }
function AddStyle(): TvStyle;
function AddListStyle: TvListStyle;
procedure AddStandardTextDocumentStyles(AFormat: TvVectorialFormat);
function GetBulletListStyle(ALevel: Integer): TvStyle;
function GetListStyleByLevel(ALevel: Integer): TvListStyle;
function GetStyleCount: Integer;
function GetStyle(AIndex: Integer): TvStyle;
function FindStyleIndex(AStyle: TvStyle): Integer;
function GetListStyleCount: Integer;
function GetListStyle(AIndex: Integer): TvListStyle;
function FindListStyleIndex(AListStyle: TvListStyle): Integer;
{ Data removing methods }
procedure Clear; virtual;
{ Debug methods }
@ -1103,6 +1271,8 @@ type
{ Data writing methods }
function AddParagraph: TvParagraph;
function AddBulletList: TvBulletList;
function AddTable: TvTable;
//function AddImage: TvImage;
end;
{@@ TvVectorialReader class reference type }
@ -1157,6 +1327,7 @@ procedure RegisterVectorialWriter(
AWriterClass: TvVectorialWriterClass;
AFormat: TvVectorialFormat);
function Make2DPoint(AX, AY: Double): T3DPoint;
function Dimension(AValue : Double; AUnits : TvUnits) : TvDimension;
implementation
@ -1256,8 +1427,83 @@ begin
Result.Z := 0;
end;
function Dimension(AValue: Double; AUnits: TvUnits): TvDimension;
begin
Result.Value := AValue;
Result.Units := AUnits;
end;
{ TvTableCell }
constructor TvTableCell.Create(APage: TvPage);
begin
inherited Create(APage);
Borders.Left.LineType:=tbtDefault;
Borders.Right.LineType:=tbtDefault;
Borders.Top.LineType:=tbtDefault;
Borders.Bottom.LineType:=tbtDefault;
Borders.InsideHoriz.LineType:=tbtDefault;
Borders.InsideVert.LineType:=tbtDefault;
SpannedCols := 1;
end;
{ TvTable }
constructor TvTable.Create(APage: TvPage);
begin
inherited Create(APage);
Rows := TFPList.Create;
end;
destructor TvTable.destroy;
var
i: Integer;
begin
for i := Rows.Count-1 downto 0 do
begin
TvTableRow(Rows.Last).Free;
Rows.Delete(Rows.Count-1);
end;
Rows.Free;
Rows := nil;
inherited destroy;
end;
function TvTable.AddRow: TvTableRow;
begin
Result := TvTableRow.create(FPage);
Rows.Add(result);
end;
function TvTable.GetRowCount: Integer;
begin
Result := Rows.Count;
end;
function TvTable.GetRow(AIndex: Integer): TvTableRow;
begin
Result := TvTableRow(Rows[AIndex]);
end;
function TvTable.AddColWidth(AValue: Double): Integer;
begin
SetLength(ColWidths, Length(ColWidths) + 1);
ColWidths[High(ColWidths)] := AValue;
end;
{ TvStyle }
constructor TvStyle.Create;
begin
// Defaults
SuppressSpacingBetweenSameParagraphs:=False;
end;
function TvStyle.GetKind: TvStyleKind;
begin
if Parent = nil then Result := Kind
@ -1342,6 +1588,9 @@ begin
If sseMarginRight in AFrom.SetElements then
MarginRight := AFrom.MarginRight;
// Other
SuppressSpacingBetweenSameParagraphs:=AFrom.SuppressSpacingBetweenSameParagraphs;
SetElements := AFrom.SetElements + SetElements;
end;
@ -1352,6 +1601,49 @@ begin
if Parent <> nil then Result.ApplyOver(Parent);
end;
{ TvTableRow }
constructor TvTableRow.create(APage: TvPage);
begin
inherited create(APage);
Cells := TFPList.Create;
Header := False;
end;
destructor TvTableRow.destroy;
Var
i : Integer;
begin
for i := Cells.Count-1 downto 0 do
begin
TvTableCell(Cells.Last).Free;
Cells.Delete(Cells.Count-1);
end;
Cells.Free;
Cells := Nil;
inherited destroy;
end;
function TvTableRow.AddCell : TvTableCell;
begin
Result := TvTableCell.Create(FPage);
Cells.Add(Result);
end;
function TvTableRow.GetCellCount: Integer;
begin
Result := Cells.Count;
end;
function TvTableRow.GetCell(AIndex: Integer): TvTableCell;
begin
Result := TvTableCell(Cells[AIndex]);
end;
{ T2DEllipticalArcSegment }
function T2DEllipticalArcSegment.AlignedEllipseCenterEquationT1(
@ -4376,9 +4668,17 @@ end;
{ TvParagraph }
procedure TvParagraph.SetLocalAlignment(AValue: TvStyleAlignment);
begin
UseLocalAlignment:=True;
FLocalAlignment:=AValue;
end;
constructor TvParagraph.Create(APage: TvPage);
begin
inherited Create(APage);
UseLocalAlignment:=False;
end;
destructor TvParagraph.Destroy;
@ -4427,7 +4727,7 @@ function TvBulletList.AddItem(ALevel: Integer; ASimpleText: string): TvParagraph
begin
Result := TvParagraph.Create(FPage);
if FPage <> nil then
Result.Style := FPage.FOwner.GetBulletListStyle(ALevel);
Result.ListStyle := FPage.FOwner.GetListStyleByLevel(ALevel);
if ASimpleText <> '' then
Result.AddText(ASimpleText);
AddEntity(Result);
@ -4457,6 +4757,19 @@ begin
AddEntity(Result);
end;
function TvRichText.AddTable: TvTable;
begin
Result := TvTable.Create(FPage);
AddEntity(Result);
end;
(*
function TvRichText.AddImage: TvImage;
begin
Result := TvImage.Create(FPage);
AddEntity(Result);
end;
*)
function TvRichText.TryToSelect(APos: TPoint; var ASubpart: Cardinal
): TvFindEntityResult;
begin
@ -5251,6 +5564,17 @@ begin
Result := MainText.AddBulletList();
end;
function TvTextPageSequence.AddTable: TvTable;
begin
Result := MainText.AddTable;
end;
(*
function TvTextPageSequence.AddImage: TvImage;
begin
Result := MainText.AddImage;
end;
*)
{ TvVectorialDocument }
{@@
@ -5263,6 +5587,7 @@ begin
FPages := TFPList.Create;
FCurrentPageIndex := -1;
FStyles := TFPList.Create;
FListStyles := TFPList.Create;
end;
{@@
@ -5276,6 +5601,8 @@ begin
FPages := nil;
FStyles.Free;
FStyles := nil;
FListStyles.Free;
FListStyles := nil;
inherited Destroy;
end;
@ -5598,9 +5925,17 @@ begin
FStyles.Add(Result);
end;
function TvVectorialDocument.AddListStyle: TvListStyle;
begin
Result := TvListStyle.Create;
FListStyles.Add(Result);
end;
procedure TvVectorialDocument.AddStandardTextDocumentStyles(AFormat: TvVectorialFormat);
var
lTextBody, lBaseHeading, lCurStyle: TvStyle;
lCurListStyle : TvListStyle;
i: Integer;
begin
//<style:style style:name="Text_20_body" style:display-name="Text body" style:family="paragraph" style:parent-style-name="Standard" style:class="text">
// <style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0.212cm" style:contextual-spacing="false" />
@ -5693,22 +6028,45 @@ begin
// ---------------------------------
lCurStyle := AddStyle();
lCurStyle.Name := 'Bullet List Item 1';
lCurStyle.Name := 'List Style';
//lCurStyle.Parent := ;
lCurStyle.ListLevel := 1;
StyleBulletList1 := lCurStyle;
lCurStyle.MarginTop := 0.5;
lCurStyle.MarginBottom := 0.5;
lCurStyle.SetElements:=[sseMarginBottom, sseMarginTop];
lCurStyle.SuppressSpacingBetweenSameParagraphs:=True;
StyleList := lCurStyle;
//, StyleBulletList2, StyleBulletList3
// ---------------------------------
// List Style Items
// ---------------------------------
for i := 0 To NUM_MAX_LISTSTYLES-1 Do
begin
lCurListStyle := AddListStyle;
lCurListStyle.Kind := vlskDecimal;
lCurListStyle.Level := i;
lCurListStyle.Prefix := '&#183;';
lCurListStyle.PrefixFontName := 'Symbol';
lCurListStyle.MarginLeft := 6.35*(i + 1);
lCurListStyle.HangingIndent := 6.35;
lCurListStyle.Alignment := vsaLeft;
ListStyles[i] := lCurListStyle;
end;
end;
function TvVectorialDocument.GetBulletListStyle(ALevel: Integer): TvStyle;
function TvVectorialDocument.GetListStyleByLevel(ALevel: Integer): TvListStyle;
var
i: Integer;
oListStyle : TvListStyle;
begin
case ALevel of
0: Result := StyleBulletList1;
1: Result := StyleBulletList2;
2: Result := StyleBulletList3;
else
Result := nil;
Result := Nil;
for i := 0 to GetListStyleCount-1 do
begin
oListStyle := GetListStyle(i);
if oListStyle.Level = ALevel then
Exit(oListStyle);
end;
end;
@ -5731,6 +6089,25 @@ begin
if GetStyle(i) = AStyle then Exit(i);
end;
function TvVectorialDocument.GetListStyleCount: Integer;
begin
Result := FListStyles.Count;
end;
function TvVectorialDocument.GetListStyle(AIndex: Integer): TvListStyle;
begin
Result := TvListStyle(FListStyles.Items[AIndex]);
end;
function TvVectorialDocument.FindListStyleIndex(AListStyle: TvListStyle): Integer;
var
i: Integer;
begin
Result := -1;
for i := 0 to GetListStyleCount()-1 do
if GetListStyle(i) = AListStyle then Exit(i);
end;
{@@
Clears all data in the document
}

98
components/fpvectorial/odtvectorialwriter.pas
View File

@ -99,6 +99,9 @@ type
implementation
uses
strutils, htmlelements;
const
{ OpenDocument general XML constants }
XML_HEADER = '<?xml version="1.0" encoding="utf-8" ?>';
@ -666,8 +669,10 @@ end;
procedure TvODTVectorialWriter.WriteDocument(AData: TvVectorialDocument);
var
i: Integer;
CurLevel: String;
CurPage: TvPage;
CurTextPage: TvTextPageSequence absolute CurPage;
CurListStyle : TvListStyle;
begin
FContent :=
XML_HEADER + LineEnding +
@ -716,7 +721,7 @@ begin
' <style:font-face style:name="SimSun" svg:font-family="SimSun" style:font-family-generic="system" style:font-pitch="variable" />' + LineEnding +
' </office:font-face-decls>' + LineEnding;
FContent := FContent +
' <office:automatic-styles>' + LineEnding +
' <office:automatic-styles>' + LineEnding;
{ ' <style:style style:name="P1" style:family="paragraph" style:parent-style-name="Heading_20_2">' + LineEnding +
' <style:text-properties />' + LineEnding + //officeooo:rsid="00072f3e" officeooo:paragraph-rsid="00072f3e"
' </style:style>' + LineEnding +
@ -732,15 +737,38 @@ begin
' <style:style style:name="P5" style:family="paragraph" style:parent-style-name="Text_20_body">' + LineEnding +
' <style:text-properties officeooo:rsid="00072f3e" />' + LineEnding +
' </style:style>' + LineEnding +}
//
' <text:list-style style:name="L1">' + LineEnding +
' <text:list-level-style-bullet text:level="1" text:style-name="Bullet_20_Symbols" text:bullet-char="•">' + LineEnding +
' <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">' + LineEnding +
' <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="1.667cm" fo:text-indent="-0.635cm" fo:margin-left="1.667cm" />' + LineEnding +
' </style:list-level-properties>' + LineEnding +
' </text:list-level-style-bullet>' + LineEnding +
' </text:list-style>' + LineEnding +
// MJT 2013-08-24 - This is the code to cycle over the ListStyles.
// - This is verified working for Level 0
// - TvBulletList needs re-architecting to be a tree
// to get deeper levels working
// (see note in WriteBulletStyle)
// - As I understand tOpenDocument-v1.1.pdf the following list style
// should work once we get nesting happening
FContent := FContent + ' <text:list-style style:name="L1">' + LineEnding;
For i := 0 To AData.GetListStyleCount-1 Do
begin
CurListStyle := AData.GetListStyle(i);
CurLevel := IntToStr(CurListStyle.Level+1); // Note the +1...
If CurListStyle.Kind=vlskBullet Then
FContent := FContent + ' <text:list-level-style-bullet text:level="'+CurLevel+'" text:style-name="Bullet_20_Symbols" text:bullet-char="'+CurListStyle.Prefix+'">' + LineEnding +
' <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">' + LineEnding +
' <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="'+FloatToODTText(CurListStyle.MarginLeft/10)+'cm" fo:text-indent="-'+FloatToODTText(CurListStyle.HangingIndent/10)+'cm" fo:margin-left="'+FloatToODTText(CurListStyle.MarginLeft/10)+'cm" />' + LineEnding +
' </style:list-level-properties>' + LineEnding +
' </text:list-level-style-bullet>' + LineEnding;
end;
FContent := FContent + ' </text:list-style>' + LineEnding;
// Pre MJT code...
//FContent := FContent +
// ' <text:list-style style:name="L1">' + LineEnding +
// ' <text:list-level-style-bullet text:level="1" text:style-name="Bullet_20_Symbols" text:bullet-char="&#183;">' + LineEnding +
// ' <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">' + LineEnding +
// ' <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="1.667cm" fo:text-indent="-0.635cm" fo:margin-left="1.667cm" />' + LineEnding +
// ' </style:list-level-properties>' + LineEnding +
// ' </text:list-level-style-bullet>' + LineEnding +
// ' </text:list-style>' + LineEnding;
{
<text:list-level-style-bullet text:level="2" text:style-name="Bullet_20_Symbols" text:bullet-char="◦">
<style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
@ -788,7 +816,8 @@ begin
</style:list-level-properties>
</text:list-level-style-bullet>
}
' </office:automatic-styles>' + LineEnding;
FContent := FContent +
' </office:automatic-styles>' + LineEnding;
FContent := FContent +
' <office:body>' + LineEnding;
@ -939,6 +968,8 @@ procedure TvODTVectorialWriter.WriteTextSpan(AEntity: TvText; AParagraph: TvPara
var
AEntityStyleName: string;
lStyle: TvStyle;
sText: String;
i : Integer;
begin
lStyle := AEntity.GetCombinedStyle(AParagraph);
if lStyle = nil then
@ -960,8 +991,23 @@ begin
}
// Note that here we write only text spans!
FContent := FContent +
'<text:span text:style-name="'+AEntityStyleName+'">'+AEntity.Value.Text+'</text:span>';
// MJT 2013-08-24 ODT Writer and DOCX writer were treating TvText.Value differently...
// This code synchronises handling between the two writers...
sText := EscapeHTML(AEntity.Value.Text);
// Trim extra CRLF appended by TStringList.Text
If DefaultTextLineBreakStyle = tlbsCRLF Then
sText := Copy(sText, 1, Length(sText) - 2)
Else
sText := Copy(sText, 1, Length(sText) - 1);
sText := StringReplace(sText, #11, '<text:tab/>', [rfReplaceAll]);
sText := StringReplace(sText, #13, '<text:line-break/>', [rfReplaceAll]);
sText := StringReplace(sText, #10, '', [rfReplaceAll]);
FContent := FContent + '<text:span text:style-name="'+AEntityStyleName+'">' +
sText + '</text:span>';
end;
procedure TvODTVectorialWriter.WriteBulletList(AEntity: TvBulletList;
@ -971,8 +1017,17 @@ var
lCurEntity, lCurSubEntity: TvEntity;
lCurParagraph: TvParagraph;
begin
// MJT 2013-08-24
// Different levels are handled by nesting <test:list> inside parent <test:item>
// Only way we can handle this is by treating TvBulletLists as a Tree
// .Level then becomes a function returning the number of steps to root.
// The code below there currently adds everything at level 0
// See http://docs.oasis-open.org/office/v1.1/OS/OpenDocument-v1.1.pdf
// page 75 "Example: Lists and sublists"
FContent := FContent +
' <text:list text:style-name="L1">' + LineEnding; // xml:id="list14840052221"
' <text:list text:style-name="L1">' + LineEnding; // xml:id="list14840052221"
for i := 0 to AEntity.GetEntitiesCount()-1 do
begin
@ -981,18 +1036,10 @@ begin
if (lCurEntity is TvParagraph) then
begin
lCurParagraph := lCurEntity as TvParagraph;
if lCurParagraph.Style <> nil then
begin
FContent := FContent +
FContent := FContent +
' <text:list-item>' + LineEnding +
' <text:p text:style-name="List_'+IntToStr(lCurParagraph.Style.ListLevel)+'">';
end
else
begin
FContent := FContent +
' <text:list-item>' + LineEnding +
' <text:p text:style-name="List_0">';
end;
' <text:p>';
for j := 0 to lCurParagraph.GetEntitiesCount()-1 do
begin
@ -1002,7 +1049,8 @@ begin
WriteTextSpan(TvText(lCurSubEntity), lCurParagraph, ACurPage, AData);
end;
FContent := FContent + '</text:p>' + LineEnding +
FContent := FContent +
'</text:p>' + LineEnding +
' </text:list-item>' + LineEnding;
end;
end;