paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-21 23:19:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

fpvectorial: Patch from Michael Thompson: Rewrites List Support And implements Simple Document Field

Browse Source 
git-svn-id: trunk@42922 -
This commit is contained in:
sekelsenmat 2013-09-24 14:40:37 +00:00
parent 21a9d29c40
commit 5d08cb8d8a
6 changed files with 897 additions and 330 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

191
components/fpvectorial/docxvectorialwriter.pas
View File

@ -237,9 +237,11 @@ Const
LU_ALIGN: Array [TvStyleAlignment] Of String =
('left', 'right', 'both', 'center');
LU_KIND: Array [TvListStyleKind] Of String =
('bullet', 'decimal', 'lowerLetter', 'lowerRoman',
'upperLetter', 'upperRoman');
LU_NUMBERFORMAT: Array [TvNumberFormat] Of String =
('decimal', 'lowerLetter', 'lowerRoman', 'upperLetter', 'upperRoman');
LU_NUMBERFORMATFORUMLA: Array [TvNumberFormat] Of String =
('Arabic', 'alphabetic', 'roman', 'ALPHABETIC', 'Roman');
LU_ON_OFF: Array[Boolean] Of String = ('off', 'on');
@ -526,6 +528,7 @@ Procedure TvDOCXVectorialWriter.PrepareDocument;
Var
// Generally this is document.xml, may also be header.xml or footer.xml though..
oDocXML: TIndentedStringList;
iPage: Integer;
Procedure ProcessRichText(ARichText: TvRichText); Forward;
@ -591,7 +594,71 @@ Var
End;
End;
Procedure ProcessParagraph(AParagraph: TvParagraph);
Procedure AddField(AField : TvField);
var
sInstruction: String;
sDefault: String;
Begin
sInstruction := '';
sDefault := '';
Case AField.Kind of
vfkNumPages:
Begin
sInstruction := ' NUMPAGES \* '+LU_NUMBERFORMATFORUMLA[AField.NumberFormat]+' \* MERGEFORMAT ';
sDefault := IntToStr(FData.GetPageCount);
End;
vfkPage:
Begin
sInstruction := ' PAGE \* '+LU_NUMBERFORMATFORUMLA[AField.NumberFormat]+' \* MERGEFORMAT ';
sDefault := IntToStr(iPage+1);
End;
vfkAuthor:
Begin
sInstruction := ' AUTHOR \* Caps \* MERGEFORMAT ';
sDefault := 'FPVECTORIAL';
End;
vfkDateCreated:
Begin
sInstruction := ' CREATEDATE \@ "'+AField.DateFormat+'" \* MERGEFORMAT ';
sDefault := DateToStr(Now);
End;
vfkDate:
Begin
sInstruction := ' DATE \@ "'+AField.DateFormat+'" \* MERGEFORMAT ';
sDefault := DateToStr(Now);
End;
end;
If sInstruction<>'' Then
Begin
If Assigned(AField.Style) Then
Begin
oDocXML.Add(indInc, '<w:rPr>');
oDocXML.Add(' <w:rStyle w:val="' + StyleNameToStyleID(AField.Style) + '"/>');
oDocXML.Add(indDec, '</w:rPr>');
End;
// Start the Formula
oDocXML.Add('<w:r><w:fldChar w:fldCharType="begin"/></w:r>');
// Add the Instruction
oDocXML.Add('<w:r><w:instrText xml:space="preserve">'+
sInstruction+
'</w:instrText></w:r>');
// SEPARATE the Field (above) from the result (below)
oDocXML.Add('<w:r><w:fldChar w:fldCharType="separate"/></w:r>');
// Add the default text
oDocXML.Add('<w:r><w:t>'+sDefault+'</w:t></w:r>');
// End the Forumla
oDocXML.Add('<w:r><w:fldChar w:fldCharType="end"/></w:r>');
end;
end;
Procedure ProcessParagraph(AParagraph: TvParagraph; AListLevel : integer = -1; ANumID : Integer = -1);
Var
i: Integer;
oEntity: TvEntity;
@ -606,11 +673,11 @@ Var
oDocXML.Add(Format('<w:pStyle w:val="%s"/>',
[StyleNameToStyleID(AParagraph.Style)]));
If Assigned(AParagraph.ListStyle) Then
If (AListLevel<>-1) 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(indInc, Format('<w:ilvl w:val="%d"/>', [AListLevel]));
oDocXML.Add(indDec, Format('<w:numId w:val="%d"/>', [ANumID]));
oDocXML.Add('</w:numPr>');
End;
@ -635,6 +702,8 @@ Var
AddTextRun(sTemp, TvText(oEntity).Style);
End
Else If oEntity is TvField Then
AddField(TvField(oEntity))
Else
{ TODO : What other entities in TvParagraph do I need to process }
Raise Exception.Create('Unsupported Entity: ' + oEntity.ClassName);
@ -643,22 +712,24 @@ Var
oDocXML.Add(indDec, '</w:p>');
End;
Procedure ProcessBulletList(ABulletList: TvBulletList);
Procedure ProcessList(AList: TvList);
Var
i: Integer;
oEntity: TvEntity;
Begin
For i := 0 To ABulletList.GetEntitiesCount - 1 Do
For i := 0 To AList.GetEntitiesCount - 1 Do
Begin
oEntity := ABulletList.GetEntity(i);
oEntity := AList.GetEntity(i);
If oEntity Is TvParagraph Then
Begin
If Not Assigned(TvParagraph(oEntity).Style) Then
TvParagraph(oEntity).Style := ABulletList.Style;
TvParagraph(oEntity).Style := AList.Style;
ProcessParagraph(TvParagraph(oEntity));
ProcessParagraph(TvParagraph(oEntity), AList.Level, FData.FindListStyleIndex(AList.ListStyle) + 1);
End
Else If oEntity Is TvList Then
ProcessList(TvList(oEntity))
Else
Raise Exception.Create('Unsupported entity ' + oEntity.ClassName);
End;
@ -944,8 +1015,8 @@ Var
If oEntity Is TvParagraph Then
ProcessParagraph(TvParagraph(oEntity))
Else If oEntity Is TvBulletList Then
ProcessBulletList(TvBulletList(oEntity))
Else If oEntity Is TvList Then
ProcessList(TvList(oEntity))
Else If oEntity Is TvTable Then
ProcessTable(TvTable(oEntity))
Else If oEntity Is TvRichText Then
@ -962,7 +1033,6 @@ Var
Var
oPage: TvPage;
oPageSequence: TvTextPageSequence;
iPage: Integer;
oFile: TFileInformation;
Begin
oFile := FFiles.AddXMLFile(OOXML_CONTENTTYPE_DOCUMENT, OOXML_PATH_DOCUMENT,
@ -1008,9 +1078,6 @@ End;
Procedure TvDOCXVectorialWriter.PrepareTextRunStyle(ADoc: TIndentedStringList;
AStyle: TvStyle);
Var
sTemp: String;
Begin
ADoc.Add(indInc, '<w:rPr>', indInc);
@ -1170,6 +1237,11 @@ Var
oStyle: TvListStyle;
oFile: TFileInformation;
i: Integer;
j: Integer;
oListLevelStyle: TvListLevelStyle;
sTotalLeader: String;
sCurrentLeader: String;
slvlText: String;
Begin
// Only add this file if there are any List styles defined...
If FData.GetListStyleCount > 0 Then
@ -1182,42 +1254,71 @@ Begin
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);
// abstractNumID allows us to group different list styles together.
// The way fpvectorial uses it, there will be a one to one relationship
// between abstractNumID and numID.
// abstractNumId is 0 based
// numID is 1 based. Go figure...
oXML.Add(indInc, Format('<w:abstractNum w:abstractNumId="%d">', [i]), 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] + '"/>');
sTotalLeader := '';
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>');
For j := 0 To oStyle.GetListLevelStyleCount-1 Do
Begin
oListLevelStyle := oStyle.GetListLevelStyle(j);
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(Format('<w:lvl w:ilvl="%d">', [oListLevelStyle.Level]), indInc);
oXML.Add('</w:lvl>', indDec);
with oListLevelStyle do
sCurrentLeader := Format('%s%s%d%s', [Prefix, '%', Level + 1, Suffix]);
sTotalLeader := sTotalLeader + sCurrentLeader;
If oListLevelStyle.Kind=vlskBullet Then
slvlText := oListLevelStyle.Bullet
Else If oListLevelStyle.DisplayLevels Then
slvlText := sTotalLeader
Else
slvlText := sCurrentLeader;
If oListLevelStyle.Kind=vlskBullet Then
oXML.Add('<w:numFmt w:val="bullet"/>')
Else
Begin // Numbered Lists
oXML.Add(Format('<w:start w:val="%d"/>', [oListLevelStyle.Start]));
oXML.Add('<w:numFmt w:val="' + LU_NUMBERFORMAT[oListLevelStyle.NumberFormat] + '"/>');
End;
oXML.Add('<w:lvlText w:val="' + slvlText + '"/>');
oXML.Add('<w:lvlJc w:val="' + LU_ALIGN[oListLevelStyle.Alignment] + '"/>');
oXML.Add('<w:pPr>');
oXML.Add(Format(' <w:ind w:left="%s" w:hanging="%s"/>',
[mmToTwipsS(oListLevelStyle.MarginLeft), mmToTwipsS(oListLevelStyle.HangingIndent)]));
oXML.Add('</w:pPr>');
oXML.Add('<w:rPr>');
oXML.Add(Format(' <w:rFonts w:ascii="%s" w:hAnsi="%s"/>',
[oListLevelStyle.LeaderFontName, oListLevelStyle.LeaderFontName]));
oXML.Add('</w:rPr>');
oXML.Add('</w:lvl>', indDec);
end;
oXML.Add(indDec, '</w:abstractNum>', 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>');
For i := 0 To FData.GetListStyleCount - 1 Do
begin
oXML.Add(indInc, Format('<w:num w:numId="%d">', [i + 1]));
oXML.Add(Format(' <w:abstractNumId w:val="%d"/>', [i]));
oXML.Add(indDec, '</w:num>');
end;
oXML.Add('</w:numbering>');
End;
@ -1229,7 +1330,7 @@ Var
oStream: TFileStream;
Begin
If ExtractFileExt(AFilename) = '' Then
AFilename := AFilename + '.docx';
AFilename := AFilename + STR_DOCX_EXTENSION;
oStream := TFileStream.Create(AFileName, fmCreate);
Try

2
components/fpvectorial/examples/fpvtextwritetest.lpi
View File

@ -1,4 +1,4 @@
<?xml version="1.0"?>
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>

32
components/fpvectorial/examples/fpvtextwritetest.pas
View File

@ -18,7 +18,7 @@ var
Vec: TvVectorialDocument;
Page: TvTextPageSequence;
CurParagraph: TvParagraph;
BulletList: TvBulletList;
CurList: TvList;
begin
Vec := TvVectorialDocument.Create;
try
@ -58,20 +58,22 @@ begin
CurParagraph.Style := Vec.StyleTextBody;
// Lazarus provides a highly visual development environment for the creation of rich user interfaces, application logic, and other supporting code artifacts. Along with the customary project management features, the Lazarus IDE also provides features that includes but are not limited to:
BulletList := Page.AddBulletList();
BulletList.AddItem(0, 'A What You See Is What You Get (WYSIWYG) visual windows layout designer');
BulletList.AddItem(0, 'An extensive set of GUI widgets or visual components such as edit boxes, buttons, dialogs, menus, etc.');
BulletList.AddItem(0, 'An extensive set of non visual components for common behaviors such as persistence of application settings');
BulletList.AddItem(0, 'A set of data connectivity components for MySQL, PostgresSQL, FireBird, Oracle, SQL Lite, Sybase, and others');
BulletList.AddItem(0, 'Data aware widget set that allows the developer to see data in visual components in the designer to assist with development');
BulletList.AddItem(0, 'Interactive code debugger');
BulletList.AddItem(0, 'Code completion');
BulletList.AddItem(0, 'Code templates');
BulletList.AddItem(0, 'Syntax highlighting');
BulletList.AddItem(0, 'Context sensitive help');
BulletList.AddItem(0, 'Text resource manager for internationalization');
BulletList.AddItem(0, 'Automatic code formatting');
BulletList.AddItem(0, 'The ability to create custom components');
CurList := Page.AddList();
CurList.ListStyle := Vec.StyleBulletList;
CurList.Style := Vec.StyleTextBody;
CurList.AddParagraph('A What You See Is What You Get (WYSIWYG) visual windows layout designer');
CurList.AddParagraph('An extensive set of GUI widgets or visual components such as edit boxes, buttons, dialogs, menus, etc.');
CurList.AddParagraph('An extensive set of non visual components for common behaviors such as persistence of application settings');
CurList.AddParagraph('A set of data connectivity components for MySQL, PostgresSQL, FireBird, Oracle, SQL Lite, Sybase, and others');
CurList.AddParagraph('Data aware widget set that allows the developer to see data in visual components in the designer to assist with development');
CurList.AddParagraph('Interactive code debugger');
CurList.AddParagraph('Code completion');
CurList.AddParagraph('Code templates');
CurList.AddParagraph('Syntax highlighting');
CurList.AddParagraph('Context sensitive help');
CurList.AddParagraph('Text resource manager for internationalization');
CurList.AddParagraph('Automatic code formatting');
CurList.AddParagraph('The ability to create custom components');
Vec.WriteToFile('text_output.odt', vfODT);
finally

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

@ -13,9 +13,8 @@ Program fpvtextwritetest2;
Uses
fpvectorial,
odtvectorialwriter,
fpvutils,
fpvectorialpkg,
docxvectorialwriter,
fpvutils,
SysUtils, FPImage;
{$R *.res}
@ -28,8 +27,10 @@ Var
Page: TvTextPageSequence;
CurParagraph: TvParagraph;
BoldTextStyle: TvStyle;
ListParaStyle : TvStyle;
CenterParagraphStyle, Center2: TvStyle;
BulletList : TvBulletList;
List : TvList;
SubList: TvList;
dtTime : TDateTime;
CurText : TvText;
@ -49,6 +50,8 @@ Begin
// Until there is a need, we will stick with supporting ODT styles
Vec.AddStandardTextDocumentStyles(vfODT);
// An example in modifying existing Styles, here putting a 1cm margin on
// either side of normal text body
Vec.StyleTextBody.MarginRight:=10;
Vec.StyleTextBody.MarginLeft:=10;
Vec.StyleTextBody.SetElements:= Vec.StyleTextBody.SetElements + [sseMarginLeft, sseMarginRight];
@ -67,6 +70,15 @@ Begin
CenterParagraphStyle.Alignment := vsaCenter;
CenterParagraphStyle.SetElements := CenterParagraphStyle.SetElements + [spbfAlignment];
ListParaStyle := Vec.AddStyle();
ListParaStyle.Name := 'List Text Body';
ListParaStyle.Font.Name := 'Arial';
ListParaStyle.Font.Size := 9;
ListParaStyle.MarginLeft:=0;
ListParaStyle.MarginTop:=0;
ListParaStyle.MarginBottom:=0;
ListParaStyle.SetElements := CenterParagraphStyle.SetElements + [spbfFontName, spbfFontSize, sseMarginLeft, sseMarginTop, sseMarginBottom];
// First page sequence
Page := Vec.AddTextPageSequence();
Page.Width := 210;
@ -80,9 +92,14 @@ Begin
// Set the Footer
CurParagraph := Page.Footer.AddParagraph;
CurParagraph.Style := CenterParagraphStyle;
CurParagraph.AddText('Confidential' + #09 + 'Page x of y' + #09 +
DateTimeToStr(Now)).Style :=
BoldTextStyle;
CurParagraph.AddText('Confidential').Style := BoldTextStyle;
CurParagraph.AddText(#09);
CurParagraph.AddText('Page ').Style := BoldTextStyle;
CurParagraph.AddField(vfkPage).Style := BoldTextStyle;
CurParagraph.AddText(' of ').Style := BoldTextStyle;
CurParagraph.AddField(vfkNumPages).Style := BoldTextStyle;
CurParagraph.AddText(#09);
CurParagraph.AddField(vfkDateCreated).Style := BoldTextStyle;
// Title
CurParagraph := Page.AddParagraph();
@ -131,21 +148,29 @@ 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');
CurParagraph := Page.AddParagraph();
CurParagraph.Style := Vec.StyleTextBody;
CurParagraph.AddText('Lazarus ').Style := BoldTextStyle;
CurParagraph.AddText('features:');
// Simple List
List := Page.AddList();
List.Style := ListParaStyle;
List.ListStyle := Vec.StyleBulletList;
List.AddParagraph('A What You See Is What You Get (WYSIWYG) visual windows layout designer');
List.AddParagraph('An extensive set of GUI widgets or visual components such as edit boxes, buttons, dialogs, menus, etc.');
List.AddParagraph('An extensive set of non visual components for common behaviors such as persistence of application settings');
List.AddParagraph('A set of data connectivity components for MySQL, PostgresSQL, FireBird, Oracle, SQL Lite, Sybase, and others');
List.AddParagraph('Data aware widget set that allows the developer to see data in visual components in the designer to assist with development');
List.AddParagraph('Interactive code debugger');
List.AddParagraph('Code completion');
List.AddParagraph('Code templates');
List.AddParagraph('Syntax highlighting');
List.AddParagraph('Context sensitive help');
List.AddParagraph('Text resource manager for internationalization');
List.AddParagraph('Automatic code formatting');
List.AddParagraph('The ability to create custom components');
// Empty line
CurParagraph := Page.AddParagraph();
@ -179,8 +204,85 @@ Begin
Begin
Add(#09 + '<test>&"This shouldn''t break the resulting document."</test>' + #09);
Add(#09 + '<test>!@#$%^&*()_+=-~`;:{}[],./|\?</test>' + #09);
Add('');
End;
// Add a simple heading
CurParagraph := Page.AddParagraph();
CurParagraph.Style := Vec.StyleHeading2;
CurText := CurParagraph.AddText('Testing Fields');
CurParagraph := Page.AddParagraph();
CurParagraph.Style := Vec.StyleTextBody;
CurParagraph.AddText('Page Count: ');
CurParagraph.AddField(vfkNumPages);
CurParagraph := Page.AddParagraph();
CurParagraph.Style := Vec.StyleTextBody;
CurParagraph.AddText('Page: ');
CurParagraph.AddField(vfkPage);
CurParagraph := Page.AddParagraph();
CurParagraph.Style := Vec.StyleTextBody;
CurParagraph.AddText('Author: ');
CurParagraph.AddField(vfkAuthor);
CurParagraph := Page.AddParagraph();
CurParagraph.Style := Vec.StyleTextBody;
CurParagraph.AddText('Date Created: ');
CurParagraph.AddField(vfkDateCreated);
CurParagraph := Page.AddParagraph();
CurParagraph.Style := Vec.StyleTextBody;
CurParagraph.AddText('Date: ');
CurParagraph.AddField(vfkDate);
// Add a simple heading
CurParagraph := Page.AddParagraph();
CurParagraph.Style := Vec.StyleHeading2;
CurText := CurParagraph.AddText('Testing Lists');
// Indented numbered List
List := Page.AddList();
List.Style := ListParaStyle;
List.ListStyle := Vec.StyleNumberList;
List.AddParagraph('Level 1, Item 1');
List.AddParagraph('Level 1, Item 2');
List.AddParagraph('Level 1, Item 3');
SubList := List.AddList;
SubList.AddParagraph('Level 2, Item 1');
SubList.AddParagraph('Level 2, Item 2');
SubList.AddParagraph('Level 2, Item 3');
With SubList.AddList Do
begin
AddParagraph('Level 3, Item 1');
AddParagraph('Level 3, Item 2');
AddParagraph('Level 3, Item 3');
end;
SubList := List.AddList;
SubList.AddParagraph('Level 2, Item 1 (new SubList added to same upper List)');
SubList.AddParagraph('Level 2, Item 2 (new SubList added to same upper List)');
SubList.AddParagraph('Level 2, Item 3 (new SubList added to same upper List)');
SubList := SubList.AddList;
SubList.AddParagraph('Level 3, Item 1');
SubList.AddParagraph('Level 3, Item 2');
SubList.AddParagraph('Level 3, Item 3');
List.AddParagraph('Level 1, Item 1 (Continuing on from same upper list)');
List.AddParagraph('Level 1, Item 2 (Continuing on from same upper list)');
List.AddParagraph('Level 1, Item 3 (Continuing on from same upper list)');
SubList := List.AddList;
SubList.ListStyle := Vec.StyleBulletList;
SubList.AddParagraph('Bullet Level 2, Item 1 (new SubList added to same upper List)');
SubList.AddParagraph('Bullet Level 2, Item 2 (new SubList added to same upper List)');
SubList.AddParagraph('Bullet Level 2, Item 3 (new SubList added to same upper List)');
// Third page sequence
Page := Vec.AddTextPageSequence();
Page.Height := 297; // back to Portrait
@ -390,12 +492,12 @@ Begin
*)
dtTime := Now;
Vec.WriteToFile('text_output.docx', vfDOCX);
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);
Vec.WriteToFile('text_output_odt', vfODT);
WriteLn('Native odt writer: '+Format('%.1f msec', [24*60*60*1000*(Now-dtTime)]));
Finally

314
components/fpvectorial/fpvectorial.pas
View File

@ -85,11 +85,12 @@ const
STR_RAW_EXTENSION = '.raw';
STR_MATHML_EXTENSION = '.mathml';
STR_ODG_EXTENSION = '.odg';
STR_ODT_EXTENSION = '.odt';
STR_DOCX_EXTENSION = '.docx';
STR_FPVECTORIAL_TEXT_HEIGHT_SAMPLE = 'Ćą';
NUM_MAX_LISTSTYLES = 8;
NUM_MAX_LISTSTYLES = 8; // OpenDocument Limit is 10, MS Word Limit is 9
type
TvCustomVectorialWriter = class;
@ -185,23 +186,52 @@ 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....
);
TvListStyleKind = (vlskBullet, vlskNumeric);
TvListStyle = Class
TvNumberFormat = (vnfDecimal, // 0, 1, 2, 3...
vnfLowerLetter, // a, b, c, d...
vnfLowerRoman, // i, ii, iii, iv....
vnfUpperLetter, // A, B, C, D...
vnfUpperRoman); // I, II, III, IV....
{ TvListLevelStyle }
TvListLevelStyle = 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...
Start : Integer; // For numbered lists only
// Define the "leader", the stuff in front of each list item
Prefix : String;
Suffix : String;
Bullet : String; // Only applies to Kind=vlskBullet
NumberFormat : TvNumberFormat; // Only applies to Kind=vlskNumeric
DisplayLevels : Boolean; // Only applies to numbered lists.
// If true, style is 1.1.1.1.
// else style is 1.
LeaderFontName : String; // Not used by odt...
MarginLeft : Double; // mm
HangingIndent : Double; //mm
Alignment : TvStyleAlignment;
Constructor Create;
end;
{ TvListStyle }
TvListStyle = class
private
ListLevelStyles : TFPList;
public
Name : String;
constructor Create;
destructor Destroy; override;
procedure Clear;
function AddListLevelStyle : TvListLevelStyle;
function GetListLevelStyleCount : Integer;
function GetListLevelStyle(AIndex: Integer): TvListLevelStyle;
end;
{ Coordinates and polyline segments }
@ -487,6 +517,21 @@ type
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
end;
TvFieldKind = (vfkNumPages, vfkPage, vfkAuthor, vfkDateCreated, vfkDate);
{ TvField }
TvField = Class(TvEntityWithStyle)
public
Kind : TvFieldKind;
DateFormat : String; // Only for Kind in (vfkDateCreated, vfkDate)
// Date Format is similar to MS Specification
NumberFormat : TvNumberFormat; // Only for Kind in (vfkNumPages, vfkPage)
constructor Create(APage : TvPage); override;
end;
{@@
}
@ -870,6 +915,7 @@ type
constructor Create(APage: TvPage); override;
destructor Destroy; override;
function AddText(AText: string): TvText;
function AddField(AKind : TvFieldKind): TvField;
function TryToSelect(APos: TPoint; var ASubpart: Cardinal): TvFindEntityResult; override;
procedure Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
@ -877,7 +923,7 @@ type
end;
{@@
TvBulletList represents a list of bullets texts, like:
TvList represents a list of bulleted texts, like:
* First level
- Second level
@ -886,13 +932,19 @@ type
The basic element to build the sequence is TvParagraph
}
{ TvBulletList }
{ TvList }
TvBulletList = class(TvEntityWithSubEntities)
TvList = class(TvEntityWithSubEntities)
public
Parent : TvList;
ListStyle : TvListStyle;
constructor Create(APage: TvPage); override; // MJT 31/08 added override;
destructor Destroy; override;
function AddItem(ALevel: Integer; ASimpleText: string): TvParagraph;
function AddParagraph(ASimpleText: string): TvParagraph;
function AddList : TvList;
function Level : Integer;
{function TryToSelect(APos: TPoint; var ASubpart: Cardinal): TvFindEntityResult; override;
procedure Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
@ -922,7 +974,7 @@ type
destructor Destroy; override;
// Data writing methods
function AddParagraph: TvParagraph;
function AddBulletList: TvBulletList;
function AddList: TvList;
function AddTable: TvTable;
//function AddImage: TvImage;
//
@ -1077,8 +1129,7 @@ type
SelectedElement: TvEntity;
// List of common styles, for conveniently finding them
StyleTextBody, StyleHeading1, StyleHeading2, StyleHeading3: TvStyle;
StyleList : TvStyle;
ListStyles : Array[0..NUM_MAX_LISTSTYLES-1] Of TvListStyle;
StyleBulletList, StyleNumberList : TvListStyle;
{ Base methods }
constructor Create; virtual;
destructor Destroy; override;
@ -1111,7 +1162,6 @@ type
function AddStyle(): TvStyle;
function AddListStyle: TvListStyle;
procedure AddStandardTextDocumentStyles(AFormat: TvVectorialFormat);
function GetListStyleByLevel(ALevel: Integer): TvListStyle;
function GetStyleCount: Integer;
function GetStyle(AIndex: Integer): TvStyle;
function FindStyleIndex(AStyle: TvStyle): Integer;
@ -1270,7 +1320,7 @@ type
function AddEntity(AEntity: TvEntity): Integer; override;
{ Data writing methods }
function AddParagraph: TvParagraph;
function AddBulletList: TvBulletList;
function AddList: TvList;
function AddTable: TvTable;
//function AddImage: TvImage;
end;
@ -1433,6 +1483,69 @@ begin
Result.Units := AUnits;
end;
{ TvField }
constructor TvField.Create(APage: TvPage);
begin
inherited Create(APage);
DateFormat := 'dd/MM/yyyy hh:mm:ss';
NumberFormat := vnfDecimal;
end;
{ TvListLevelStyle }
constructor TvListLevelStyle.Create;
begin
Start := 1;
Bullet := '&#183;';
LeaderFontName := 'Symbol';
Alignment := vsaLeft;
end;
{ TvListStyle }
constructor TvListStyle.Create;
begin
ListLevelStyles:=TFPList.Create;
end;
destructor TvListStyle.Destroy;
begin
Clear;
ListLevelStyles.Free;
ListLevelStyles := Nil;
inherited Destroy;
end;
procedure TvListStyle.Clear;
var
i: Integer;
begin
for i := ListLevelStyles.Count-1 downto 0 do
begin
TvListLevelStyle(ListLevelStyles[i]).free;
ListLevelStyles.Delete(i);
end;
end;
function TvListStyle.AddListLevelStyle: TvListLevelStyle;
begin
Result := TvListLevelStyle.Create;
ListLevelStyles.Add(Result);
end;
function TvListStyle.GetListLevelStyleCount: Integer;
begin
Result := ListLevelStyles.Count;
end;
function TvListStyle.GetListLevelStyle(AIndex : Integer): TvListLevelStyle;
begin
Result := TvListLevelStyle(ListLevelStyles[Aindex]);
end;
{ TvTableCell }
constructor TvTableCell.Create(APage: TvPage);
@ -4710,6 +4823,13 @@ begin
AddEntity(Result);
end;
function TvParagraph.AddField(AKind: TvFieldKind): TvField;
begin
Result := TvField.Create(FPage);
Result.Kind := AKind;
AddEntity(Result);
end;
function TvParagraph.TryToSelect(APos: TPoint; var ASubpart: Cardinal
): TvFindEntityResult;
begin
@ -4728,28 +4848,58 @@ begin
Result:=inherited GenerateDebugTree(ADestRoutine, APageItem);
end;
{ TvBulletList }
{ TvList }
constructor TvBulletList.Create(APage: TvPage);
constructor TvList.Create(APage: TvPage);
begin
inherited Create(APage);
Parent := Nil;
end;
destructor TvBulletList.Destroy;
destructor TvList.Destroy;
begin
inherited Destroy;
end;
function TvBulletList.AddItem(ALevel: Integer; ASimpleText: string): TvParagraph;
function TvList.AddParagraph(ASimpleText: string): TvParagraph;
begin
Result := TvParagraph.Create(FPage);
if FPage <> nil then
Result.ListStyle := FPage.FOwner.GetListStyleByLevel(ALevel);
// TODO:
// if FPage <> nil then
// Result.ListStyle := FPage.FOwner.GetListStyleByLevel(ALevel);
if ASimpleText <> '' then
Result.AddText(ASimpleText);
AddEntity(Result);
end;
function TvList.AddList: TvList;
begin
Result := TvList.Create(FPage);
Result.Style := Style;
Result.ListStyle := ListStyle;
Result.Parent := Self;
AddEntity(Result);
end;
function TvList.Level: Integer;
var
oListItem : TvList;
begin
Result := 0;
oListItem := Parent;
while (oListItem<>Nil) do
begin
oListItem := oListItem.Parent;
inc(Result);
end;
end;
{ TvRichText }
constructor TvRichText.Create(APage: TvPage);
@ -4768,9 +4918,9 @@ begin
AddEntity(Result);
end;
function TvRichText.AddBulletList: TvBulletList;
function TvRichText.AddList: TvList;
begin
Result := TvBulletList.Create(FPage);
Result := TvList.Create(FPage);
AddEntity(Result);
end;
@ -5618,9 +5768,9 @@ begin
Result := MainText.AddParagraph();
end;
function TvTextPageSequence.AddBulletList: TvBulletList;
function TvTextPageSequence.AddList: TvList;
begin
Result := MainText.AddBulletList();
Result := MainText.AddList();
end;
function TvTextPageSequence.AddTable: TvTable;
@ -6004,39 +6154,29 @@ var
lTextBody, lBaseHeading, lCurStyle: TvStyle;
lCurListStyle : TvListStyle;
i: Integer;
lCurListLevelStyle: TvListLevelStyle;
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" />
//</style:style>
lTextBody := AddStyle();
lTextBody.Name := 'Text Body';
lTextBody.Kind := vskTextBody;
lTextBody.Font.Size := 12;
lTextBody.Font.Name := 'Times New Roman';
lTextBody.Alignment := vsaJustifed;
lTextBody.SetElements := [spbfFontSize, spbfFontName, spbfAlignment];
lTextBody.MarginTop := 0;
lTextBody.MarginBottom := 2.12;
lTextBody.SetElements := [spbfFontSize, spbfFontName, spbfAlignment, sseMarginTop, sseMarginBottom];
StyleTextBody := lTextBody;
// Headings
// <style:style style:name="Heading" style:family="paragraph" style:parent-style-name="Standard" style:next-style-name="Text_20_body" style:class="text">
// <style:paragraph-properties fo:margin-top="0.423cm" fo:margin-bottom="0.212cm" style:contextual-spacing="false" fo:keep-with-next="always" />
// <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" />
// </style:style>
lBaseHeading := AddStyle();
lBaseHeading.Name := 'Heading';
lBaseHeading.Kind := vskHeading;
lBaseHeading.Font.Size := 14;
lBaseHeading.Font.Name := 'Arial';
lBaseHeading.SetElements := [spbfFontSize, spbfFontName, sseMarginTop, sseMarginBottom];
lBaseHeading.MarginTop := 4.23;
lBaseHeading.MarginBottom := 2.12;
lBaseHeading.SetElements := [spbfFontSize, spbfFontName, sseMarginTop, sseMarginBottom];
//<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">
// <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" />
//</style:style>
lCurStyle := AddStyle();
lCurStyle.Name := 'Heading 1';
lCurStyle.Parent := lBaseHeading;
@ -6046,9 +6186,6 @@ begin
lCurStyle.SetElements := [spbfFontSize, spbfFontBold];
StyleHeading1 := lCurStyle;
//<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">
// <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" />
//</style:style>
lCurStyle := AddStyle();
lCurStyle.Name := 'Heading 2';
lCurStyle.Parent := lBaseHeading;
@ -6059,9 +6196,6 @@ begin
lCurStyle.SetElements := [spbfFontSize, spbfFontBold, spbfFontItalic];
StyleHeading2 := lCurStyle;
//<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">
// <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" />
//</style:style>
lCurStyle := AddStyle();
lCurStyle.Name := 'Heading 3';
lCurStyle.Parent := lBaseHeading;
@ -6071,70 +6205,45 @@ begin
lCurStyle.SetElements := [spbfFontSize, spbfFontName, spbfFontBold];
StyleHeading3 := lCurStyle;
{
<style:style style:name="List" style:family="paragraph" style:parent-style-name="Text_20_body" style:class="list">
<style:text-properties style:font-size-asian="12pt" style:font-name-complex="Mangal1" />
</style:style>
<style:style style:name="Caption" style:family="paragraph" style:parent-style-name="Standard" style:class="extra">
<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" />
<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" />
</style:style>
<style:style style:name="Index" style:family="paragraph" style:parent-style-name="Standard" style:class="index">
<style:paragraph-properties text:number-lines="false" text:line-number="0" />
<style:text-properties style:font-size-asian="12pt" style:font-name-complex="Mangal1" />
</style:style>
<style:style style:name="Internet_20_link" style:display-name="Internet link" style:family="text">
<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" />
</style:style>
<style:style style:name="Bullet_20_Symbols" style:display-name="Bullet Symbols" style:family="text">
<style:text-properties style:font-name="OpenSymbol" style:font-name-asian="OpenSymbol" style:font-name-complex="OpenSymbol" />
</style:style>
}
// ---------------------------------
// Bullet List Items
// ---------------------------------
lCurStyle := AddStyle();
lCurStyle.Name := 'List Style';
//lCurStyle.Parent := ;
lCurStyle.MarginTop := 0.5;
lCurStyle.MarginBottom := 0.5;
lCurStyle.SetElements:=[sseMarginBottom, sseMarginTop];
lCurStyle.SuppressSpacingBetweenSameParagraphs:=True;
StyleList := lCurStyle;
// ---------------------------------
// List Style Items
// ---------------------------------
lCurListStyle := AddListStyle();
lCurListStyle.Name := 'Bullet List Style';
StyleBulletList := lCurListStyle;
for i := 0 To NUM_MAX_LISTSTYLES-1 Do
begin
lCurListStyle := AddListStyle;
lCurListStyle.Kind := vlskBullet;
lCurListStyle.Level := i;
lCurListStyle.Prefix := '&#183;';
lCurListStyle.PrefixFontName := 'Symbol';
lCurListStyle.MarginLeft := 6.35*(i + 1);
lCurListStyle.HangingIndent := 6.35;
lCurListStyle.Alignment := vsaLeft;
lCurListLevelStyle := StyleBulletList.AddListLevelStyle;
lCurListLevelStyle.Kind := vlskBullet;
lCurListLevelStyle.Level := i;
ListStyles[i] := lCurListStyle;
// Bullet is positioned at MarginLeft - HangingIndent
lCurListLevelStyle.MarginLeft := 16.35*(i + 1);
lCurListLevelStyle.HangingIndent := 6.35;
end;
end;
function TvVectorialDocument.GetListStyleByLevel(ALevel: Integer): TvListStyle;
var
i: Integer;
oListStyle : TvListStyle;
begin
Result := Nil;
for i := 0 to GetListStyleCount-1 do
lCurListStyle := AddListStyle();
lCurListStyle.Name := 'Numbered List Style';
StyleNumberList := lCurListStyle;
for i := 0 To NUM_MAX_LISTSTYLES-1 Do
begin
oListStyle := GetListStyle(i);
lCurListLevelStyle := StyleNumberList.AddListLevelStyle;
lCurListLevelStyle.Kind := vlskNumeric;
lCurListLevelStyle.NumberFormat := vnfDecimal;
lCurListLevelStyle.Level := i;
if oListStyle.Level = ALevel then
Exit(oListStyle);
lCurListLevelStyle.Prefix := '';
lCurListLevelStyle.Suffix := '.';
lCurListLevelStyle.DisplayLevels := True; // 1.1.1.1.
lCurListLevelStyle.LeaderFontName := 'Arial';
// For MS Word
// Bullet is positioned at MarginLeft - HangingIndent
lCurListLevelStyle.MarginLeft := 16.35*(i + 1);
lCurListLevelStyle.HangingIndent := 6.35 + 3*i;
end;
end;
@ -6176,6 +6285,7 @@ begin
if GetListStyle(i) = AListStyle then Exit(i);
end;
{@@
Clears all data in the document
}

540
components/fpvectorial/odtvectorialwriter.pas
View File

@ -59,18 +59,43 @@ uses
fpvectorial, fpvutils, lazutf8;
type
// Forward declarations
TvODTVectorialWriter = class;
{ TListStyle_Style }
TListStyle_Style = Class
Style : TvStyle;
ListStyle : TvListStyle;
End;
{ TListStyle_StyleList }
TListStyle_StyleList = Class(TFPList)
Writer : TvODTVectorialWriter;
Data : TvVectorialDocument;
destructor Destroy; override;
function AddCrossReference(AStyle : TvStyle; AListStyle: TvListStyle) : Integer;
function AsText(AIndex : Integer) : String;
End;
{ TvODTVectorialWriter }
// Writes ODT 1.2
// Writes ODT 1.2 with LibreOffice extensions...
TvODTVectorialWriter = class(TvCustomVectorialWriter)
private
FDateCount : Integer; // Used to track Date Style Formats...
FPointSeparator: TFormatSettings;
// Strings with the contents of files
FMeta, FSettings, FStyles, FContent, FMimetype: string;
FAutomaticStyles, FMasterStyles: string; // built during writedocument, used during writestyle
FAutomaticStyleID : Integer;
FContentAutomaticStyles : string; // built during writedocument, used during writedocument
FContentAutomaticStyleID : Integer;
FList_StyleCrossRef : TListStyle_StyleList;
FNewPageSequence : Boolean;
@ -78,6 +103,7 @@ type
// helper routines
function StyleNameToODTStyleName(AData: TvVectorialDocument; AStyleIndex: Integer; AToContentAutoStyle: Boolean = False): string; overload;
function StyleNameToODTStyleName(AData: TvVectorialDocument; AStyle: TvStyle; AToContentAutoStyle: Boolean = False): string; overload;
function ListStyleNameToODTText(AData: TvVectorialDocument; AListStyle : TvListStyle) : string;
function FloatToODTText(AFloat: Double): string;
function BordersToString(ATableBorders, ACellBorders: TvTableBorders; ATopCell,
ABottomCell, ALeftCell, ARightCell: Boolean): String;
@ -96,7 +122,9 @@ type
AData: TvVectorialDocument);
procedure WriteTextSpan(AEntity: TvText; AParagraph: TvParagraph;
ACurPage: TvTextPageSequence; AData: TvVectorialDocument);
procedure WriteBulletList(AEntity: TvBulletList; ACurPage: TvTextPageSequence; AData: TvVectorialDocument);
procedure WriteField(AEntity: TvField; AParagraph: TvParagraph;
ACurPage: TvTextPageSequence; AData: TvVectorialDocument);
procedure WriteList(AEntity: TvList; ACurPage: TvTextPageSequence; AData: TvVectorialDocument);
// Routines to write parts of those files
function WriteStylesXMLAsString: string;
//
@ -179,6 +207,71 @@ const
FLOAT_MILIMETERS_PER_PIXEL = 0.2822; // DPI 90 = 1 / 90 inches per pixel
FLOAT_PIXELS_PER_MILIMETER = 3.5433; // DPI 90 = 1 / 90 inches per pixel
// Lookups
LU_ALIGN: Array [TvStyleAlignment] Of String =
('start', 'end', 'justify', 'center');
LU_V_ALIGN: Array[TvVerticalAlignment] Of String =
('top', 'bottom', 'middle', 'automatic');
LU_NUMBERFORMAT: Array [TvNumberFormat] Of String =
('1', 'a', 'i', 'A', 'I');
LU_BORDERTYPE: Array[TvTableBorderType] Of String =
('solid', 'dashed', 'solid', 'none', 'default');
// ('solid', 'dashed', 'double', 'none', 'default'); // NOTE: double not supported
{ TListStyle_StyleList }
destructor TListStyle_StyleList.Destroy;
begin
while (Count>0) do
begin
TListStyle_Style(Last).Free;
Delete(Count-1);
end;
inherited destroy;
end;
function TListStyle_StyleList.AddCrossReference(AStyle: TvStyle;
AListStyle: TvListStyle): Integer;
Var
i : Integer;
oCrossRef : TListStyle_Style;
begin
// Only add unique instances of the cross references
Result := -1;
for i := 0 To Count-1 Do
begin
oCrossRef := TListStyle_Style(Items[i]);
if (oCrossRef.Style = AStyle) And (oCrossRef.ListStyle=AListStyle) Then
exit(i);
end;
// We will only get here if the supplied combination is not already in the list
oCrossRef := TListStyle_Style.Create;
oCrossRef.Style := AStyle;
oCrossRef.ListStyle := AListStyle;
Result := Add(oCrossRef);
end;
function TListStyle_StyleList.AsText(AIndex: Integer): String;
begin
if (AIndex>=0) And (AIndex<Count) Then
with (TListStyle_Style(Items[AIndex])) Do
Result := Writer.StyleNameToODTStyleName(Data, Style, False) + '_' +
Writer.ListStyleNameToODTText(Data, ListStyle)
else
raise exception.create('index out of bounds');
end;
function TvODTVectorialWriter.StyleNameToODTStyleName(
AData: TvVectorialDocument; AStyleIndex: Integer; AToContentAutoStyle: Boolean): string;
var
@ -205,6 +298,15 @@ begin
Result := StyleNameToODTStyleName(AData, lStyleIndex, AToContentAutoStyle);
end;
function TvODTVectorialWriter.ListStyleNameToODTText(
AData: TvVectorialDocument; AListStyle: TvListStyle): string;
begin
Result := StringReplace(AListStyle.Name, ' ', '', [rfReplaceAll]);
If Result='' Then
Result := Format('List_%d', [AData.FindListStyleIndex(AListStyle)]);
end;
function TvODTVectorialWriter.FloatToODTText(AFloat: Double): string;
begin
Result := FloatToStr(AFloat, FPointSeparator);
@ -399,9 +501,10 @@ var
i: Integer;
CurStyle: TvStyle;
lTextPropsStr, lParagraphPropsStr, lCurStyleTmpStr, CurStyleParent : string;
Const
LU_ALIGN: Array [TvStyleAlignment] Of String =
('start', 'end', 'justify', 'center');
CurListStyle: TvListStyle;
j: Integer;
CurListLevelStyle: TvListLevelStyle;
CurLevel, sLevelAttr: String;
begin
FStyles :=
XML_HEADER + LineEnding +
@ -663,7 +766,66 @@ begin
' </text:outline-level-style>' + LineEnding +
' </text:outline-style>' + LineEnding;
FStyles := FStyles +
// Build up the List definitions - store in Styles.xml, not content.xml
For i := 0 To AData.GetListStyleCount-1 Do
begin
CurListStyle := AData.GetListStyle(i);
FStyles := FStyles +
' <text:list-style style:name="'+ListStyleNameToODTText(AData, CurListStyle)+'">' + LineEnding;
For j := 0 To CurListStyle.GetListLevelStyleCount-1 Do
Begin
CurListLevelStyle := CurListStyle.GetListLevelStyle(j);
CurLevel := IntToStr(CurListLevelStyle.Level+1); // Note the +1...
// Open Bullet or Number...
If CurListLevelStyle.Kind=vlskBullet Then
FStyles := FStyles +
' <text:list-level-style-bullet text:level="'+CurLevel+'" '+
'text:style-name="Bullet_20_Symbols" '+
'text:bullet-char="'+CurListLevelStyle.Bullet+'">' + LineEnding
Else
Begin
sLevelAttr:='text:level="'+CurLevel+'" ';
If CurListLevelStyle.Prefix<>'' Then
sLevelAttr := Format('%s style:num-prefix="%s"', [sLevelAttr, CurListLevelStyle.Prefix]);
If CurListLevelStyle.Suffix<>'' Then
sLevelAttr := Format('%s style:num-suffix="%s"', [sLevelAttr, CurListLevelStyle.Suffix]);
sLevelAttr := sLevelAttr + ' style:num-format="'+LU_NUMBERFORMAT[CurListLevelStyle.NumberFormat]+'"';
// Display previous levels in Leader?
If (CurListLevelStyle.DisplayLevels) And (CurLevel<>'1') Then
sLevelAttr := Format('%s text:display-levels="%s"', [sLevelAttr, CurLevel]);
FStyles := FStyles +
' <text:list-level-style-number ' + sLevelAttr +'>' + LineEnding;
End;
// Common Level properties
FStyles:=FStyles +
' <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(CurListLevelStyle.MarginLeft/10)+'cm" '+
'fo:text-indent="-'+FloatToODTText(CurListLevelStyle.HangingIndent/10)+'cm" '+
'fo:margin-left="'+FloatToODTText(CurListLevelStyle.MarginLeft/10)+'cm" />' + LineEnding +
' </style:list-level-properties>' + LineEnding;
// Close Bullet or Number
If CurListLevelStyle.Kind=vlskBullet Then
FStyles:=FStyles + ' </text:list-level-style-bullet>' + LineEnding
Else
FStyles:=FStyles + ' </text:list-level-style-number>' + LineEnding
end;
FStyles := FStyles + ' </text:list-style>' + LineEnding;
end;
FStyles := FStyles +
' <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;
FStyles := FStyles +
' <text:notes-configuration text:note-class="endnote" style:num-format="i" text:start-value="0" />' + LineEnding;
@ -678,27 +840,12 @@ begin
FStyles := FStyles +
'<office:automatic-styles>' + LineEnding +
FAutomaticStyles + LineEnding +
(*
' <style:page-layout style:name="Mpm1">' + LineEnding +
' <style:page-layout-properties fo:page-width="21.001cm" fo:page-height="29.7cm" style:num-format="1" style:print-orientation="portrait" fo:margin-top="2cm" fo:margin-bottom="2cm" fo:margin-left="2cm" fo:margin-right="2cm" style:writing-mode="lr-tb" style:footnote-max-height="0cm">' + LineEnding +
' <style:footnote-sep style:width="0.018cm" style:distance-before-sep="0.101cm" style:distance-after-sep="0.101cm" style:line-style="solid" style:adjustment="left" style:rel-width="25%" style:color="#000000" />' + LineEnding +
' </style:page-layout-properties>' + LineEnding +
' <style:header-style />' + LineEnding +
' <style:footer-style />' + LineEnding +
' </style:page-layout>' + LineEnding +
' <style:style style:name="List_0" style:family="paragraph" style:parent-style-name="Standard" style:list-style-name="L1">' + LineEnding +
// <style:text-properties officeooo:rsid="00072f3e" officeooo:paragraph-rsid="00072f3e" />
' </style:style>' + LineEnding +
*)
FAutomaticStyles + LineEnding +
'</office:automatic-styles>' + LineEnding;
FStyles := FStyles +
'<office:master-styles>' + LineEnding +
FMasterStyles + LineEnding +
(*
' <style:master-page style:name="Standard" style:page-layout-name="Mpm1" />' + LineEnding +
*)
FMasterStyles + LineEnding +
'</office:master-styles>' + LineEnding;
FStyles := FStyles +
@ -710,10 +857,10 @@ var
i: Integer;
sPrefix : String;
sAutomaticStyles : String;
CurLevel: String;
CurPage: TvPage;
CurTextPage: TvTextPageSequence absolute CurPage;
CurListStyle : TvListStyle;
oCrossRef: TListStyle_Style;
begin
// content.xml will be built up by
// sPrefix + sAutomaticStyles + FContent
@ -797,32 +944,21 @@ begin
'</office:document-content>' + LineEnding;
// Build up the automatic styles detailed in the content.xml
sAutomaticStyles := sAutomaticStyles +
' <office:automatic-styles>' + LineEnding;
sAutomaticStyles := ' <office:automatic-styles>' + 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
// Add all the List Definition / Paragraph Style
// cross references
// TODO: Investigate if this should/could be moved into Styles.xml
sAutomaticStyles := sAutomaticStyles + ' <text:list-style style:name="L1">' + LineEnding;
For i := 0 To AData.GetListStyleCount-1 Do
for i := 0 to FList_StyleCrossRef.Count-1 Do
begin
CurListStyle := AData.GetListStyle(i);
CurLevel := IntToStr(CurListStyle.Level+1); // Note the +1...
oCrossRef := TListStyle_Style(FList_StyleCrossRef[i]);
If CurListStyle.Kind=vlskBullet Then
sAutomaticStyles := sAutomaticStyles + ' <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;
sAutomaticStyles := sAutomaticStyles +
' <style:style style:name="'+FList_StyleCrossRef.AsText(i)+'" '+
'style:family="paragraph" '+
'style:parent-style-name="'+StyleNameToODTStyleName(AData, oCrossRef.Style, False)+'" '+
'style:list-style-name="'+ListStyleNameToODTText(AData, oCrossRef.ListStyle)+'" />' + LineEnding;
end;
sAutomaticStyles := sAutomaticStyles + ' </text:list-style>' + LineEnding;
// Now add any Automatic Styles built during WritePage..
sAutomaticStyles := sAutomaticStyles + FContentAutomaticStyles;
@ -846,8 +982,8 @@ begin
if (lCurEntity is TvParagraph) then
WriteParagraph(TvParagraph(lCurEntity), ACurPage, AData);
if (lCurEntity is TvBulletList) then
WriteBulletList(TvBulletList(lCurEntity), ACurPage, AData);
if (lCurEntity is TvList) then
WriteList(TvList(lCurEntity), ACurPage, AData);
if (lCurEntity is TvTable) then
WriteTable(TvTable(lCurEntity), ACurPage, AData);
end;
@ -932,7 +1068,7 @@ begin
sOrientation := 'portrait';
// Define the page layout in Styles.xml
// TODO: Add PAge Margins...
// TODO: Add Page Margins...
FAutomaticStyles := FAutomaticStyles +
'<style:page-layout style:name="'+sPageLayoutName+'">'+ LineEnding+
' <style:page-layout-properties '+
@ -961,63 +1097,15 @@ begin
lCurEntity := AEntity.GetEntity(i);
if (lCurEntity is TvText) then
WriteTextSpan(TvText(lCurEntity), AEntity, ACurPage, AData);
WriteTextSpan(TvText(lCurEntity), AEntity, ACurPage, AData)
else if (lCurEntity is TvField) then
WriteField(TvField(lCurEntity), AEntity, ACurPage, AData)
else
raise exception.create('TvParagraph subentity '+lCurEntity.ClassName+' not handled');
end;
FContent := FContent +
'</text:'+EntityKindName+'>' + LineEnding;
{
<text:h text:style-name="P2" text:outline-level="1">Laza<text:span text:style-name="T1">ru</text:span>s</text:h>
<text:p text:style-name="P5">Lazarus is a free and open source development tool for the Free Pascal compiler, which is also free and open source.</text:p>
<text:h text:style-name="P1" text:outline-level="2">Overview</text:h>
<text:p text:style-name="P3">Lazarus is a free cross-platform visual integrated development environment (IDE) for rapid application development (RAD) using the Free Pascal compiler supported dialects of Object Pascal. Developers use Lazarus to create native code console and graphical user interface (GUI) applications for the desktop along with mobile devices, web applications, web services, and visual components and function libraries (.so, .dll, etc) for use by other programs for any platform the Free Pascal compiler supports( Mac, Unix, Linux, Windows, etc).</text:p>
<text:p text:style-name="P3" />
<text:p text:style-name="P3">Lazarus provides a highly visual development environment for the creation of rich user interfaces, application logic, and other supporting code artifacts. Along with the customary project management features, the Lazarus IDE also provides features that includes but are not limited to:</text:p>
<text:p text:style-name="P3" />
<text:list xml:id="list5792477270030595966" text:style-name="L1">
<text:list-item>
<text:p text:style-name="P4">A What You See Is What You Get (WYSIWYG) visual windows layout designer</text:p>
</text:list-item>
<text:list-item>
<text:p text:style-name="P4">An extensive set of GUI widgets or visual components such as edit boxes, buttons, dialogs, menus, etc.</text:p>
</text:list-item>
<text:list-item>
<text:p text:style-name="P4">An extensive set of non visual components for common behaviors such as persistence of application settings</text:p>
</text:list-item>
<text:list-item>
<text:p text:style-name="P4">A set of data connectivity components for MySQL, PostgresSQL, FireBird, Oracle, SQL Lite, Sybase, and others</text:p>
</text:list-item>
<text:list-item>
<text:p text:style-name="P4">Data aware widget set that allows the developer to see data in visual components in the designer to assist with development</text:p>
</text:list-item>
<text:list-item>
<text:p text:style-name="P4">Interactive code debugger</text:p>
</text:list-item>
<text:list-item>
<text:p text:style-name="P4">Code completion</text:p>
</text:list-item>
<text:list-item>
<text:p text:style-name="P4">Code templates</text:p>
</text:list-item>
<text:list-item>
<text:p text:style-name="P4">Syntax highlighting</text:p>
</text:list-item>
<text:list-item>
<text:p text:style-name="P4">Context sensitive help</text:p>
</text:list-item>
<text:list-item>
<text:p text:style-name="P4">Text resource manager for internationalization</text:p>
</text:list-item>
<text:list-item>
<text:p text:style-name="P4">Automatic code formatting</text:p>
</text:list-item>
<text:list-item>
<text:p text:style-name="P4">The ability to create custom components</text:p>
</text:list-item>
</text:list>
<text:p text:style-name="P3" />
<text:p text:style-name="P3">Lazarus inherits three features from its use of the Free Pascal compiler: compile and execution speed, and cross-compilation. The Free Pascal compiler benefits from the Pascal language structure, which is rigid, and the steady advancements of Pascal compiler design, spanning several decades, to compile large applications quickly, often seconds.</text:p>
}
end;
procedure TvODTVectorialWriter.WriteTextSpan(AEntity: TvText; AParagraph: TvParagraph;
@ -1026,8 +1114,12 @@ var
AEntityStyleName: string;
lStyle: TvStyle;
sText: String;
i : Integer;
begin
lStyle := AEntity.Style;
If lStyle<>Nil Then
AEntityStyleName:=StyleNameToODTStyleName(AData, lStyle, False);
// No need to all GetCombinedStyle as Paragraph Style already applied in text:p tag
(*
lStyle := AEntity.GetCombinedStyle(AParagraph);
if lStyle = nil then
begin
@ -1037,6 +1129,7 @@ begin
begin
AEntityStyleName := StyleNameToODTStyleName(AData, lStyle, False);
end;
*)
{
<text:p text:style-name="P2">
Lazaru
@ -1047,10 +1140,6 @@ begin
</text:p>
}
// Note that here we write only text spans!
// 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
@ -1059,24 +1148,169 @@ begin
Else
sText := Copy(sText, 1, Length(sText) - 1);
sText := StringReplace(sText, ' ', ' <text:s/>', [rfReplaceAll]);
sText := StringReplace(sText, #09, '<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>';
If lStyle<>Nil Then
FContent := FContent + '<text:span text:style-name="'+AEntityStyleName+'">' +
sText + '</text:span>'
Else
FContent := FContent + '<text:span>' + sText + '</text:span>'
end;
procedure TvODTVectorialWriter.WriteField(AEntity: TvField;
AParagraph: TvParagraph; ACurPage: TvTextPageSequence;
AData: TvVectorialDocument);
Var
sDateStyleName : String;
i: Integer;
cCurrChar: Char;
cPrevChar: Char;
sTag: String;
iLen: Integer;
begin
// <number:day number:calendar="gregorian"/>
// <number:text>/</number:text>
// <number:month number:style="long" number:calendar="gregorian"/>
// <number:text>/</number:text>
// <number:year number:style="long" number:calendar="gregorian"/>
// <number:text> </number:text>
// <number:hours/>
// <number:text>:</number:text>
// <number:minutes number:style="long"/>
// <number:text> </number:text>
// <number:am-pm/>
if AEntity.Kind in [vfkDate, vfkDateCreated] Then
begin
inc(FDateCount);
sDateStyleName := Format('Date_%d', [FDateCount]);
FContentAutomaticStyles:=FContentAutomaticStyles +
' <number:date-style style:name="'+sDateStyleName+'"> '+LineEnding;
cPrevChar := Chr(0);
i := 1;
while (i<=Length(AEntity.DateFormat)) do
begin
cCurrChar := AEntity.DateFormat[i];
iLen := 1;
if cCurrChar<>cPrevChar Then
begin
// Find out how many characters repeat in a row...
while (i+iLen<=Length(AEntity.DateFormat)) And (AEntity.DateFormat[i+iLen]=cCurrChar) do
inc(iLen);
sTag := '';
case cCurrChar Of
'd' :
begin
Case iLen Of
1 : sTag := '<number:day/>';
2 : sTag := '<number:day number:style="long"/>';
3 : sTag := '<number:day-of-week/>';
else
sTag := '<number:day-of-week number:style="long"/>';
end;
end;
'M' :
begin
case iLen Of
1 : sTag := '<number:month/>';
2 : sTag := '<number:month number:style="long"/>';
3 : sTag := '<number:month number:textual="true"/>';
else
sTag := '<number:month number:textual="true" number:style="long"/>';
end;
end;
'y' :
begin
if iLen=2 then
sTag := '<number:year/>'
else
sTag := '<number:year number:style="long"/>';
end;
'h' :
begin
if iLen=1 then
sTag := '<number:hours/>'
else
sTag := '<number:hours number:style="long"/>';
end;
'm' :
begin
if iLen=1 then
sTag := '<number:minutes/>'
else
sTag := '<number:minutes number:style="long"/>';
end;
's' :
begin
if iLen=1 then
sTag := '<number:seconds/>'
else
sTag := '<number:seconds number:style="long"/>';
end;
'a' :
begin
sTag := '<number:am-pm/>';
iLen := 5;
end;
else
sTag := '<number:text>'+cCurrChar+'</number:text>';
end;
cPrevChar := cCurrChar;
end;
FContentAutomaticStyles:=FContentAutomaticStyles +
' '+sTag + LineEnding;
Inc(i, iLen);
end;
FContentAutomaticStyles:=FContentAutomaticStyles +
' </number:date-style> '+LineEnding;
end;
case AEntity.Kind of
vfkNumPages:
begin
FContent:=FContent +
'<text:page-count style:num-format="'+LU_NUMBERFORMAT[AEntity.NumberFormat]+
'">'+IntToStr(AData.GetPageCount)+'</text:page-count>';
end;
vfkPage:
begin
FContent:=FContent +
'<text:page-number style:num-format="'+LU_NUMBERFORMAT[AEntity.NumberFormat]+
'" text:fixed="false">'+IntToStr(AData.GetPageIndex(ACurPage))+'</text:page-number>';
end;
vfkAuthor:
begin
FContent:=FContent +
'<text:initial-creator text:fixed="false">FPVECTORIAL</text:initial-creator>';
end;
vfkDateCreated:
begin
FContent:=FContent +
'<text:creation-date style:data-style-name="'+sDateStyleName+'">'+DateToStr(Now)+'</text:creation-date>';
end;
vfkDate:
begin
FContent:=FContent +
'<text:date style:data-style-name="'+sDateStyleName+'">'+DateToStr(Now)+'</text:date>';
end;
end;
end;
function TvODTVectorialWriter.BordersToString(ATableBorders, ACellBorders : TvTableBorders;
ATopCell, ABottomCell, ALeftCell, ARightCell : Boolean):String;
Const
LU_BORDERTYPE: Array[TvTableBorderType] Of String =
('solid', 'dashed', 'solid', 'none', 'default');
// ('solid', 'dashed', 'double', 'none', 'default');
(*
double requires a completely different configuration, so for now, we won't
double line thickness requires a completely different configuration, so for now, we won't
support it...
<style:table-cell-properties style:vertical-align="middle"
@ -1126,7 +1360,6 @@ Const
end;
Var
sLeft, sRight, sTop, sBottom : String;
sPadding : String;
Begin
(*
OpenDocument does not support setting borders at the Table Level,
@ -1212,8 +1445,6 @@ Var
sCellStyle,
sTemp, sTemp2: String;
bInHeader: Boolean;
Const
LU_V_ALIGN: Array[TvVerticalAlignment] Of String = ('top', 'bottom', 'middle', 'automatic');
Begin
// TODO: Add support for TvTableBorder.Spacing
@ -1376,8 +1607,8 @@ Begin
if (lCurEntity is TvParagraph) then
WriteParagraph(TvParagraph(lCurEntity), ACurPage, AData);
if (lCurEntity is TvBulletList) then
WriteBulletList(TvBulletList(lCurEntity), ACurPage, AData);
if (lCurEntity is TvList) then
WriteList(TvList(lCurEntity), ACurPage, AData);
if (lCurEntity is TvTable) then
WriteTable(TvTable(lCurEntity), ACurPage, AData);
end;
@ -1395,36 +1626,37 @@ Begin
AddBody('</table:table>');
end;
procedure TvODTVectorialWriter.WriteBulletList(AEntity: TvBulletList;
procedure TvODTVectorialWriter.WriteList(AEntity: TvList;
ACurPage: TvTextPageSequence; AData: TvVectorialDocument);
var
i, j: Integer;
lCurEntity, lCurSubEntity: TvEntity;
lCurParagraph: TvParagraph;
iCrossRef: Integer;
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="'+ListStyleNameToODTText(AData, AEntity.ListStyle)+'">' + LineEnding;
for i := 0 to AEntity.GetEntitiesCount()-1 do
begin
lCurEntity := AEntity.GetEntity(i);
FContent := FContent +
' <text:list-item>' + LineEnding;
if (lCurEntity is TvParagraph) then
begin
lCurParagraph := lCurEntity as TvParagraph;
iCrossRef := FList_StyleCrossRef.AddCrossReference(AEntity.Style, AEntity.ListStyle);
// Special Style correlating the Paragraph Style and the List style
// should be added to Content.xml Automatic Styles
FContent := FContent +
' <text:list-item>' + LineEnding +
' <text:p>';
' <text:p text:style-name="'+FList_StyleCrossRef.AsText(iCrossRef)+'">';
for j := 0 to lCurParagraph.GetEntitiesCount()-1 do
begin
@ -1435,9 +1667,13 @@ begin
end;
FContent := FContent +
'</text:p>' + LineEnding +
' </text:list-item>' + LineEnding;
end;
' </text:p>' + LineEnding;
end
else if lCurEntity Is TvList Then
WriteList(TvList(lCurEntity), ACurPage, AData);
FContent := FContent +
' </text:list-item>' + LineEnding;
end;
FContent := FContent +
@ -1459,22 +1695,46 @@ begin
FAutomaticStyles := '';
FMasterStyles := '';
FList_StyleCrossRef := TListStyle_StyleList.Create;
FList_StyleCrossRef.Writer := Self;
FDateCount := 0;
end;
destructor TvODTVectorialWriter.Destroy;
begin
FList_StyleCrossRef.Free;
inherited Destroy;
end;
procedure TvODTVectorialWriter.WriteToFile(AFileName: string;
AData: TvVectorialDocument);
Var
oStream: TFileStream;
Begin
If ExtractFileExt(AFilename) = '' Then
AFilename := AFilename + STR_ODT_EXTENSION;
oStream := TFileStream.Create(AFileName, fmCreate);
Try
WriteToStream(oStream, AData);
Finally
FreeAndNil(oStream);
End;
End;
procedure TvODTVectorialWriter.WriteToStream(AStream: TStream;
AData: TvVectorialDocument);
var
FZip: TZipper;
// Streams with the contents of files
FSMeta, FSSettings, FSStyles, FSContent, FSMimetype: TStringStream;
FSMetaInfManifest, FSManifestRDF: TStringStream;
begin
FList_StyleCrossRef.Data := AData;
{ Fill the strings with the contents of the files }
WriteMimetype();
@ -1501,10 +1761,9 @@ begin
FZip := TZipper.Create;
try
FZip.FileName := AFileName;
// MimeType must be first file, and should be uncompressed
// TODO: CompressionLevel is not working. Bug, or misuse?
// See http://mantis.freepascal.org/view.php?id=24897 for patch...
FZip.Entries.AddFileEntry(FSMimetype, OPENDOC_PATH_MIMETYPE).CompressionLevel:=clNone;
FZip.Entries.AddFileEntry(FSMeta, OPENDOC_PATH_META);
@ -1514,7 +1773,7 @@ begin
FZip.Entries.AddFileEntry(FSMetaInfManifest, OPENDOC_PATH_METAINF_MANIFEST);
FZip.Entries.AddFileEntry(FSManifestRDF, OPENDOC_PATH_MANIFESTRDF);
FZip.ZipAllFiles;
FZip.SaveToStream(AStream);
finally
FZip.Free;
FSMeta.Free;
@ -1527,13 +1786,6 @@ begin
end;
end;
procedure TvODTVectorialWriter.WriteToStream(AStream: TStream;
AData: TvVectorialDocument);
begin
// Not supported at the moment
raise Exception.Create('TvODTVectorialWriter.WriteToStream not supported');
end;
initialization
RegisterVectorialWriter(TvODTVectorialWriter, vfODT);