1 {
2 Writes an ODT Document
3
4 License: The same modified LGPL as the Free Pascal RTL
5 See the file COPYING.modifiedLGPL for more details
6
7 An OpenDocument document is a compressed ZIP file with the following files inside:
8
9 content.xml - Actual contents
10 meta.xml - Authoring data
11 settings.xml - User persistent viewing information, such as zoom, cursor position, etc.
12 styles.xml - Styles, which are the only way to do formatting
13 mimetype - application/vnd.oasis.opendocument.text
14 META-INF\manifest.xml - Describes the other files in the archive
15
16 Specifications obtained from:
17
18 http://docs.oasis-open.org/office/v1.1/OS/OpenDocument-v1.1.pdf
19
20 Example of content.xml structure:
21
22 <?xml version="1.0" encoding="UTF-8"?>
23 <office:document-content xmlns:office="urn:oasis:names:tc:opendocument:xmlns:office:1.0" .....>
24 <office:scripts/>
25 <office:automatic-styles>
26 <style:style style:name="dp1" style:family="drawing-page"/>
27 <style:style style:name="gr1" style:family="graphic" style:parent-style-name="standard">
28 ....
29 </office:automatic-styles>
30 <office:body>
31 <office:drawing>
32 <draw:page draw:name="page1" draw:style-name="dp1" draw:master-page-name="Oletus">
33 <draw:ellipse draw:style-name="gr2" draw:text-style-name="P1" draw:layer="layout" svg:width="11cm" svg:height="3cm" svg:x="5.5cm" svg:y="6.5cm">
34 <text:p/>
35 </draw:ellipse>
36 ... other elements in the page...
37 </draw:page>
38 </office:drawing>
39 </office:body>
40 </office:document-content>
41
42 Validator for ODF 1.0
43 http://opendocumentfellowship.com/validator
44 Validator for ODF 1.2
45 http://odf-validator2.rhcloud.com/odf-validator2/
46
47 AUTHORS: Felipe Monteiro de Carvalho
48 }
49 unit odtvectorialwriter;
50
51 {$mode objfpc}{$H+}
52
53 interface
54
55 uses
56 Classes, SysUtils,
57 zipper, zstream, {NOTE: might require zipper from FPC 2.6.2+ }
58 fpimage, fpcanvas,
59 fpvectorial, fpvutils, lazutf8;
60
61 type
62
63 // Forward declarations
64 TvODTVectorialWriter = class;
65
66 { TListStyle_Style }
67
68 TListStyle_Style = Class
69 Style : TvStyle;
70 ListStyle : TvListStyle;
71 End;
72
73 { TListStyle_StyleList }
74
75 TListStyle_StyleList = Class(TFPList)
76 Writer : TvODTVectorialWriter;
77 Data : TvVectorialDocument;
78
79 destructor Destroy; override;
80
AddCrossReferencenull81 function AddCrossReference(AStyle : TvStyle; AListStyle: TvListStyle) : Integer;
AsTextnull82 function AsText(AIndex : Integer) : String;
83 End;
84
85 { TvODTVectorialWriter }
86
87 // Writes ODT 1.2 with LibreOffice extensions...
88 TvODTVectorialWriter = class(TvCustomVectorialWriter)
89 private
90 FDateCount : Integer; // Used to track Date Style Formats...
91 FPointSeparator: TFormatSettings;
92 // Strings with the contents of files
93 FMeta, FSettings, FStyles, FContent, FMimetype: string;
94 FAutomaticStyles, FMasterStyles: string; // built during writedocument, used during writestyle
95 FAutomaticStyleID : Integer;
96 FContentAutomaticStyles : string; // built during writedocument, used during writedocument
97
98 FRasterImageFileNames:TStringList;
99
100 FList_StyleCrossRef : TListStyle_StyleList;
101
102 FNewPageSequence : Boolean;
103
104 FMetaInfManifest, FManifestRDF: string;
105 // helper routines
StyleNameToODTStyleNamenull106 function StyleNameToODTStyleName(AData: TvVectorialDocument; AStyleIndex: Integer; AToContentAutoStyle: Boolean = False): string; overload;
StyleNameToODTStyleNamenull107 function StyleNameToODTStyleName(AData: TvVectorialDocument; AStyle: TvStyle; AToContentAutoStyle: Boolean = False): string; overload;
ListStyleNameToODTTextnull108 function ListStyleNameToODTText(AData: TvVectorialDocument; AListStyle : TvListStyle) : string;
FloatToODTTextnull109 function FloatToODTText(AFloat: Double): string;
BordersToStringnull110 function BordersToString(ATableBorders, ACellBorders: TvTableBorders; ATopCell,
111 ABottomCell, ALeftCell, ARightCell: Boolean): String;
TextPropertiesToStringnull112 function TextPropertiesToString(AStyle: TvStyle): String;
113 // Routines to write those files
114 procedure WriteMimetype;
115 procedure WriteMetaInfManifest;
116 procedure WriteManifestRDF;
117 procedure WriteMeta;
118 procedure WriteSettings;
119 procedure WriteStyles(AData: TvVectorialDocument);
120 procedure WriteDocument(AData: TvVectorialDocument);
121 procedure WritePage(ACurPage: TvTextPageSequence; AData: TvVectorialDocument);
122 //
123 procedure WriteParagraph(AEntity: TvParagraph; ACurPage: TvTextPageSequence; AData: TvVectorialDocument);
124 procedure WriteTable(ATable: TvTable; ACurPage: TvTextPageSequence;
125 AData: TvVectorialDocument);
126 procedure WriteTextSpan(AEntity: TvText; AParagraph: TvParagraph;
127 ACurPage: TvTextPageSequence; AData: TvVectorialDocument);
128 procedure WriteField(AEntity: TvField; AParagraph: TvParagraph;
129 ACurPage: TvTextPageSequence; AData: TvVectorialDocument);
130 procedure WriteList(AEntity: TvList; ACurPage: TvTextPageSequence; AData: TvVectorialDocument);
131
132 procedure WriteRasterImage(AEntity:TvRasterImage; AParagraph: TvParagraph;
133 ACurPage: TvTextPageSequence; AData: TvVectorialDocument);
134
135 // Routines to write parts of those files
WriteStylesXMLAsStringnull136 function WriteStylesXMLAsString: string;
137 //
138 public
139 { General reading methods }
140 constructor Create; override;
141 destructor Destroy; override;
142 procedure WriteToFile(AFileName: string; AData: TvVectorialDocument); override;
143 procedure WriteToStream(AStream: TStream; AData: TvVectorialDocument); override;
144 end;
145
146 implementation
147
148 uses
149 htmlelements, FPWritePNG, Math;
150
151 const
152 { OpenDocument general XML constants }
153 XML_HEADER = '<?xml version="1.0" encoding="utf-8" ?>';
154
155 { OpenDocument Directory structure constants }
156 OPENDOC_PATH_CONTENT = 'content.xml';
157 OPENDOC_PATH_META = 'meta.xml';
158 OPENDOC_PATH_SETTINGS = 'settings.xml';
159 OPENDOC_PATH_STYLES = 'styles.xml';
160 OPENDOC_PATH_MIMETYPE = 'mimetype';
161 OPENDOC_PATH_METAINF = 'META-INF' + '/';
162 OPENDOC_PATH_METAINF_MANIFEST = 'META-INF' + '/' + 'manifest.xml';
163 OPENDOC_PATH_MANIFESTRDF = 'manifest.rdf';
164
165 { OpenDocument schemas constants }
166 SCHEMAS_XMLNS = 'http://schemas.openxmlformats.org/officeDocument/2006/extended-properties';
167 SCHEMAS_XMLNS_CALCEXT = 'urn:org:documentfoundation:names:experimental:calc:xmlns:calcext:1.0';
168 SCHEMAS_XMLNS_CHART = 'urn:oasis:names:tc:opendocument:xmlns:chart:1.0';
169 SCHEMAS_XMLNS_CONFIG = 'urn:oasis:names:tc:opendocument:xmlns:config:1.0';
170 SCHEMAS_XMLNS_CSS3T = 'http://www.w3.org/TR/css3-text/';
171 SCHEMAS_XMLNS_DC = 'http://purl.org/dc/elements/1.1/';
172 SCHEMAS_XMLNS_DCTERMS = 'http://purl.org/dc/terms/';
173 SCHEMAS_XMLNS_DOM = 'http://www.w3.org/2001/xml-events';
174 SCHEMAS_XMLNS_DR3D = 'urn:oasis:names:tc:opendocument:xmlns:dr3d:1.0';
175 SCHEMAS_XMLNS_DRAW = 'urn:oasis:names:tc:opendocument:xmlns:drawing:1.0';
176 SCHEMAS_XMLNS_DRAWOOO = 'http://openoffice.org/2010/draw';
177 SCHEMAS_XMLNS_FIELD = 'urn:openoffice:names:experimental:ooo-ms-interop:xmlns:field:1.0';
178 SCHEMAS_XMLNS_FO = 'urn:oasis:names:tc:opendocument:xmlns:xsl-fo-compatible:1.0';
179 SCHEMAS_XMLNS_FORM = 'urn:oasis:names:tc:opendocument:xmlns:form:1.0';
180 SCHEMAS_XMLNS_FORMX = 'urn:openoffice:names:experimental:ooxml-odf-interop:xmlns:form:1.0';
181 SCHEMAS_XMLNS_GRDDL = 'http://www.w3.org/2003/g/data-view#';
182 SCHEMAS_XMLNS_MANIFEST = 'urn:oasis:names:tc:opendocument:xmlns:manifest:1.0';
183 SCHEMAS_XMLNS_MATH = 'http://www.w3.org/1998/Math/MathML';
184 SCHEMAS_XMLNS_META = 'urn:oasis:names:tc:opendocument:xmlns:meta:1.0';
185 SCHEMAS_XMLNS_NUMBER = 'urn:oasis:names:tc:opendocument:xmlns:datastyle:1.0';
186 SCHEMAS_XMLNS_OF = 'urn:oasis:names:tc:opendocument:xmlns:of:1.2';
187 SCHEMAS_XMLNS_OFFICE = 'urn:oasis:names:tc:opendocument:xmlns:office:1.0';
188 SCHEMAS_XMLNS_OFFICEOOO= 'http://openoffice.org/2009/office';
189 SCHEMAS_XMLNS_OOO = 'http://openoffice.org/2004/office';
190 SCHEMAS_XMLNS_OOOC = 'http://openoffice.org/2004/calc';
191 SCHEMAS_XMLNS_OOOW = 'http://openoffice.org/2004/writer';
192 SCHEMAS_XMLNS_RPT = 'http://openoffice.org/2005/report';
193 SCHEMAS_XMLNS_SCRIPT = 'urn:oasis:names:tc:opendocument:xmlns:script:1.0';
194 SCHEMAS_XMLNS_STYLE = 'urn:oasis:names:tc:opendocument:xmlns:style:1.0';
195 SCHEMAS_XMLNS_SVG = 'urn:oasis:names:tc:opendocument:xmlns:svg-compatible:1.0';
196 SCHEMAS_XMLNS_TABLE = 'urn:oasis:names:tc:opendocument:xmlns:table:1.0';
197 SCHEMAS_XMLNS_TABLEOOO = 'http://openoffice.org/2009/table';
198 SCHEMAS_XMLNS_TEXT = 'urn:oasis:names:tc:opendocument:xmlns:text:1.0';
199 SCHEMAS_XMLNS_V = 'urn:schemas-microsoft-com:vml';
200 SCHEMAS_XMLNS_XFORMS = 'http://www.w3.org/2002/xforms';
201 SCHEMAS_XMLNS_XHTML = 'http://www.w3.org/1999/xhtml';
202 SCHEMAS_XMLNS_XLINK = 'http://www.w3.org/1999/xlink';
203 SCHEMAS_XMLNS_XSD = 'http://www.w3.org/2001/XMLSchema';
204 SCHEMAS_XMLNS_XSI = 'http://www.w3.org/2001/XMLSchema-instance';
205
206 // SVG requires hardcoding a DPI value
207
208 // The Opera Browser and Inkscape use 90 DPI, so we follow that
209
210 // 1 Inch = 25.4 milimiters
211 // 90 inches per pixel = (1 / 90) * 25.4 = 0.2822
212 // FLOAT_MILIMETERS_PER_PIXEL = 0.3528; // DPI 72 = 1 / 72 inches per pixel
213
214 FLOAT_MILIMETERS_PER_PIXEL = 0.2822; // DPI 90 = 1 / 90 inches per pixel
215 FLOAT_PIXELS_PER_MILIMETER = 3.5433; // DPI 90 = 1 / 90 inches per pixel
216
217 // Lookups
218 LU_ALIGN: Array [TvStyleAlignment] Of String =
219 ('start', 'end', 'justify', 'center');
220
221 LU_V_ALIGN: Array[TvVerticalAlignment] Of String =
222 ('top', 'bottom', 'middle', 'automatic');
223
224 LU_NUMBERFORMAT: Array [TvNumberFormat] Of String =
225 ('1', 'a', 'i', 'A', 'I');
226
227 LU_BORDERTYPE: Array[TvTableBorderType] Of String =
228 ('solid', 'dashed', 'solid', 'none', 'default');
229 // ('solid', 'dashed', 'double', 'none', 'default'); // NOTE: double not supported
230
FPColorToHTMLnull231 function FPColorToHTML(AColor: TFPColor): String;
232 begin
233 Result := Format('#%.2x%.2x%.2x', [AColor.Red shr 8, AColor.Green shr 8, AColor.Blue shr 8]);
234 end;
235
236 { TListStyle_StyleList }
237
238 destructor TListStyle_StyleList.Destroy;
239 begin
240 while (Count>0) do
241 begin
242 TListStyle_Style(Last).Free;
243 Delete(Count-1);
244 end;
245
246 inherited destroy;
247 end;
248
AddCrossReferencenull249 function TListStyle_StyleList.AddCrossReference(AStyle: TvStyle;
250 AListStyle: TvListStyle): Integer;
251 Var
252 i : Integer;
253 oCrossRef : TListStyle_Style;
254
255 begin
256 // Only add unique instances of the cross references
257 Result := -1;
258
259 for i := 0 To Count-1 Do
260 begin
261 oCrossRef := TListStyle_Style(Items[i]);
262
263 if (oCrossRef.Style = AStyle) And (oCrossRef.ListStyle=AListStyle) Then
264 exit(i);
265 end;
266
267 // We will only get here if the supplied combination is not already in the list
268 oCrossRef := TListStyle_Style.Create;
269 oCrossRef.Style := AStyle;
270 oCrossRef.ListStyle := AListStyle;
271
272 Result := Add(oCrossRef);
273 end;
274
AsTextnull275 function TListStyle_StyleList.AsText(AIndex: Integer): String;
276 begin
277 if (AIndex>=0) And (AIndex<Count) Then
278 with (TListStyle_Style(Items[AIndex])) Do
279 Result := Writer.StyleNameToODTStyleName(Data, Style, False) + '_' +
280 Writer.ListStyleNameToODTText(Data, ListStyle)
281 else
282 raise exception.create('index out of bounds');
283 end;
284
StyleNameToODTStyleNamenull285 function TvODTVectorialWriter.StyleNameToODTStyleName(
286 AData: TvVectorialDocument; AStyleIndex: Integer; AToContentAutoStyle: Boolean): string;
287 var
288 lStyle: TvStyle;
289 begin
290 lStyle := AData.GetStyle(AStyleIndex);
291 if AToContentAutoStyle then
292 begin
293 Result := 'P' + IntToStr(AStyleIndex);
294 end
295 else
296 begin
297 Result := StringReplace(lStyle.Name, ' ', '_', [rfReplaceAll, rfIgnoreCase]);
298 end;
299 end;
300
StyleNameToODTStyleNamenull301 function TvODTVectorialWriter.StyleNameToODTStyleName(
302 AData: TvVectorialDocument; AStyle: TvStyle; AToContentAutoStyle: Boolean
303 ): string;
304 var
305 lStyleIndex: Integer;
306 begin
307 lStyleIndex := AData.FindStyleIndex(AStyle);
308 Result := StyleNameToODTStyleName(AData, lStyleIndex, AToContentAutoStyle);
309 end;
310
TvODTVectorialWriter.ListStyleNameToODTTextnull311 function TvODTVectorialWriter.ListStyleNameToODTText(
312 AData: TvVectorialDocument; AListStyle: TvListStyle): string;
313 begin
314 Result := StringReplace(AListStyle.Name, ' ', '', [rfReplaceAll]);
315
316 If Result='' Then
317 Result := Format('List_%d', [AData.FindListStyleIndex(AListStyle)]);
318 end;
319
FloatToODTTextnull320 function TvODTVectorialWriter.FloatToODTText(AFloat: Double): string;
321 begin
322 Result := FloatToStr(AFloat, FPointSeparator);
323 end;
324
325 procedure TvODTVectorialWriter.WriteMimetype;
326 begin
327 FMimetype := 'application/vnd.oasis.opendocument.text';
328 end;
329
330 procedure TvODTVectorialWriter.WriteMetaInfManifest;
331 var
332 i:integer;
333 begin
334 FMetaInfManifest :=
335 XML_HEADER + LineEnding +
336 '<manifest:manifest xmlns:manifest="' + SCHEMAS_XMLNS_MANIFEST + '" manifest:version="1.2">' + LineEnding +
337 ' <manifest:file-entry manifest:full-path="/" manifest:media-type="application/vnd.oasis.opendocument.text" />' + LineEnding; // manifest:version="1.2"
338
339 for i:= 0 to FRasterImageFileNames.Count-1 do
340 begin
341 FMetaInfManifest := FMetaInfManifest+
342 ' <manifest:file-entry manifest:media-type="image/png" manifest:full-path="'+FRasterImageFileNames[i]+'" />' + LineEnding;
343 end;
344
345 FMetaInfManifest := FMetaInfManifest+
346 ' <manifest:file-entry manifest:media-type="text/xml" manifest:full-path="content.xml" />' + LineEnding +
347 ' <manifest:file-entry manifest:media-type="text/xml" manifest:full-path="styles.xml" />' + LineEnding +
348 ' <manifest:file-entry manifest:media-type="text/xml" manifest:full-path="meta.xml" />' + LineEnding +
349 ' <manifest:file-entry manifest:media-type="text/xml" manifest:full-path="settings.xml" />' + LineEnding +
350 ' <manifest:file-entry manifest:full-path="manifest.rdf" manifest:media-type="application/rdf+xml"/>' + LineEnding +
351 '</manifest:manifest>';
352
353 end;
354
355 procedure TvODTVectorialWriter.WriteManifestRDF;
356 begin
357 FManifestRDF :=
358 XML_HEADER + LineEnding +
359 '<rdf:RDF xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#">' + LineEnding +
360 ' <rdf:Description rdf:about="styles.xml">' + LineEnding +
361 ' <rdf:type rdf:resource="http://docs.oasis-open.org/ns/office/1.2/meta/odf#StylesFile"/>' + LineEnding +
362 ' </rdf:Description>' + LineEnding +
363 ' <rdf:Description rdf:about="">' + LineEnding +
364 ' <ns0:hasPart xmlns:ns0="http://docs.oasis-open.org/ns/office/1.2/meta/pkg#" rdf:resource="styles.xml"/>' + LineEnding +
365 ' </rdf:Description>' + LineEnding +
366 ' <rdf:Description rdf:about="content.xml">' + LineEnding +
367 ' <rdf:type rdf:resource="http://docs.oasis-open.org/ns/office/1.2/meta/odf#ContentFile"/>' + LineEnding +
368 ' </rdf:Description>' + LineEnding +
369 ' <rdf:Description rdf:about="">' + LineEnding +
370 ' <ns0:hasPart xmlns:ns0="http://docs.oasis-open.org/ns/office/1.2/meta/pkg#" rdf:resource="content.xml"/>' + LineEnding +
371 ' </rdf:Description>' + LineEnding +
372 ' <rdf:Description rdf:about="">' + LineEnding +
373 ' <rdf:type rdf:resource="http://docs.oasis-open.org/ns/office/1.2/meta/pkg#Document"/>' + LineEnding +
374 ' </rdf:Description>' + LineEnding +
375 '</rdf:RDF>' + LineEnding;
376 end;
377
378 procedure TvODTVectorialWriter.WriteMeta;
379 begin
380 FMeta :=
381 XML_HEADER + LineEnding +
382 '<office:document-meta xmlns:office="' + SCHEMAS_XMLNS_OFFICE + '"' +
383 ' xmlns:xlink="' + SCHEMAS_XMLNS_XLINK + '"' +
384 ' xmlns:dc="' + SCHEMAS_XMLNS_DC + '"' +
385 ' xmlns:ooo="' + SCHEMAS_XMLNS_OOO + '"' +
386 ' xmlns:grddl="' + SCHEMAS_XMLNS_GRDDL + '"' +
387 ' xmlns:meta="' + SCHEMAS_XMLNS_META + '"' +
388 ' xmlns="' + SCHEMAS_XMLNS + '"' +
389 ' xmlns:ex="' + SCHEMAS_XMLNS + '" office:version="1.2">' + LineEnding +
390 ' <office:meta>' + LineEnding +
391 // <meta:creation-date>2013-07-21T09:29:41.06</meta:creation-date>
392 // <dc:date>2013-07-21T20:13:32.29</dc:date>
393 ' <meta:generator>FPVectorial Library</meta:generator>' + LineEnding +
394 // <meta:document-statistic meta:table-count="0" meta:image-count="0" meta:object-count="0" meta:page-count="1" meta:paragraph-count="19" meta:word-count="312" meta:character-count="2028" meta:non-whitespace-character-count="2028" />
395 ' </office:meta>' + LineEnding +
396 '</office:document-meta>';
397 end;
398
399 procedure TvODTVectorialWriter.WriteSettings;
400 begin
401 FSettings :=
402 XML_HEADER + LineEnding +
403 '<office:document-settings xmlns:office="' + SCHEMAS_XMLNS_OFFICE + '"' +
404 ' xmlns:xlink="' + SCHEMAS_XMLNS_XLINK + '"' +
405 ' xmlns:config="' + SCHEMAS_XMLNS_CONFIG + '"' +
406 ' xmlns:ooo="' + SCHEMAS_XMLNS_OOO + '" office:version="1.2">' + LineEnding +
407 '<office:settings>' + LineEnding +
408 ' <config:config-item-set config:name="ooo:view-settings">' + LineEnding +
409 ' <config:config-item config:name="ViewAreaTop" config:type="int">0</config:config-item>' + LineEnding +
410 ' <config:config-item config:name="ViewAreaLeft" config:type="int">0</config:config-item>' + LineEnding +
411 ' <config:config-item config:name="ViewAreaWidth" config:type="int">25534</config:config-item>' + LineEnding +
412 ' <config:config-item config:name="ViewAreaHeight" config:type="int">9289</config:config-item>' + LineEnding +
413 {
414 <config:config-item config:name="ShowRedlineChanges" config:type="boolean">true</config:config-item>
415 <config:config-item config:name="InBrowseMode" config:type="boolean">false</config:config-item>
416 <config:config-item-map-indexed config:name="Views">
417 <config:config-item-map-entry>
418 <config:config-item config:name="ViewId" config:type="string">view2</config:config-item>
419 <config:config-item config:name="ViewLeft" config:type="int">4267</config:config-item>
420 <config:config-item config:name="ViewTop" config:type="int">2925</config:config-item>
421 <config:config-item config:name="VisibleLeft" config:type="int">0</config:config-item>
422 <config:config-item config:name="VisibleTop" config:type="int">0</config:config-item>
423 <config:config-item config:name="VisibleRight" config:type="int">25532</config:config-item>
424 <config:config-item config:name="VisibleBottom" config:type="int">9287</config:config-item>
425 <config:config-item config:name="ZoomType" config:type="short">0</config:config-item>
426 <config:config-item config:name="ViewLayoutColumns" config:type="short">0</config:config-item>
427 <config:config-item config:name="ViewLayoutBookMode" config:type="boolean">false</config:config-item>
428 <config:config-item config:name="ZoomFactor" config:type="short">100</config:config-item>
429 <config:config-item config:name="IsSelectedFrame" config:type="boolean">false</config:config-item>
430 </config:config-item-map-entry>
431 </config:config-item-map-indexed>
432 </config:config-item-set>
433 }
434 ' </config:config-item-set>' + LineEnding +
435 ' <config:config-item-set config:name="ooo:configuration-settings">' + LineEnding +
436 ' <config:config-item config:name="ChartAutoUpdate" config:type="boolean">true</config:config-item>' + LineEnding +
437 {
438 <config:config-item config:name="IsLabelDocument" config:type="boolean">false</config:config-item>
439 <config:config-item config:name="MathBaselineAlignment" config:type="boolean">true</config:config-item>
440 <config:config-item config:name="Rsid" config:type="int">490666</config:config-item>
441 <config:config-item config:name="OutlineLevelYieldsNumbering" config:type="boolean">false</config:config-item>
442 <config:config-item config:name="PrintLeftPages" config:type="boolean">true</config:config-item>
443 <config:config-item config:name="DoNotJustifyLinesWithManualBreak" config:type="boolean">false</config:config-item>
444 <config:config-item config:name="ClippedPictures" config:type="boolean">false</config:config-item>
445 <config:config-item config:name="AlignTabStopPosition" config:type="boolean">true</config:config-item>
446 <config:config-item config:name="PrintTextPlaceholder" config:type="boolean">false</config:config-item>
447 <config:config-item config:name="UseOldNumbering" config:type="boolean">false</config:config-item>
448 <config:config-item config:name="CurrentDatabaseCommand" config:type="string" />
449 <config:config-item config:name="ProtectForm" config:type="boolean">false</config:config-item>
450 <config:config-item config:name="PrintBlackFonts" config:type="boolean">false</config:config-item>
451 <config:config-item config:name="PrintProspectRTL" config:type="boolean">false</config:config-item>
452 <config:config-item config:name="BackgroundParaOverDrawings" config:type="boolean">false</config:config-item>
453 <config:config-item config:name="FloattableNomargins" config:type="boolean">false</config:config-item>
454 <config:config-item config:name="SmallCapsPercentage66" config:type="boolean">false</config:config-item>
455 <config:config-item config:name="PrintControls" config:type="boolean">true</config:config-item>
456 <config:config-item config:name="EmbedSystemFonts" config:type="boolean">false</config:config-item>
457 <config:config-item config:name="CharacterCompressionType" config:type="short">0</config:config-item>
458 <config:config-item config:name="PrintHiddenText" config:type="boolean">false</config:config-item>
459 <config:config-item config:name="UseFormerTextWrapping" config:type="boolean">false</config:config-item>
460 <config:config-item config:name="IsKernAsianPunctuation" config:type="boolean">false</config:config-item>
461 <config:config-item config:name="PrintProspect" config:type="boolean">false</config:config-item>
462 <config:config-item config:name="PrintEmptyPages" config:type="boolean">false</config:config-item>
463 <config:config-item config:name="UnbreakableNumberings" config:type="boolean">false</config:config-item>
464 <config:config-item config:name="UseFormerObjectPositioning" config:type="boolean">false</config:config-item>
465 <config:config-item config:name="ConsiderTextWrapOnObjPos" config:type="boolean">false</config:config-item>
466 <config:config-item config:name="TableRowKeep" config:type="boolean">false</config:config-item>
467 <config:config-item config:name="PrintReversed" config:type="boolean">false</config:config-item>
468 <config:config-item config:name="TabsRelativeToIndent" config:type="boolean">true</config:config-item>
469 <config:config-item config:name="PrintRightPages" config:type="boolean">true</config:config-item>
470 <config:config-item config:name="PrintPaperFromSetup" config:type="boolean">false</config:config-item>
471 <config:config-item config:name="AddFrameOffsets" config:type="boolean">false</config:config-item>
472 <config:config-item config:name="AddParaSpacingToTableCells" config:type="boolean">true</config:config-item>
473 <config:config-item config:name="UpdateFromTemplate" config:type="boolean">true</config:config-item>
474 <config:config-item config:name="AddExternalLeading" config:type="boolean">true</config:config-item>
475 <config:config-item config:name="PrintSingleJobs" config:type="boolean">false</config:config-item>
476 <config:config-item config:name="PrinterIndependentLayout" config:type="string">high-resolution</config:config-item>
477 <config:config-item config:name="RsidRoot" config:type="int">470846</config:config-item>
478 <config:config-item config:name="LinkUpdateMode" config:type="short">1</config:config-item>
479 <config:config-item config:name="PrintAnnotationMode" config:type="short">0</config:config-item>
480 <config:config-item config:name="TabOverMargin" config:type="boolean">false</config:config-item>
481 <config:config-item config:name="UseOldPrinterMetrics" config:type="boolean">false</config:config-item>
482 <config:config-item config:name="RedlineProtectionKey" config:type="base64Binary" />
483 <config:config-item config:name="PrinterSetup" config:type="base64Binary" />
484 <config:config-item config:name="IgnoreFirstLineIndentInNumbering" config:type="boolean">false</config:config-item>
485 <config:config-item config:name="CollapseEmptyCellPara" config:type="boolean">true</config:config-item>
486 <config:config-item config:name="PrinterName" config:type="string" />
487 <config:config-item config:name="EmbedFonts" config:type="boolean">false</config:config-item>
488 <config:config-item config:name="InvertBorderSpacing" config:type="boolean">false</config:config-item>
489 <config:config-item config:name="PrintPageBackground" config:type="boolean">true</config:config-item>
490 <config:config-item config:name="DoNotCaptureDrawObjsOnPage" config:type="boolean">false</config:config-item>
491 <config:config-item config:name="TabOverflow" config:type="boolean">true</config:config-item>
492 <config:config-item config:name="ApplyUserData" config:type="boolean">true</config:config-item>
493 <config:config-item config:name="TabAtLeftIndentForParagraphsInList" config:type="boolean">false</config:config-item>
494 <config:config-item config:name="UnxForceZeroExtLeading" config:type="boolean">false</config:config-item>
495 <config:config-item config:name="SaveVersionOnClose" config:type="boolean">false</config:config-item>
496 <config:config-item config:name="PrintFaxName" config:type="string" />
497 <config:config-item config:name="StylesNoDefault" config:type="boolean">false</config:config-item>
498 <config:config-item config:name="AddParaTableSpacing" config:type="boolean">true</config:config-item>
499 <config:config-item config:name="PrintDrawings" config:type="boolean">true</config:config-item>
500 <config:config-item config:name="LoadReadonly" config:type="boolean">false</config:config-item>
501 <config:config-item config:name="PrintGraphics" config:type="boolean">true</config:config-item>
502 <config:config-item config:name="FieldAutoUpdate" config:type="boolean">true</config:config-item>
503 <config:config-item config:name="AllowPrintJobCancel" config:type="boolean">true</config:config-item>
504 <config:config-item config:name="UseFormerLineSpacing" config:type="boolean">false</config:config-item>
505 <config:config-item config:name="SaveGlobalDocumentLinks" config:type="boolean">false</config:config-item>
506 <config:config-item config:name="CurrentDatabaseDataSource" config:type="string" />
507 <config:config-item config:name="IgnoreTabsAndBlanksForLineCalculation" config:type="boolean">false</config:config-item>
508 <config:config-item config:name="CurrentDatabaseCommandType" config:type="int">0</config:config-item>
509 <config:config-item config:name="DoNotResetParaAttrsForNumFont" config:type="boolean">false</config:config-item>
510 <config:config-item config:name="ClipAsCharacterAnchoredWriterFlyFrames" config:type="boolean">false</config:config-item>
511 <config:config-item config:name="PrintTables" config:type="boolean">true</config:config-item>
512 <config:config-item config:name="AddParaTableSpacingAtStart" config:type="boolean">true</config:config-item>
513 </config:config-item-set>
514 }
515 ' </config:config-item-set>' + LineEnding +
516 ' </office:settings>' + LineEnding +
517 '</office:document-settings>';
518 end;
519
520 procedure TvODTVectorialWriter.WriteStyles(AData: TvVectorialDocument);
521 var
522 i: Integer;
523 CurStyle: TvStyle;
524 lTextPropsStr, lParagraphPropsStr, lCurStyleTmpStr, CurStyleParent : string;
525 CurListStyle: TvListStyle;
526 j: Integer;
527 CurListLevelStyle: TvListLevelStyle;
528 CurLevel, sLevelAttr: String;
529 begin
530 FStyles :=
531 XML_HEADER + LineEnding +
532 '<office:document-styles xmlns:office="' + SCHEMAS_XMLNS_OFFICE + '"' +
533 ' xmlns:style="' + SCHEMAS_XMLNS_STYLE + '"' +
534 ' xmlns:text="' + SCHEMAS_XMLNS_TEXT + '"' +
535 ' xmlns:table="' + SCHEMAS_XMLNS_TABLE + '"' +
536 ' xmlns:draw="' + SCHEMAS_XMLNS_DRAW + '"' +
537 ' xmlns:fo="' + SCHEMAS_XMLNS_FO + '"' +
538 ' xmlns:xlink="' + SCHEMAS_XMLNS_XLINK + '"' +
539 ' xmlns:dc="' + SCHEMAS_XMLNS_DC + '"' +
540 ' xmlns:meta="' + SCHEMAS_XMLNS_META + '"' +
541 ' xmlns:number="' + SCHEMAS_XMLNS_NUMBER + '"' +
542 ' xmlns:svg="' + SCHEMAS_XMLNS_SVG + '"' +
543 ' xmlns:chart="' + SCHEMAS_XMLNS_CHART + '"' +
544 ' xmlns:dr3d="' + SCHEMAS_XMLNS_DR3D + '"' +
545 ' xmlns:math="' + SCHEMAS_XMLNS_MATH + '"' +
546 ' xmlns:form="' + SCHEMAS_XMLNS_FORM + '"' +
547 ' xmlns:script="' + SCHEMAS_XMLNS_SCRIPT + '"' +
548 ' xmlns:ooo="' + SCHEMAS_XMLNS_OOO + '"' +
549 ' xmlns:ooow="' + SCHEMAS_XMLNS_OOOW + '"' +
550 ' xmlns:oooc="' + SCHEMAS_XMLNS_OOOC + '"' +
551 ' xmlns:dom="' + SCHEMAS_XMLNS_DOM + '"' +
552 ' xmlns:rpt="' + SCHEMAS_XMLNS_RPT + '"' +
553 ' xmlns:of="' + SCHEMAS_XMLNS_OF + '"' +
554 ' xmlns:xhtml="' + SCHEMAS_XMLNS_XHTML + '"' +
555 ' xmlns:grddl="' + SCHEMAS_XMLNS_GRDDL + '"' +
556 ' xmlns:officeooo="' + SCHEMAS_XMLNS_OFFICEOOO + '"' +
557 ' xmlns:tableooo="' + SCHEMAS_XMLNS_TABLEOOO + '"' +
558 ' xmlns:drawooo="' + SCHEMAS_XMLNS_DRAWOOO + '"' +
559 ' xmlns:calcext="' + SCHEMAS_XMLNS_CALCEXT + '"' +
560 ' xmlns:css3t="' + SCHEMAS_XMLNS_CSS3T + '"' +
561 ' office:version="1.2">' + LineEnding;
562
563 // TODO: Parse Styles for Fonts not included in the list below...
564 FStyles := FStyles +
565 '<office:font-face-decls>' + LineEnding +
566 ' <style:font-face style:name="Mangal1" svg:font-family="Mangal" />' + LineEnding +
567 ' <style:font-face style:name="OpenSymbol" svg:font-family="OpenSymbol" />' + LineEnding +
568 ' <style:font-face style:name="Times New Roman" svg:font-family="Times New Roman" style:font-family-generic="roman" style:font-pitch="variable" />' + LineEnding +
569 ' <style:font-face style:name="Arial" svg:font-family="Arial" />' + LineEnding +
570 ' <style:font-face style:name="Verdana" svg:font-family="Verdana" />' + LineEnding +
571 ' <style:font-face style:name="Mangal" svg:font-family="Mangal" style:font-family-generic="system" style:font-pitch="variable" />' + LineEnding +
572 ' <style:font-face style:name="Microsoft YaHei" svg:font-family="''Microsoft YaHei''" style:font-family-generic="system" style:font-pitch="variable" />' + LineEnding +
573 ' <style:font-face style:name="SimSun" svg:font-family="SimSun" style:font-family-generic="system" style:font-pitch="variable" />' + LineEnding +
574 '</office:font-face-decls>' + LineEnding;
575
576 // ----------------------------
577 // Styles
578 // ----------------------------
579
580 FStyles := FStyles +
581 '<office:styles>' + LineEnding;
582
583 FStyles := FStyles +
584 ' <style:default-style style:family="graphic">' + LineEnding +
585 ' <style:graphic-properties svg:stroke-color="#3465af" draw:fill-color="#729fcf" fo:wrap-option="no-wrap" draw:shadow-offset-x="0.3cm" draw:shadow-offset-y="0.3cm" draw:start-line-spacing-horizontal="0.283cm" draw:start-line-spacing-vertical="0.283cm" draw:end-line-spacing-horizontal="0.283cm" draw:end-line-spacing-vertical="0.283cm" style:flow-with-text="false" />' + LineEnding +
586 ' <style:paragraph-properties style:text-autospace="ideograph-alpha" style:line-break="strict" style:writing-mode="lr-tb" style:font-independent-line-spacing="false">' + LineEnding +
587 ' <style:tab-stops />' + LineEnding +
588 ' </style:paragraph-properties>' + LineEnding +
589 ' <style:text-properties style:use-window-font-color="true" fo:font-size="12pt" fo:language="fi" fo:country="FI" style:letter-kerning="true" style:font-size-asian="10.5pt" style:language-asian="zh" style:country-asian="CN" style:font-size-complex="12pt" style:language-complex="hi" style:country-complex="IN" />' + LineEnding +
590 ' </style:default-style>' + LineEnding +
591 ' <style:default-style style:family="paragraph">' + LineEnding +
592 ' <style:paragraph-properties fo:hyphenation-ladder-count="no-limit" style:text-autospace="ideograph-alpha" style:punctuation-wrap="hanging" style:line-break="strict" style:tab-stop-distance="1.251cm" style:writing-mode="page" />' + LineEnding +
593 ' <style:text-properties style:use-window-font-color="true" style:font-name="Times New Roman" fo:font-size="12pt" fo:language="fi" fo:country="FI" style:letter-kerning="true" style:font-name-asian="SimSun" style:font-size-asian="10.5pt" style:language-asian="zh" style:country-asian="CN" style:font-name-complex="Mangal" style:font-size-complex="12pt" style:language-complex="hi" style:country-complex="IN" fo:hyphenate="false" fo:hyphenation-remain-char-count="2" fo:hyphenation-push-char-count="2" />' + LineEnding +
594 ' </style:default-style>' + LineEnding +
595 ' <style:default-style style:family="table">' + LineEnding +
596 ' <style:table-properties table:border-model="collapsing" />' + LineEnding +
597 ' </style:default-style>' + LineEnding +
598 ' <style:default-style style:family="table-row">' + LineEnding +
599 ' <style:table-row-properties fo:keep-together="auto" />' + LineEnding +
600 ' </style:default-style>' + LineEnding;
601
602 FStyles := FStyles +
603 ' <style:style style:name="Standard" style:family="paragraph" style:class="text" />' + LineEnding;
604
605 for i := 0 to AData.GetStyleCount() - 1 do
606 begin
607 lParagraphPropsStr := '';
608 CurStyle := AData.GetStyle(i);
609
610 if CurStyle.Parent = nil then CurStyleParent := 'Standard'
611 else CurStyleParent := StyleNameToODTStyleName(AData, AData.FindStyleIndex(CurStyle.Parent), False);
612
613 lTextPropsStr := TextPropertiesToString(CurStyle);
614
615 if CurStyle.GetKind() = vskTextSpan then
616 begin
617 {
618 <style:style style:name="MT2" style:family="text">
619 <style:text-properties fo:font-style="italic" fo:font-weight="normal" officeooo:rsid="0009f49c" style:font-style-asian="italic" style:font-weight-asian="normal" style:font-style-complex="italic" style:font-weight-complex="normal" />
620 </style:style>
621 }
622 lCurStyleTmpStr := // tmp string to help see the text in the debugger
623 ' <style:style style:name="'+StyleNameToODTStyleName(AData, i, False)+'" style:display-name="'+ CurStyle.Name +'" style:family="text" style:parent-style-name="'+CurStyleParent+'" >' + LineEnding +
624 ' <style:text-properties '+lTextPropsStr+' />' + LineEnding +
625 ' </style:style>' + LineEnding;
626 FStyles := FStyles + lCurStyleTmpStr;
627 end
628 // Paragraph kind
629 else
630 begin
631 lParagraphPropsStr := '';
632
633 // If any one value in here is set, then ALL inherited values are overridden
634 // In other words, we must fully define the style paragraph properties,
635 // we can't rely on LibreOffice Style Inheritance...
636 // TODO: Confirm if this applies to Text Properties as well...
637
638 if sseMarginTop in CurStyle.SetElements then
639 lParagraphPropsStr := lParagraphPropsStr + 'fo:margin-top="'+FloatToODTText(CurStyle.MarginTop)+'mm" ';
640 if sseMarginBottom in CurStyle.SetElements then
641 lParagraphPropsStr := lParagraphPropsStr + 'fo:margin-bottom="'+FloatToODTText(CurStyle.MarginBottom)+'mm" ';
642 if sseMarginLeft in CurStyle.SetElements then
643 lParagraphPropsStr := lParagraphPropsStr + 'fo:margin-left="'+FloatToODTText(CurStyle.MarginLeft)+'mm" ';
644 if sseMarginRight in CurStyle.SetElements then
645 lParagraphPropsStr := lParagraphPropsStr + 'fo:margin-right="'+FloatToODTText(CurStyle.MarginRight)+'mm" ';
646 if (spbfAlignment in CurStyle.SetElements) then
647 lParagraphPropsStr := lParagraphPropsStr + 'fo:text-align="'+LU_ALIGN[CurStyle.Alignment]+'" ';
648 if CurStyle.SuppressSpacingBetweenSameParagraphs then
649 lParagraphPropsStr := lParagraphPropsStr + 'style:contextual-spacing="true" ';
650 //else
651 // lParagraphPropsStr := lParagraphPropsStr + 'style:contextual-spacing="false" ';
652
653 lCurStyleTmpStr := // tmp string to help see the text in the debugger
654 ' <style:style style:name="'+StyleNameToODTStyleName(AData, i, False)+'" style:display-name="'+ CurStyle.Name +'" style:family="paragraph" style:parent-style-name="'+CurStyleParent+'" style:class="text">' + LineEnding +
655 ' <style:paragraph-properties '+lParagraphPropsStr+' />' + LineEnding +
656 ' <style:text-properties '+lTextPropsStr+' />' + LineEnding +
657 ' </style:style>' + LineEnding;
658 FStyles := FStyles + lCurStyleTmpStr;
659 end;
660 {
661 <style:style style:name="Heading" style:family="paragraph" style:parent-style-name="Standard" style:next-style-name="Text_20_body" style:class="text">
662 <style:paragraph-properties fo:margin-top="0.423cm" fo:margin-bottom="0.212cm" style:contextual-spacing="false" fo:keep-with-next="always" />
663 <style:text-properties style:font-name="Arial" fo:font-size="14pt" style:font-name-asian="Microsoft YaHei" style:font-size-asian="14pt" style:font-name-complex="Mangal" style:font-size-complex="14pt" />
664 </style:style>
665 <style:style style:name="List" style:family="paragraph" style:parent-style-name="Text_20_body" style:class="list">
666 <style:text-properties style:font-size-asian="12pt" style:font-name-complex="Mangal1" />
667 </style:style>
668 <style:style style:name="Caption" style:family="paragraph" style:parent-style-name="Standard" style:class="extra">
669 <style:paragraph-properties fo:margin-top="0.212cm" fo:margin-bottom="0.212cm" style:contextual-spacing="false" text:number-lines="false" text:line-number="0" />
670 <style:text-properties fo:font-size="12pt" fo:font-style="italic" style:font-size-asian="12pt" style:font-style-asian="italic" style:font-name-complex="Mangal1" style:font-size-complex="12pt" style:font-style-complex="italic" />
671 </style:style>
672 <style:style style:name="Index" style:family="paragraph" style:parent-style-name="Standard" style:class="index">
673 <style:paragraph-properties text:number-lines="false" text:line-number="0" />
674 <style:text-properties style:font-size-asian="12pt" style:font-name-complex="Mangal1" />
675 </style:style>
676 <style:style style:name="Heading_20_1" style:display-name="Heading 1" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="1" style:class="text">
677 <style:text-properties fo:font-size="115%" fo:font-weight="bold" style:font-size-asian="115%" style:font-weight-asian="bold" style:font-size-complex="115%" style:font-weight-complex="bold" />
678 </style:style>
679 <style:style style:name="Heading_20_2" style:display-name="Heading 2" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="2" style:class="text">
680 <style:text-properties fo:font-size="14pt" fo:font-style="italic" fo:font-weight="bold" style:font-size-asian="14pt" style:font-style-asian="italic" style:font-weight-asian="bold" style:font-size-complex="14pt" style:font-style-complex="italic" style:font-weight-complex="bold" />
681 </style:style>
682 <style:style style:name="Heading_20_3" style:display-name="Heading 3" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="3" style:class="text">
683 <style:text-properties fo:font-size="14pt" fo:font-weight="bold" style:font-size-asian="14pt" style:font-weight-asian="bold" style:font-size-complex="14pt" style:font-weight-complex="bold" />
684 </style:style>
685 <style:style style:name="Internet_20_link" style:display-name="Internet link" style:family="text">
686 <style:text-properties fo:color="#000080" fo:language="zxx" fo:country="none" style:text-underline-style="solid" style:text-underline-width="auto" style:text-underline-color="font-color" style:language-asian="zxx" style:country-asian="none" style:language-complex="zxx" style:country-complex="none" />
687 </style:style>
688 }
689 end;
690
691 FStyles := FStyles +
692 ' <style:style style:name="Bullet_20_Symbols" style:display-name="Bullet Symbols" style:family="text">' + LineEnding +
693 ' <style:text-properties style:font-name="OpenSymbol" style:font-name-asian="OpenSymbol" style:font-name-complex="OpenSymbol" />' + LineEnding +
694 ' </style:style>' + LineEnding;
695
696 FStyles := FStyles +
697 ' <text:outline-style style:name="Outline">' + LineEnding +
698 ' <text:outline-level-style text:level="1" style:num-format="">' + LineEnding +
699 ' <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">' + LineEnding +
700 ' <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="0.762cm" fo:text-indent="-0.762cm" fo:margin-left="0.762cm" />' + LineEnding +
701 ' </style:list-level-properties>' + LineEnding +
702 ' </text:outline-level-style>' + LineEnding +
703 ' <text:outline-level-style text:level="2" style:num-format="">' + LineEnding +
704 ' <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">' + LineEnding +
705 ' <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="1.016cm" fo:text-indent="-1.016cm" fo:margin-left="1.016cm" />' + LineEnding +
706 ' </style:list-level-properties>' + LineEnding +
707 ' </text:outline-level-style>' + LineEnding +
708 ' <text:outline-level-style text:level="3" style:num-format="">' + LineEnding +
709 ' <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">' + LineEnding +
710 ' <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="1.27cm" fo:text-indent="-1.27cm" fo:margin-left="1.27cm" />' + LineEnding +
711 ' </style:list-level-properties>' + LineEnding +
712 ' </text:outline-level-style>' + LineEnding +
713 ' <text:outline-level-style text:level="4" style:num-format="">' + LineEnding +
714 ' <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">' + LineEnding +
715 ' <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="1.524cm" fo:text-indent="-1.524cm" fo:margin-left="1.524cm" />' + LineEnding +
716 ' </style:list-level-properties>' + LineEnding +
717 ' </text:outline-level-style>' + LineEnding +
718 ' <text:outline-level-style text:level="5" style:num-format="">' + LineEnding +
719 ' <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">' + LineEnding +
720 ' <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="1.778cm" fo:text-indent="-1.778cm" fo:margin-left="1.778cm" />' + LineEnding +
721 ' </style:list-level-properties>' + LineEnding +
722 ' </text:outline-level-style>' + LineEnding +
723 ' <text:outline-level-style text:level="6" style:num-format="">' + LineEnding +
724 ' <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">' + LineEnding +
725 ' <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="2.032cm" fo:text-indent="-2.032cm" fo:margin-left="2.032cm" />' + LineEnding +
726 ' </style:list-level-properties>' + LineEnding +
727 ' </text:outline-level-style>' + LineEnding +
728 ' <text:outline-level-style text:level="7" style:num-format="">' + LineEnding +
729 ' <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">' + LineEnding +
730 ' <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="2.286cm" fo:text-indent="-2.286cm" fo:margin-left="2.286cm" />' + LineEnding +
731 ' </style:list-level-properties>' + LineEnding +
732 ' </text:outline-level-style>' + LineEnding +
733 ' <text:outline-level-style text:level="8" style:num-format="">' + LineEnding +
734 ' <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">' + LineEnding +
735 ' <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="2.54cm" fo:text-indent="-2.54cm" fo:margin-left="2.54cm" />' + LineEnding +
736 ' </style:list-level-properties>' + LineEnding +
737 ' </text:outline-level-style>' + LineEnding +
738 ' <text:outline-level-style text:level="9" style:num-format="">' + LineEnding +
739 ' <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">' + LineEnding +
740 ' <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="2.794cm" fo:text-indent="-2.794cm" fo:margin-left="2.794cm" />' + LineEnding +
741 ' </style:list-level-properties>' + LineEnding +
742 ' </text:outline-level-style>' + LineEnding +
743 ' <text:outline-level-style text:level="10" style:num-format="">' + LineEnding +
744 ' <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">' + LineEnding +
745 ' <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="3.048cm" fo:text-indent="-3.048cm" fo:margin-left="3.048cm" />' + LineEnding +
746 ' </style:list-level-properties>' + LineEnding +
747 ' </text:outline-level-style>' + LineEnding +
748 ' </text:outline-style>' + LineEnding;
749
750 // Build up the List definitions - store in Styles.xml, not content.xml
751 For i := 0 To AData.GetListStyleCount-1 Do
752 begin
753 CurListStyle := AData.GetListStyle(i);
754
755 FStyles := FStyles +
756 ' <text:list-style style:name="'+ListStyleNameToODTText(AData, CurListStyle)+'">' + LineEnding;
757
758 For j := 0 To CurListStyle.GetListLevelStyleCount-1 Do
759 Begin
760 CurListLevelStyle := CurListStyle.GetListLevelStyle(j);
761 CurLevel := IntToStr(CurListLevelStyle.Level+1); // Note the +1...
762
763 // Open Bullet or Number...
764 If CurListLevelStyle.Kind=vlskBullet Then
765 FStyles := FStyles +
766 ' <text:list-level-style-bullet text:level="'+CurLevel+'" '+
767 'text:style-name="Bullet_20_Symbols" '+
768 'text:bullet-char="'+CurListLevelStyle.Bullet+'">' + LineEnding
769
770 Else
771 Begin
772 sLevelAttr:='text:level="'+CurLevel+'" ';
773
774 If CurListLevelStyle.Prefix<>'' Then
775 sLevelAttr := Format('%s style:num-prefix="%s"', [sLevelAttr, CurListLevelStyle.Prefix]);
776
777 If CurListLevelStyle.Suffix<>'' Then
778 sLevelAttr := Format('%s style:num-suffix="%s"', [sLevelAttr, CurListLevelStyle.Suffix]);
779
780 sLevelAttr := sLevelAttr + ' style:num-format="'+LU_NUMBERFORMAT[CurListLevelStyle.NumberFormat]+'"';
781
782 // Display previous levels in Leader?
783 If (CurListLevelStyle.DisplayLevels) And (CurLevel<>'1') Then
784 sLevelAttr := Format('%s text:display-levels="%s"', [sLevelAttr, CurLevel]);
785
786 FStyles := FStyles +
787 ' <text:list-level-style-number ' + sLevelAttr +'>' + LineEnding;
788 End;
789
790 // Common Level properties
791 FStyles:=FStyles +
792 ' <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">' + LineEnding +
793 ' <style:list-level-label-alignment text:label-followed-by="listtab" '+
794 // 'text:list-tab-stop-position="'+FloatToODTText(CurListLevelStyle.MarginLeft/10)+'cm" '+
795 'fo:text-indent="-'+FloatToODTText(CurListLevelStyle.HangingIndent/10)+'cm" '+
796 'fo:margin-left="'+FloatToODTText(CurListLevelStyle.MarginLeft/10)+'cm" />' + LineEnding +
797 ' </style:list-level-properties>' + LineEnding;
798
799 // Close Bullet or Number
800 If CurListLevelStyle.Kind=vlskBullet Then
801 FStyles:=FStyles + ' </text:list-level-style-bullet>' + LineEnding
802 Else
803 FStyles:=FStyles + ' </text:list-level-style-number>' + LineEnding
804 end;
805
806 FStyles := FStyles + ' </text:list-style>' + LineEnding;
807 end;
808
809 FStyles := FStyles +
810 ' <text:notes-configuration text:note-class="footnote" style:num-format="1" text:start-value="0" text:footnotes-position="page" text:start-numbering-at="document" />' + LineEnding;
811 FStyles := FStyles +
812 ' <text:notes-configuration text:note-class="endnote" style:num-format="i" text:start-value="0" />' + LineEnding;
813 FStyles := FStyles +
814 ' <text:linenumbering-configuration text:number-lines="false" text:offset="0.499cm" style:num-format="1" text:number-position="left" text:increment="5" />' + LineEnding;
815 FStyles := FStyles +
816 '</office:styles>' + LineEnding;
817
818 // ----------------------------
819 // Automatic Styles
820 // ----------------------------
821
822 FStyles := FStyles +
823 '<office:automatic-styles>' + LineEnding +
824 FAutomaticStyles + LineEnding +
825 '</office:automatic-styles>' + LineEnding;
826
827 FStyles := FStyles +
828 '<office:master-styles>' + LineEnding +
829 FMasterStyles + LineEnding +
830 '</office:master-styles>' + LineEnding;
831
832 FStyles := FStyles +
833 '</office:document-styles>';
834 end;
835
836 procedure TvODTVectorialWriter.WriteDocument(AData: TvVectorialDocument);
837 var
838 i: Integer;
839 sPrefix : String;
840 sAutomaticStyles : String;
841 CurPage: TvPage;
842 CurTextPage: TvTextPageSequence absolute CurPage;
843 oCrossRef: TListStyle_Style;
844
845 begin
846 // content.xml will be built up by
847 // sPrefix + sAutomaticStyles + FContent
848
849 sPrefix :=
850 XML_HEADER + LineEnding +
851 '<office:document-content xmlns:office="' + SCHEMAS_XMLNS_OFFICE + '"' +
852 ' xmlns:style="' + SCHEMAS_XMLNS_STYLE + '"' +
853 ' xmlns:text="' + SCHEMAS_XMLNS_TEXT + '"' +
854 ' xmlns:table="' + SCHEMAS_XMLNS_TABLE + '"' +
855 ' xmlns:draw="' + SCHEMAS_XMLNS_DRAW + '"' +
856 ' xmlns:fo="' + SCHEMAS_XMLNS_FO + '"' +
857 ' xmlns:xlink="' + SCHEMAS_XMLNS_XLINK + '"' +
858 ' xmlns:dc="' + SCHEMAS_XMLNS_DC + '"' +
859 ' xmlns:meta="' + SCHEMAS_XMLNS_META + '"' +
860 ' xmlns:number="' + SCHEMAS_XMLNS_NUMBER + '"' +
861 ' xmlns:svg="' + SCHEMAS_XMLNS_SVG + '"' +
862 ' xmlns:chart="' + SCHEMAS_XMLNS_CHART + '"' +
863 ' xmlns:dr3D="' + SCHEMAS_XMLNS_DR3D + '"' +
864 ' xmlns:math="' + SCHEMAS_XMLNS_MATH + '"' +
865 ' xmlns:form="' + SCHEMAS_XMLNS_FORM + '"' +
866 ' xmlns:script="' + SCHEMAS_XMLNS_SCRIPT + '"' +
867 ' xmlns:ooo="' + SCHEMAS_XMLNS_OOO + '"' +
868 ' xmlns:oooc="' + SCHEMAS_XMLNS_OOOC + '"' +
869 ' xmlns:xforms="' + SCHEMAS_XMLNS_XFORMS + '"' +
870 ' xmlns:xsi="' + SCHEMAS_XMLNS_XSI + '"' +
871 ' xmlns:rpt="' + SCHEMAS_XMLNS_RPT + '"' +
872 ' xmlns:of="' + SCHEMAS_XMLNS_OF + '"' +
873 ' xmlns:xhtml="' + SCHEMAS_XMLNS_XHTML + '"' +
874 ' xmlns:grddl="' + SCHEMAS_XMLNS_GRDDL + '"' +
875 ' xmlns:officeooo="' + SCHEMAS_XMLNS_OFFICEOOO + '"' +
876 ' xmlns:tableooo="' + SCHEMAS_XMLNS_TABLEOOO + '"' +
877 ' xmlns:drawooo="' + SCHEMAS_XMLNS_DRAWOOO + '"' +
878 ' xmlns:calcext="' + SCHEMAS_XMLNS_CALCEXT + '"' +
879 ' xmlns:field="' + SCHEMAS_XMLNS_FIELD + '"' +
880 ' xmlns:formx="' + SCHEMAS_XMLNS_FORMX + '"' +
881 ' xmlns:css3t="' + SCHEMAS_XMLNS_CSS3T + '"' +
882 ' office:version="1.2">' + LineEnding;
883 sPrefix := sPrefix +
884 ' <office:scripts />' + LineEnding;
885 sPrefix := sPrefix +
886 ' <office:font-face-decls>' + LineEnding +
887 ' <style:font-face style:name="Mangal1" svg:font-family="Mangal" />' + LineEnding +
888 ' <style:font-face style:name="OpenSymbol" svg:font-family="OpenSymbol" />' + LineEnding +
889 ' <style:font-face style:name="Times New Roman" svg:font-family="''Times New Roman''" style:font-family-generic="roman" style:font-pitch="variable" />' + LineEnding +
890 ' <style:font-face style:name="Arial" svg:font-family="Arial" style:font-family-generic="swiss" style:font-pitch="variable" />' + LineEnding +
891 ' <style:font-face style:name="Mangal" svg:font-family="Mangal" style:font-family-generic="system" style:font-pitch="variable" />' + LineEnding +
892 ' <style:font-face style:name="Microsoft YaHei" svg:font-family="''Microsoft YaHei''" style:font-family-generic="system" style:font-pitch="variable" />' + LineEnding +
893 ' <style:font-face style:name="SimSun" svg:font-family="SimSun" style:font-family-generic="system" style:font-pitch="variable" />' + LineEnding +
894 ' </office:font-face-decls>' + LineEnding;
895
896 // Build the main content of the document
897 FContent := ' <office:body>' + LineEnding;
898
899 FContent := FContent +
900 ' <office:text>' + LineEnding;
901
902 FContent := FContent +
903 ' <text:sequence-decls>' + LineEnding +
904 ' <text:sequence-decl text:display-outline-level="0" text:name="Illustration" />' + LineEnding +
905 ' <text:sequence-decl text:display-outline-level="0" text:name="Table" />' + LineEnding +
906 ' <text:sequence-decl text:display-outline-level="0" text:name="Text" />' + LineEnding +
907 ' <text:sequence-decl text:display-outline-level="0" text:name="Drawing" />' + LineEnding +
908 ' </text:sequence-decls>' + LineEnding;
909
910 FNewPageSequence := False;
911
912 // During each WritePage (and nested calls) FContentAutomaticStyles gets built up
913 for i := 0 to AData.GetPageCount()-1 do
914 begin
915 CurPage := AData.GetPage(i);
916 if CurPage is TvTextPageSequence then
917 WritePage(CurTextPage, AData);
918 end;
919
920 FContent := FContent +
921 ' </office:text>' + LineEnding;
922 FContent := FContent +
923 ' </office:body>' + LineEnding;
924 FContent := FContent +
925 '</office:document-content>' + LineEnding;
926
927 // Build up the automatic styles detailed in the content.xml
928 sAutomaticStyles := ' <office:automatic-styles>' + LineEnding;
929
930 // Add all the List Definition / Paragraph Style
931 // cross references
932
933 for i := 0 to FList_StyleCrossRef.Count-1 Do
934 begin
935 oCrossRef := TListStyle_Style(FList_StyleCrossRef[i]);
936
937 sAutomaticStyles := sAutomaticStyles +
938 ' <style:style style:name="'+FList_StyleCrossRef.AsText(i)+'" '+
939 'style:family="paragraph" '+
940 'style:parent-style-name="'+StyleNameToODTStyleName(AData, oCrossRef.Style, False)+'" '+
941 'style:list-style-name="'+ListStyleNameToODTText(AData, oCrossRef.ListStyle)+'" />' + LineEnding;
942 end;
943
944 // Now add any Automatic Styles built during WritePage..
945 sAutomaticStyles := sAutomaticStyles + FContentAutomaticStyles;
946
947 sAutomaticStyles := sAutomaticStyles +
948 ' </office:automatic-styles>' + LineEnding;
949
950 // Now piece it all together
951 FContent := sPrefix + sAutomaticStyles + FContent;
952 end;
953
954 procedure TvODTVectorialWriter.WritePage(ACurPage: TvTextPageSequence; AData: TvVectorialDocument);
955 var
956 i: Integer;
957 lCurEntity: TvEntity;
958 begin
959 FNewPageSequence := True;
960 for i := 0 to ACurPage.GetEntitiesCount()-1 do
961 begin
962 lCurEntity := ACurPage.GetEntity(i);
963
964 if (lCurEntity is TvParagraph) then
965 WriteParagraph(TvParagraph(lCurEntity), ACurPage, AData);
966 if (lCurEntity is TvList) then
967 WriteList(TvList(lCurEntity), ACurPage, AData);
968 if (lCurEntity is TvTable) then
969 WriteTable(TvTable(lCurEntity), ACurPage, AData);
970 end;
971 end;
972
973 procedure TvODTVectorialWriter.WriteParagraph(AEntity: TvParagraph;
974 ACurPage: TvTextPageSequence; AData: TvVectorialDocument);
975 var
976 EntityKindName, AEntityStyleName, lOutlineLevel: string;
977 sAutoStyleName, sPageMasterName, sPageLayoutName : String;
978 sOrientation : String;
979 i: Integer;
980 lCurEntity: TvEntity;
981 dWidth, dHeight : Double;
982 begin
983 lOutlineLevel := '';
984 if AEntity.Style = nil then
985 begin
986 EntityKindName := 'p';
987 AEntityStyleName := 'Standard';
988 end
989 else
990 begin
991 case AEntity.Style.GetKind() of
992 vskHeading:
993 begin
994 EntityKindName := 'h';
995 lOutlineLevel := 'text:outline-level="'+IntToStr(AEntity.Style.HeadingLevel)+'" ';
996 end;
997 else // vskTextBody;
998 EntityKindName := 'p';
999 end;
1000
1001 AEntityStyleName := StyleNameToODTStyleName(AData, AEntity.Style, False);
1002 end;
1003
1004 If FNewPageSequence Then
1005 begin
1006 // Create an automatic style in both content.xml and style.xml
1007 // and reference the newly created style in the text we're just
1008 // about to write
1009 // TODO: Find out how to deal with new Page Sequences with other
1010 // objects at the start of the page...
1011
1012 Inc(FAutomaticStyleID);
1013 i := AData.GetPageIndex(ACurPage);
1014
1015 sAutoStyleName := AEntityStyleName+'_P' + IntToStr(FAutomaticStyleID);
1016 sPageMasterName := 'Page_Sequence_'+IntToStr(i+1);
1017 sPageLayoutName := 'MPM'+IntToStr(i+1);
1018
1019 // Create an automatic style descended from AEntityStyleName
1020 FContentAutomaticStyles := FContentAutomaticStyles +
1021 '<style:style style:name="'+sAutoStyleName+'"' +
1022 ' style:family="paragraph"' +
1023 ' style:master-page-name="'+sPageMasterName+'"' +
1024 ' style:parent-style-name="'+ AEntityStyleName +'">' +
1025 LineEnding +
1026 '</style:style>'+ LineEnding;
1027
1028
1029 // Define the MasterStyles in Styles.xml
1030 // TODO: Add Header and Footer content to FMasterStyles
1031 FMasterStyles := FMasterStyles +
1032 '<style:master-page style:name="'+sPageMasterName+'" style:page-layout-name="'+sPageLayoutName+'"/>' + LineEnding;
1033
1034 dWidth := ACurPage.Width;
1035 If dWidth=0 Then
1036 dWidth := AData.Width;
1037 If dWidth=0 Then
1038 dWidth := 210; // Default A4
1039
1040 dHeight := ACurPage.Height;
1041 If dHeight=0 Then
1042 dHeight := AData.Height;
1043 If dHeight=0 Then
1044 dHeight := 297; // Default A4
1045
1046 If dWidth>dHeight Then
1047 sOrientation := 'landscape'
1048 else
1049 sOrientation := 'portrait';
1050
1051 // Define the page layout in Styles.xml
1052 // TODO: Add Page Margins...
1053 FAutomaticStyles := FAutomaticStyles +
1054 '<style:page-layout style:name="'+sPageLayoutName+'">'+ LineEnding+
1055 ' <style:page-layout-properties '+
1056 ' fo:page-width="'+FloatToODTText(dWidth)+'mm"'+
1057 ' fo:page-height="'+FloatToODTText(dHeight)+'mm"'+
1058 ' style:print-orientation="'+sOrientation+'"'+
1059 ' style:num-format="1" fo:margin-top="0.7874in" fo:margin-bottom="0.7874in" fo:margin-left="0.7874in" fo:margin-right="0.7874in" style:writing-mode="lr-tb" style:footnote-max-height="0in">'+ LineEnding;
1060
1061 FAutomaticStyles := FAutomaticStyles +
1062 ' <style:footnote-sep style:width="0.0071in" style:distance-before-sep="0.0398in" style:distance-after-sep="0.0398in" style:line-style="solid" style:adjustment="left" style:rel-width="25%" style:color="#000000"/>'+ LineEnding+
1063 ' </style:page-layout-properties>'+ LineEnding+
1064 ' <style:header-style/>'+ LineEnding+
1065 ' <style:footer-style/>'+ LineEnding+
1066 '</style:page-layout>' + LineEnding;
1067
1068 // Ensure the text is written out using the new Automatic Style
1069 AEntityStyleName:=sAutoStyleName;
1070 FNewPageSequence:=False;
1071 end;
1072
1073 FContent := FContent +
1074 ' <text:'+EntityKindName+' text:style-name="'+AEntityStyleName+'" ' + lOutlineLevel +'>';
1075
1076 for i := 0 to AEntity.GetEntitiesCount()-1 do
1077 begin
1078 lCurEntity := AEntity.GetEntity(i);
1079
1080 if (lCurEntity is TvText) then
1081 WriteTextSpan(TvText(lCurEntity), AEntity, ACurPage, AData)
1082 else if (lCurEntity is TvField) then
1083 WriteField(TvField(lCurEntity), AEntity, ACurPage, AData)
1084 else if (lCurEntity is TvRasterImage) then
1085 WriteRasterImage(TvRasterImage(lCurEntity), AEntity, ACurPage, AData)
1086 else
1087 raise exception.create('TvParagraph subentity '+lCurEntity.ClassName+' not handled');
1088 end;
1089
1090 FContent := FContent +
1091 '</text:'+EntityKindName+'>' + LineEnding;
1092 end;
1093
1094 procedure TvODTVectorialWriter.WriteTextSpan(AEntity: TvText; AParagraph: TvParagraph;
1095 ACurPage: TvTextPageSequence; AData: TvVectorialDocument);
1096 var
1097 AEntityStyleName: string;
1098 lStyle: TvStyle;
1099 sText: String;
1100 begin
1101 lStyle := AEntity.Style;
1102 If lStyle<>Nil Then
1103 AEntityStyleName:=StyleNameToODTStyleName(AData, lStyle, False);
1104 // No need to all GetCombinedStyle as Paragraph Style already applied in text:p tag
1105 (*
1106 lStyle := AEntity.GetCombinedStyle(AParagraph);
1107 if lStyle = nil then
1108 begin
1109 AEntityStyleName := 'Standard';
1110 end
1111 else
1112 begin
1113 AEntityStyleName := StyleNameToODTStyleName(AData, lStyle, False);
1114 end;
1115 *)
1116 {
1117 <text:p text:style-name="P2">
1118 Lazaru
1119 <text:span text:style-name="T2">s is a fre</text:span>
1120 e and open sou
1121 <text:span text:style-name="T5">rce development tool for</text:span>
1122 the Free Pascal compiler, which is also free and open source.
1123 </text:p>
1124 }
1125 // Note that here we write only text spans!
1126 sText := EscapeHTML(AEntity.Value.Text);
1127
1128 // Trim extra CRLF appended by TStringList.Text
1129 If DefaultTextLineBreakStyle = tlbsCRLF Then
1130 sText := Copy(sText, 1, Length(sText) - 2)
1131 Else
1132 sText := Copy(sText, 1, Length(sText) - 1);
1133
1134 sText := StringReplace(sText, ' ', ' <text:s/>', [rfReplaceAll]);
1135 sText := StringReplace(sText, #09, '<text:tab/>', [rfReplaceAll]);
1136 sText := StringReplace(sText, #13, '<text:line-break/>', [rfReplaceAll]);
1137 sText := StringReplace(sText, #10, '', [rfReplaceAll]);
1138
1139 If lStyle <> nil Then
1140 sText := Format('<text:span text:style-name="%s">%s</text:span>', [
1141 AEntityStyleName, sText])
1142 else
1143 sText := Format('<text:span>%s</text:span>', [sText]);
1144
1145 FContent := FContent + sText;
1146 end;
1147
1148 procedure TvODTVectorialWriter.WriteField(AEntity: TvField;
1149 AParagraph: TvParagraph; ACurPage: TvTextPageSequence;
1150 AData: TvVectorialDocument);
1151 Var
1152 sDateStyleName : String;
1153 i: Integer;
1154 cCurrChar: Char;
1155 cPrevChar: Char;
1156 sTag: String;
1157 iLen: Integer;
1158 begin
1159 // <number:day number:calendar="gregorian"/>
1160 // <number:text>/</number:text>
1161 // <number:month number:style="long" number:calendar="gregorian"/>
1162 // <number:text>/</number:text>
1163 // <number:year number:style="long" number:calendar="gregorian"/>
1164 // <number:text> </number:text>
1165 // <number:hours/>
1166 // <number:text>:</number:text>
1167 // <number:minutes number:style="long"/>
1168 // <number:text> </number:text>
1169 // <number:am-pm/>
1170 if AEntity.Kind in [vfkDate, vfkDateCreated] Then
1171 begin
1172 inc(FDateCount);
1173 sDateStyleName := Format('Date_%d', [FDateCount]);
1174
1175 FContentAutomaticStyles:=FContentAutomaticStyles +
1176 ' <number:date-style style:name="'+sDateStyleName+'"> '+LineEnding;
1177
1178 cPrevChar := Chr(0);
1179 i := 1;
1180 while (i<=Length(AEntity.DateFormat)) do
1181 begin
1182 cCurrChar := AEntity.DateFormat[i];
1183
1184 iLen := 1;
1185 if cCurrChar<>cPrevChar Then
1186 begin
1187 // Find out how many characters repeat in a row...
1188 while (i+iLen<=Length(AEntity.DateFormat)) And (AEntity.DateFormat[i+iLen]=cCurrChar) do
1189 inc(iLen);
1190
1191 sTag := '';
1192
1193 case cCurrChar Of
1194 'd' :
1195 begin
1196 Case iLen Of
1197 1 : sTag := '<number:day/>';
1198 2 : sTag := '<number:day number:style="long"/>';
1199 3 : sTag := '<number:day-of-week/>';
1200 else
1201 sTag := '<number:day-of-week number:style="long"/>';
1202 end;
1203 end;
1204 'M' :
1205 begin
1206 case iLen Of
1207 1 : sTag := '<number:month/>';
1208 2 : sTag := '<number:month number:style="long"/>';
1209 3 : sTag := '<number:month number:textual="true"/>';
1210 else
1211 sTag := '<number:month number:textual="true" number:style="long"/>';
1212 end;
1213 end;
1214 'y' :
1215 begin
1216 if iLen=2 then
1217 sTag := '<number:year/>'
1218 else
1219 sTag := '<number:year number:style="long"/>';
1220 end;
1221 'h' :
1222 begin
1223 if iLen=1 then
1224 sTag := '<number:hours/>'
1225 else
1226 sTag := '<number:hours number:style="long"/>';
1227 end;
1228 'm' :
1229 begin
1230 if iLen=1 then
1231 sTag := '<number:minutes/>'
1232 else
1233 sTag := '<number:minutes number:style="long"/>';
1234 end;
1235 's' :
1236 begin
1237 if iLen=1 then
1238 sTag := '<number:seconds/>'
1239 else
1240 sTag := '<number:seconds number:style="long"/>';
1241 end;
1242 'a' :
1243 begin
1244 sTag := '<number:am-pm/>';
1245 iLen := 5;
1246 end;
1247 else
1248 sTag := '<number:text>'+cCurrChar+'</number:text>';
1249 end;
1250
1251 cPrevChar := cCurrChar;
1252 end;
1253
1254 FContentAutomaticStyles:=FContentAutomaticStyles +
1255 ' '+sTag + LineEnding;
1256
1257 Inc(i, iLen);
1258 end;
1259
1260 FContentAutomaticStyles:=FContentAutomaticStyles +
1261 ' </number:date-style> '+LineEnding;
1262 end;
1263
1264 case AEntity.Kind of
1265 vfkNumPages:
1266 begin
1267 FContent:=FContent +
1268 '<text:page-count style:num-format="'+LU_NUMBERFORMAT[AEntity.NumberFormat]+
1269 '">'+IntToStr(AData.GetPageCount)+'</text:page-count>';
1270 end;
1271 vfkPage:
1272 begin
1273 FContent:=FContent +
1274 '<text:page-number style:num-format="'+LU_NUMBERFORMAT[AEntity.NumberFormat]+
1275 '" text:fixed="false">'+IntToStr(AData.GetPageIndex(ACurPage))+'</text:page-number>';
1276 end;
1277 vfkAuthor:
1278 begin
1279 FContent:=FContent +
1280 '<text:initial-creator text:fixed="false">FPVECTORIAL</text:initial-creator>';
1281 end;
1282 vfkDateCreated:
1283 begin
1284 FContent:=FContent +
1285 '<text:creation-date style:data-style-name="'+sDateStyleName+'">'+DateToStr(Now)+'</text:creation-date>';
1286 end;
1287 vfkDate:
1288 begin
1289 FContent:=FContent +
1290 '<text:date style:data-style-name="'+sDateStyleName+'">'+DateToStr(Now)+'</text:date>';
1291 end;
1292 end;
1293 end;
1294
TvODTVectorialWriter.BordersToStringnull1295 function TvODTVectorialWriter.BordersToString(ATableBorders, ACellBorders : TvTableBorders;
1296 ATopCell, ABottomCell, ALeftCell, ARightCell : Boolean):String;
1297 (*
1298 double line thickness requires a completely different configuration, so for now, we won't
1299 support it...
1300
1301 <style:table-cell-properties style:vertical-align="middle"
1302 style:border-line-width-left="0.28mm 0.28mm 0.28mm"
1303 style:border-line-width-top="0.28mm 0.28mm 0.28mm"
1304 fo:padding="0mm"
1305 fo:border-left="2.35pt double #ff0000"
1306 fo:border-right="0.5pt solid #ff0000"
1307 fo:border-top="2.35pt double #ff0000"
1308 fo:border-bottom="0.5pt solid #ff0000"/>
1309
1310 From the OASIS Open Office Specification:
1311 The style:border-line-width specifies the line widths of all four sides,
1312 while the other attributes specify the line widths of one side only.
1313
1314 The value of the attributes can be a list of three space-separated lengths,
1315 as follows:
1316 • The first value specifies the width of the inner line
1317 • The second value specified the distance between the two lines
1318 • The third value specifies the width of the outer line
1319
1320 The result of specifying a border line width without specifying a border
1321 width style of double for the same border is undefined.
1322 *)
1323
BorderToStringnull1324 Function BorderToString(AAttrib : String; ABorder: TvTableBorder) : String;
1325 Begin
1326 Result := '';
1327 If ABorder.LineType<>tbtDefault Then
1328 Begin
1329 If ABorder.LineType=tbtNone Then
1330 Result := 'none'
1331 Else
1332 Begin
1333 If ABorder.Width <> 0 Then
1334 Result := Format('%s %smm', [Result, FloatToODTText(ABorder.Width)])
1335 Else
1336 Result := Format('%s 0.05pt', [Result]);
1337
1338 Result := Format('%s %s', [Result, LU_BORDERTYPE[ABorder.LineType]]);
1339
1340 Result := Format('%s #%s', [Result, FPColorToRGBHexString(ABorder.Color)]);
1341 end;
1342
1343 Result := Format('%s="%s"', [AAttrib, Trim(Result)]);
1344 end;
1345 end;
1346 Var
1347 sLeft, sRight, sTop, sBottom : String;
1348 Begin
1349 (*
1350 OpenDocument does not support setting borders at the Table Level,
1351 only at the cell level. For end user convenience, FPVectorial supports
1352 setting borders at the table level, but allows the end user fine control,
1353 if they prefer, by providing support for borders at the cell level as well.
1354
1355 This means we're going to need to calculate actual border
1356 based on TvTable.Borders (which includes InsideHoriz and InsideVert) as
1357 default values, which can be overridden if specific TvTableCell.Borders
1358 are defined (ie LineType<>tbtDefault)
1359
1360 Matters are complicated by the need to work out if we need to draw the right
1361 and top borders (if we always draw right borders then two lines will be visible
1362 on internal border, the left border from the cell to the right and the right
1363 border from this cell). To deal with this, we only set the Right and Top
1364 borders if either the Cell.Borders specify (they overrule all), or if we're
1365 actually at the top or right cells (which the calling function will calculate
1366 for us)
1367 *)
1368
1369 sLeft := BorderToString('fo:border-left', ACellBorders.Left);
1370 if sLeft='' then
1371 begin
1372 if ALeftCell then
1373 sLeft := BorderToString('fo:border-left', ATableBorders.Left)
1374 else
1375 // Really need to look at cell to the left and determine if it has overriding Cell.Borders.Right :-(
1376 sLeft := BorderToString('fo:border-left', ATableBorders.InsideVert);
1377 end;
1378
1379 sRight := BorderToString('fo:border-right', ACellBorders.Right);
1380 if sRight='' then
1381 begin
1382 if ARightCell then
1383 sRight := BorderToString('fo:border-right', ATableBorders.Right)
1384 else
1385 sRight := 'fo:border-right="none"';
1386 end;
1387
1388 sTop := BorderToString('fo:border-top', ACellBorders.Top);
1389 if sTop='' then
1390 begin
1391 if ATopCell then
1392 sTop := BorderToString('fo:border-top', ATableBorders.Top)
1393 else
1394 sTop := 'fo:border-top="none"';
1395 end;
1396
1397 sBottom := BorderToString('fo:border-bottom', ACellBorders.Bottom);
1398 if sBottom='' then
1399 begin
1400 if ABottomCell then
1401 sBottom := BorderToString('fo:border-bottom', ATableBorders.Bottom)
1402 else
1403 // Really need to look at cell below, and determine if it has overriding Cell.Borders.Top :-(
1404 sBottom := BorderToString('fo:border-bottom', ATableBorders.InsideHoriz);
1405 end;
1406
1407 Result := Format('%s %s %s %s', [sLeft, sRight, sTop, sBottom]);
1408 end;
1409
TvODTVectorialWriter.TextPropertiesToStringnull1410 function TvODTVectorialWriter.TextPropertiesToString(AStyle: TvStyle): String;
1411 var
1412 fontStyleChanged: Boolean;
1413 begin
1414 Result := '';
1415 fontStyleChanged := false;
1416
1417 if spbfFontSize in AStyle.SetElements then
1418 begin
1419 Result := Result + ' fo:font-size="'+IntToStr(AStyle.Font.Size)+'pt" ';
1420 Result := Result + ' fo:font-size-asian="'+IntToStr(AStyle.Font.Size)+'pt" ';
1421 Result := Result + ' fo:font-size-complex="'+IntToStr(AStyle.Font.Size)+'pt" ';
1422 end;
1423
1424 if spbfFontName in AStyle.SetElements then
1425 begin
1426 Result := Result + ' style:font-name="'+AStyle.Font.Name+'" ';
1427 Result := Result + ' style:font-name-asian="Microsoft YaHei" ';
1428 Result := Result + ' style:font-name-complex="Mangal" ';
1429 end;
1430
1431 if (spbfFontColor in AStyle.SetElements) then
1432 begin
1433 Result := Result + Format(' fo:color="%s" loext:opacity="100%%"',
1434 [FPColorToHtml(AStyle.Font.Color)]);
1435 end;
1436
1437 if (spbfFontBold in AStyle.SetElements) then
1438 begin
1439 if AStyle.Font.Bold then
1440 begin
1441 Result := Result + ' fo:font-weight="bold" ';
1442 Result := Result + ' style:font-weight-asian="bold" ';
1443 Result := Result + ' style:font-weight-complex="bold" ';
1444 fontStyleChanged := true;
1445 end;
1446 end;
1447
1448 if (spbfFontItalic in AStyle.SetElements) then
1449 begin
1450 if AStyle.Font.Italic then
1451 begin
1452 Result := Result + ' fo:font-style="italic" ';
1453 Result := Result + ' style:font-style-asian="italic" ';
1454 Result := Result + ' style:font-style-complex="italic" ';
1455 fontStyleChanged := true;
1456 end;
1457 end;
1458
1459 if (spbfFontUnderline in AStyle.SetElements) then
1460 begin
1461 if AStyle.Font.Underline then
1462 begin
1463 Result := Result + ' style:text-underline-style="solid"';
1464 Result := Result + ' style:text-underline-width="auto"';
1465 Result := Result + ' style:text-underline-color="font-color"';
1466 fontStyleChanged := true;
1467 end;
1468 end;
1469
1470 if (spbfFontStrikeThrough in AStyle.SetElements) then
1471 begin
1472 if AStyle.Font.StrikeThrough then
1473 begin
1474 Result := Result + ' style:text-line-through-style="solid" ';
1475 fontStyleChanged := true;
1476 end;
1477 end;
1478
1479 if not fontStyleChanged then
1480 begin
1481 Result := Result + ' fo:font-weight="normal" ';
1482 Result := Result + ' style:font-weight-asian="normal" ';
1483 Result := Result + ' style:font-weight-complex="normal" ';
1484 end;
1485 end;
1486
1487 procedure TvODTVectorialWriter.WriteTable(ATable: TvTable;
1488 ACurPage: TvTextPageSequence; AData: TvVectorialDocument);
1489 procedure AddBody(AString : String);
1490 begin
1491 FContent := FContent + ' ' + AString + LineEnding;
1492 end;
1493 procedure AddStyle(AString : String);
1494 begin
1495 FContentAutomaticStyles:=FContentAutomaticStyles + ' ' + AString + LineEnding;
1496 end;
1497 Var
1498 iRow, iCell, iCol, k: Integer;
1499 oRow: TvTableRow;
1500 oCell: TvTableCell;
1501 lCurEntity: TvEntity;
1502 sTableName : String;
1503 iColCount : Integer;
1504 sTableStyle,
1505 sColStyle,
1506 sRowStyle,
1507 sCellStyle,
1508 sTemp, sTemp2: String;
1509 bInHeader: Boolean;
1510
1511 Begin
1512 // TODO: Add support for TvTableBorder.Spacing
1513 // TODO: Add support for TvTableRow.CellSpacing
1514 // TODO: Add support for TvTable.CellSpacing
1515
1516 if ATable.GetRowCount=0 Then
1517 Exit;
1518
1519 // Style information stored in content.xml -> office:automatic-styles
1520 // Table information stored in content.xml -> office:body
1521
1522 sTableName := Trim(ATable.Name);
1523 If sTableName='' Then
1524 sTableName := Format('Table_%d.%d', [AData.GetPageIndex(ACurPage)+1, ACurPage.GetEntityIndex(ATable)+1]);
1525 sTableStyle := sTableName;
1526
1527 // Table meta properties
1528 AddStyle('<style:style style:name="'+sTableStyle+'" style:family="table">');
1529 Case ATable.PreferredWidth.Units of
1530 dimMillimeter: sTemp := 'style:width="'+FloatToODTText(ATable.PreferredWidth.Value)+'mm"';
1531 dimPoint: sTemp := 'style:width="'+FloatToODTText(ATable.PreferredWidth.Value)+'pt"';
1532 dimPercent: sTemp := 'style:rel-width="'+FloatToODTText(ATable.PreferredWidth.Value)+'%"';
1533 End;
1534 if ATable.BackgroundColor <> FPColor(0, 0, 0, 0) Then
1535 sTemp := sTemp + ' fo:background-color="#'+FPColorToRGBHexString(ATable.BackgroundColor)+'"';
1536
1537 AddStyle(' <style:table-properties '+sTemp+' table:align="margins"/>');
1538 AddStyle('</style:style>');
1539
1540 AddBody(Format('<table:table table:name="%s" table:style-name="%s">', [sTableName, sTableStyle]));
1541
1542 // Now define any column specific properties
1543 If Length(ATable.ColWidths)>0 Then
1544 iColCount := Length(ATable.ColWidths)
1545 Else
1546 // No ColWidths defined means simple tables only (no merged cells)
1547 iColCount := TvTableRow(ATable.GetRow(0)).GetCellCount;
1548
1549 For iCol := 0 To iColCount-1 Do
1550 Begin
1551 sColStyle := Format('%s.Col_%d', [sTableStyle, iCol+1]);
1552
1553 If Length(ATable.ColWidths)>0 Then
1554 begin
1555 AddStyle('<style:style style:name="'+sColStyle+'" style:family="table-column">');
1556 Case ATable.ColWidthsUnits Of
1557 dimMillimeter: sTemp := 'style:column-width="'+FloatToODTText(ATable.ColWidths[iCol])+'mm"';
1558 dimPoint: sTemp := 'style:column-width="'+FloatToODTText(ATable.ColWidths[iCol])+'pt"';
1559 dimPercent: sTemp := 'style:rel-column-width="'+FloatToODTText(65535 * ATable.ColWidths[iCol] / 100)+'*"';
1560 End;
1561
1562 AddStyle(' <style:table-column-properties '+sTemp+'/>');
1563 AddStyle('</style:style>');
1564 end;
1565
1566 AddBody(' <table:table-column table:style-name="'+sColStyle+'" table:number-columns-repeated="1"/>');
1567 end;
1568
1569 // Write out the table row by row, defining row and cell styles as we go..
1570 bInHeader := False;
1571 For iRow := 0 To ATable.GetRowCount-1 Do
1572 Begin
1573 oRow := ATable.GetRow(iRow);
1574
1575 // Current Header functionality will only work
1576 // if header rows correctly defined...
1577 If (bInHeader) And not (oRow.Header) Then
1578 Begin
1579 bInHeader := False;
1580 // Close header rows...
1581 AddBody(' </table:table-header-rows>');
1582 end;
1583
1584 If (oRow.Header) And (iRow=0) Then
1585 Begin
1586 bInHeader := True;
1587 // Open header rows
1588 AddBody(' <table:table-header-rows>');
1589 end;
1590
1591 sTemp := '';
1592 sRowStyle := Format('%s.Row_%d', [sTableStyle, iRow+1]);
1593
1594 if oRow.BackgroundColor <> FPColor(0, 0, 0, 0) Then
1595 sTemp := sTemp + ' fo:background-color="#'+FPColorToRGBHexString(oRow.BackgroundColor)+'"';
1596
1597 If oRow.Height<>0 Then
1598 sTemp := sTemp + ' style:row-height="'+FloatToODTText(oRow.Height)+'mm"';
1599
1600 if Not oRow.AllowSplitAcrossPage Then
1601 sTemp := sTemp + ' fo:keep-together="always"';
1602 // else
1603 // sTemp := sTemp + ' fo:keep-together="auto"';
1604
1605 // Only define the style if it is required...
1606 If sTemp<>'' Then
1607 begin
1608 AddStyle('<style:style style:name="'+sRowStyle+'" style:family="table-row">');
1609 AddStyle(' <style:table-row-properties '+sTemp+'/>');
1610 AddStyle('</style:style>');
1611
1612 AddBody(' <table:table-row table:style-name="'+sRowStyle+'">');
1613 end
1614 Else
1615 AddBody(' <table:table-row>');
1616
1617 For iCell := 0 To oRow.GetCellCount-1 Do
1618 Begin
1619 oCell := oRow.GetCell(iCell);
1620
1621 sTemp := '';
1622 sCellStyle := Format('%s.Cell_%dx%d', [sTableStyle, iRow + 1, iCell + 1]);
1623
1624 (* // I cannot find a mechanism for setting cell width in ODT...
1625 If oCell.PreferredWidth.Value<>0 Then
1626 Begin
1627 Case oCell.PreferredWidth.Units Of
1628 dimMillimeter: sTemp := sTemp + 'style:cell-width="'+FloatToODTText(oCell.PreferredWidth)+'mm"';
1629 dimPoint: sTemp := sTemp + 'style:cell-width="'+FloatToODTText(oCell.PreferredWidth)+'pt"';
1630 dimPercent: sTemp := sTemp + 'style:rel-cell-width="'+FloatToODTText(65535 * oCell.PreferredWidth / 100)+'*"';
1631 End;
1632 end;
1633 *)
1634 // Top is default in LibreOffice Write
1635 If oCell.VerticalAlignment<>vaTop Then
1636 sTemp := sTemp + ' style:vertical-align="'+LU_V_ALIGN[oCell.VerticalAlignment]+'"';
1637
1638 if oCell.BackgroundColor <> FPColor(0, 0, 0, 0) Then
1639 sTemp := sTemp + ' fo:background-color="#'+FPColorToRGBHexString(oCell.BackgroundColor)+'"';
1640
1641 sTemp := sTemp + ' ' + BordersToString(ATable.Borders, oCell.Borders,
1642 iRow=0, iRow=ATable.GetRowCount-1,
1643 iCell=0, iCell=oRow.GetCellCount-1);
1644
1645 sTemp2 := '';
1646
1647 If oCell.SpannedCols>1 Then
1648 sTemp2 := 'table:number-columns-spanned="'+IntToStr(oCell.SpannedCols)+'" ';
1649
1650 // Only define the style if it is required...
1651 sTemp := Trim(sTemp);
1652 if sTemp<>'' Then
1653 begin
1654 AddStyle('<style:style style:name="'+sCellStyle+'" style:family="table-cell">');
1655 AddStyle(' <style:table-cell-properties '+sTemp+'/>');
1656 AddStyle('</style:style>');
1657
1658 AddBody(' <table:table-cell table:style-name="'+sCellStyle+'" '+sTemp2+'office:value-type="string">');
1659 end
1660 Else
1661 AddBody(' <table:table-cell '+sTemp2+'office:value-type="string">');
1662
1663 FContent := FContent + ' ';
1664
1665 // oCell is a TvRichText descendant, so process it similarly...
1666 for k := 0 to oCell.GetEntitiesCount()-1 do
1667 begin
1668 lCurEntity := oCell.GetEntity(k);
1669
1670 if (lCurEntity is TvParagraph) then
1671 WriteParagraph(TvParagraph(lCurEntity), ACurPage, AData);
1672 if (lCurEntity is TvList) then
1673 WriteList(TvList(lCurEntity), ACurPage, AData);
1674 if (lCurEntity is TvTable) then
1675 WriteTable(TvTable(lCurEntity), ACurPage, AData);
1676 end;
1677
1678 AddBody(' </table:table-cell>');
1679
1680 // FPVectorial doesn't directly support covered (merged) cells,
1681 // instead they're implied by SpannedCols count > 1
1682 for k := 2 to oCell.SpannedCols Do
1683 AddBody('<table:covered-table-cell />');
1684 end;
1685
1686 AddBody(' </table:table-row>');
1687 end;
1688 AddBody('</table:table>');
1689 end;
1690
1691 procedure TvODTVectorialWriter.WriteList(AEntity: TvList;
1692 ACurPage: TvTextPageSequence; AData: TvVectorialDocument);
1693 var
1694 i, j: Integer;
1695 lCurEntity, lCurSubEntity: TvEntity;
1696 lCurParagraph: TvParagraph;
1697 iCrossRef: Integer;
1698 begin
1699 // See http://docs.oasis-open.org/office/v1.1/OS/OpenDocument-v1.1.pdf
1700 // page 75 "Example: Lists and sublists"
1701
1702 FContent := FContent +
1703 ' <text:list text:style-name="'+ListStyleNameToODTText(AData, AEntity.ListStyle)+'">' + LineEnding;
1704
1705 for i := 0 to AEntity.GetEntitiesCount()-1 do
1706 begin
1707 lCurEntity := AEntity.GetEntity(i);
1708
1709 FContent := FContent +
1710 ' <text:list-item>' + LineEnding;
1711
1712 if (lCurEntity is TvParagraph) then
1713 begin
1714 lCurParagraph := lCurEntity as TvParagraph;
1715
1716 iCrossRef := FList_StyleCrossRef.AddCrossReference(AEntity.Style, AEntity.ListStyle);
1717
1718 // Special Style correlating the Paragraph Style and the List style
1719 // should be added to Content.xml Automatic Styles
1720 FContent := FContent +
1721 ' <text:p text:style-name="'+FList_StyleCrossRef.AsText(iCrossRef)+'">';
1722
1723 for j := 0 to lCurParagraph.GetEntitiesCount()-1 do
1724 begin
1725 lCurSubEntity := lCurParagraph.GetEntity(j);
1726
1727 if (lCurSubEntity is TvText) then
1728 WriteTextSpan(TvText(lCurSubEntity), lCurParagraph, ACurPage, AData);
1729 end;
1730
1731 FContent := FContent +
1732 ' </text:p>' + LineEnding;
1733 end
1734 else if lCurEntity Is TvList Then
1735 WriteList(TvList(lCurEntity), ACurPage, AData);
1736
1737 FContent := FContent +
1738 ' </text:list-item>' + LineEnding;
1739 end;
1740
1741 FContent := FContent +
1742 ' </text:list>' + LineEnding;
1743 end;
1744
1745 procedure TvODTVectorialWriter.WriteRasterImage(AEntity: TvRasterImage; AParagraph: TvParagraph;
1746 ACurPage: TvTextPageSequence; AData: TvVectorialDocument);
1747 var
1748 FRasterImageName:string;
1749 FRasterImageHeight:double;
1750 FRasterImageWidth:double;
1751 begin
1752 if AEntity.RasterImage=nil then
1753 Exit;
1754
1755 if IsZero(AEntity.Height) then
1756 FRasterImageHeight:=RoundTo((AEntity.RasterImage.Height*2.54)/96,-3) // default 96 dpi of document, unit used cm
1757 else
1758 FRasterImageHeight:=AEntity.Height;
1759
1760 if IsZero(AEntity.Width) then
1761 FRasterImageWidth:=RoundTo((AEntity.RasterImage.Width*2.54)/96,-3) // default 96 dpi of document, unit used cm
1762 else
1763 FRasterImageWidth:=AEntity.Width;
1764
1765 FRasterImageName:='Pictures/'+IntTostr(FRasterImageFileNames.Count+1)+'.png';
1766 FContent:=FContent+'<draw:frame draw:name="Image'+IntTostr(FRasterImageFileNames.Count+1)+'" svg:width="'+FloatToODTText(FRasterImageWidth)+'cm" svg:height="'+FloatToODTText(FRasterImageHeight)+'cm" text:anchor-type="as-char" draw:z-index="2">';
1767 FContent:=FContent+'<draw:image xlink:href="'+FRasterImageName+'" xlink:type="simple" xlink:show="embed" xlink:actuate="onLoad"/>';
1768 FContent:=FContent+'</draw:frame>';
1769
1770 FRasterImageFileNames.AddObject(FRasterImageName,AEntity);
1771 end;
1772
WriteStylesXMLAsStringnull1773 function TvODTVectorialWriter.WriteStylesXMLAsString: string;
1774 begin
1775
1776 end;
1777
1778 constructor TvODTVectorialWriter.Create;
1779 begin
1780 inherited Create;
1781
1782 FPointSeparator := DefaultFormatSettings;
1783 FPointSeparator.DecimalSeparator := '.';
1784 FPointSeparator.ThousandSeparator := '#';// disable the thousand separator
1785
1786 FAutomaticStyles := '';
1787 FMasterStyles := '';
1788
1789 FList_StyleCrossRef := TListStyle_StyleList.Create;
1790 FList_StyleCrossRef.Writer := Self;
1791
1792 FDateCount := 0;
1793
1794 FRasterImageFileNames:=TStringList.Create;
1795 end;
1796
1797 destructor TvODTVectorialWriter.Destroy;
1798 begin
1799 FRasterImageFileNames.Free;
1800 FList_StyleCrossRef.Free;
1801
1802 inherited Destroy;
1803 end;
1804
1805 procedure TvODTVectorialWriter.WriteToFile(AFileName: string;
1806 AData: TvVectorialDocument);
1807 Var
1808 oStream: TFileStream;
1809 Begin
1810 If ExtractFileExt(AFilename) = '' Then
1811 AFilename := AFilename + STR_ODT_EXTENSION;
1812
1813 oStream := TFileStream.Create(AFileName, fmCreate);
1814 Try
1815 WriteToStream(oStream, AData);
1816 Finally
1817 FreeAndNil(oStream);
1818 End;
1819 End;
1820
1821 procedure TvODTVectorialWriter.WriteToStream(AStream: TStream;
1822 AData: TvVectorialDocument);
1823 var
1824 FZip: TZipper;
1825 // Streams with the contents of files
1826 FSMeta, FSSettings, FSStyles, FSContent, FSMimetype: TStringStream;
1827 FSMetaInfManifest, FSManifestRDF: TStringStream;
1828 FSRasterImage:TMemoryStream;
1829 i:integer;
1830 WriterPNG:TFPWriterPNG;
1831 FRasterImageStreamList:TFPList;
1832 begin
1833 FList_StyleCrossRef.Data := AData;
1834
1835 { Fill the strings with the contents of the files }
1836 WriteMimetype();
1837 WriteManifestRDF();
1838 WriteMeta();
1839 WriteSettings();
1840 // Reversed order of Document and Styles to allow embedding Automatic Styles
1841 // built up during WriteDocument...
1842 WriteDocument(AData);
1843 WriteStyles(AData);
1844 WriteMetaInfManifest();
1845
1846 { Write the data to streams }
1847
1848 FSMeta := TStringStream.Create(FMeta);
1849 FSSettings := TStringStream.Create(FSettings);
1850 FSStyles := TStringStream.Create(FStyles);
1851 FSContent := TStringStream.Create(FContent);
1852 FSMimetype := TStringStream.Create(FMimetype);
1853 FSMetaInfManifest := TStringStream.Create(FMetaInfManifest);
1854 FSManifestRDF := TStringStream.Create(FManifestRDF);
1855
1856
1857 FRasterImageStreamList:=nil;
1858
1859 WriterPNG:=TFPWriterPNG.Create;
1860 WriterPNG.UseAlpha:=true;
1861
1862 { Now compress the files }
1863 FZip := TZipper.Create;
1864 try
1865 // MimeType must be first file, and should be uncompressed
1866 // TODO: CompressionLevel is not working. Bug, or misuse?
1867 // See http://mantis.freepascal.org/view.php?id=24897 for patch...
1868 FZip.Entries.AddFileEntry(FSMimetype, OPENDOC_PATH_MIMETYPE).CompressionLevel:=clNone;
1869
1870 FZip.Entries.AddFileEntry(FSMeta, OPENDOC_PATH_META);
1871 FZip.Entries.AddFileEntry(FSSettings, OPENDOC_PATH_SETTINGS);
1872 FZip.Entries.AddFileEntry(FSStyles, OPENDOC_PATH_STYLES);
1873 FZip.Entries.AddFileEntry(FSContent, OPENDOC_PATH_CONTENT);
1874 FZip.Entries.AddFileEntry(FSMetaInfManifest, OPENDOC_PATH_METAINF_MANIFEST);
1875 FZip.Entries.AddFileEntry(FSManifestRDF, OPENDOC_PATH_MANIFESTRDF);
1876
1877 FRasterImageStreamList:=TFPList.Create;
1878
1879 for i:=0 to FRasterImageFileNames.Count-1 do
1880 begin
1881 FSRasterImage:=TMemoryStream.Create;
1882 TvRasterImage(FRasterImageFileNames.Objects[i]).RasterImage.SaveToStream(FSRasterImage,WriterPNG);
1883 FRasterImageStreamList.Add(FSRasterImage);
1884 FSRasterImage.Seek(0,soFromBeginning);
1885 FZip.Entries.AddFileEntry(FSRasterImage, FRasterImageFileNames[i]);
1886 end;
1887
1888 FZip.SaveToStream(AStream);
1889 finally
1890 if FRasterImageStreamList<> nil then
1891 begin
1892 for i:=0 to FRasterImageStreamList.Count-1 do
1893 TvRasterImage(FRasterImageStreamList[i]).Free;
1894 FRasterImageStreamList.Free;
1895 end;
1896 FZip.Free;
1897 FSMeta.Free;
1898 FSSettings.Free;
1899 FSStyles.Free;
1900 FSContent.Free;
1901 FSMimetype.Free;
1902 FSMetaInfManifest.Free;
1903 FSManifestRDF.Free;
1904 WriterPNG.Free;
1905 end;
1906 end;
1907
1908 initialization
1909
1910 RegisterVectorialWriter(TvODTVectorialWriter, vfODT);
1911
1912 end.
1913
1914