View difference between Paste ID: 5sQmiDkn and NTx7zDUA

 Unit BODTUnit;
 
 {$mode objfpc}{$H+}
 
 Interface
 
 Uses
   {$ifdef unix}
   unix,
   {$else}
   windows,
   {$endif}
   Classes, SysUtils, XMLRead, XMLWrite, DOM, zipper, strutils;
 
 Type
   TFontStyle = (ftBold, ftItalic);
   TFontStyles = set of TFontStyle;
   TTextPosition = (
     tpCenter = 1,
     tpLeft = 2,
     tpRight = 3,
     tpJustify = 4);
   TVertAlign = (vaTop, vaMiddle, vaBottom, vaAutomatic);
 
 Type BODTClass = Class;
 
 Type
 
 { BODTTableClass }
 
  BODTTableClass = Class
   Private
     bODT: BODTClass;
     bRootNode: TDOMNode;
     bTableName: String;
     Function GetCellNode(Const aCol, aRow: Integer): TDOMNode;
     Function GetRowCount: Integer;
     Function GetRowNode(Const aRow: Integer): TDomNode;
   Public
     //** Ссылка к документу, содержащему эту таблицу
     Property ODT: BODTClass Read bODT;
     //** Имя таблицы
     Property TableName: String Read bTableName;
     //** Количество строк в таблице
     Property RowCount: Integer Read GetRowCount;
 
     //** Копирует строку
     Procedure MultiplyRow(Const aRow, aCount: Integer);
     //** Удаляет последнюю строку
     Procedure RemoveRow;
     //** Объединяет ячейки в строке
     Procedure SetCellColSpan(Const aCol, aRow: Integer;
       Const aColSpan: Integer);
-    //** Устанавливает значение в ячейке. Опционально позволяет указать стиль
+    //** Устанавливает значение в ячейке. Также позволяет указать стиль текста
-    //** текста
+
       Const aStyleName: String = '');
     //** Сокращение для присвоения ячейке значения по маске (вызывает format)
     Procedure SetCellValue(Const aCol, aRow: Integer; Const aValueMask: String;
       Const aParams: Array Of Const; Const aStyleName: String = '');
     //** Сокращение для присвоения ячейке числового значения
     Procedure SetCellValue(Const aCol, aRow: Integer; Const aValue: Integer;
       Const aStyleName: String = '');
     //** Сокращение для присвоения ячейке логического значения
-    //** Сокращение для присвоения ячейке булева значения
+
       Const aTrueString, aFalseString: String; Const aStyleName: String = '');
 
     //** Удаляет таблицу из документа
     Procedure DeleteTable;
 
     Constructor Build(Const aODT: BODTClass; Const aTableName: String);
     Destructor Burn;
 End;
 
 Type
 
 { BODTClass }
 
  BODTClass = Class
   Private
     bContent: TXMLDocument;
     bManifest: TXMLDocument;
     bMeta: TXMLDocument;
     bSettings: TXMLDocument;
     bStyles: TXMLDocument;
     bStyleSheetFile: String;
     bTempDir: String;
     bXSLTProcPath: String;
   Public
     //** content.xml - содержимое документа
     Property Content: TXMLDocument Read bContent;
     //** META-INF/manifest.xml - содержимое всего архива
     Property Manifest: TXMLDocument Read bManifest;
     //** meta.xml - мета-данные (автор, дата генерации документа и т.д.)
     Property Meta: TXMLDocument read bMeta;
     //** Еще один файл в котором лежат общие настройки документа OpenOffice
-    //** meta.xml - мета-данные (автор, дата генерации документа, генератор и т.д.)
+
     //** styles.xml - стили текста, форматирования таблиц и т.д.
     Property Styles: TXMLDocument Read bStyles;
     //** Путь к файлу стилей для XSLT преобразования
     Property StyleSheetFile: String Read bStyleSheetFile Write bStyleSheetFile;
     //** Путь к исполняемому файлу xsltproc для XSLT преобразования
     Property XSLTProcPath: String Read bXSLTProcPath Write bXSLTProcPath;
 
 
     //** Создаёт документ
     Procedure GenerateDocument(Const aFileName: String);
     //** Создаёт HTML через xslt преобразование
     Procedure GenerateHTML(Const aFileName: String);
 
     //** Загружает шаблон
     Function LoadTemplate(Const aFileName: String): Boolean;
 
     //** Регистрирует стиль текста
     Procedure RegisterStyle(Const aName, aFontName: String;
       Const aFontSize: Integer; Const aFontStyle: TFontStyles;
       Const aTextPosition: TTextPosition);
 
     Constructor Build;
     Destructor Burn;
 End;
 
 Implementation
 
 ResourceString
   //Files names
   FILEcontentxml = 'content.xml';
   FILEstylesxml = 'styles.xml';
   {$IFDEF unix}
   FILEmanifestxml = 'META-INF/manifest.xml';
   {$ELSE}
   FILEmanifestxml = 'META-INF\manifest.xml';
   {$ENDIF}
   FILEmetaxml = 'meta.xml';
   FILEsettingsxml = 'settings.xml';
 
   //ODT Nodes names
   XMLTableTableRow = 'table:table-row';
   XMLTextStyleName = 'text:style-name';
   XMLTableNumberColumnsSpanned = 'table:number-columns-spanned';
   XMLTableTable = 'table:table';
   XMLTableName = 'table:name';
   XMLStyleStyle = 'style:style';
   XMLStyleName = 'style:name';
   XMLStyleFamily = 'style:family';
   XMLStyleParentStyleName = 'style:parent-style-name';
   XMLStyleTextProperties = 'style:text-properties';
   XMLFoFontSize = 'fo:font-size';
   XMLStyleFontName = 'style:font-name';
   XMLFoFontStyle = 'fo:font-style';
   XMLStyleFontStyleAsian = 'style:font-style-asian';
   XMLStyleFontStyleComplex = 'style:font-style-complex';
   XMLFoFontWeight = 'fo:font-weight';
   XMLStyleFontWeightAsian = 'style:font-weight-asian';
   XMLStyleFontWeightComplex = 'style:font-weight-complex';
   XMLStyleParagraphProperies = 'style:paragraph-properies';
   XMLFoTextAlign = 'fo:text-align';
   XMLStyleJustifySingleWord = 'style:justify-single-word';
   XMLOfficeAutomaticStyles = 'office:automatic-styles';
   XMLXmlVersion10EncodingUTF8 = '<?xml version=''1.0'' encoding=''UTF-8''?>';
   XMLOfficeDocumentXmlns = '<office:document '
     +'xmlns:office=''urn:oasis:names:tc:opendocument:xmlns:office:1.0''>';
 
   // Font names
   FontItalic = 'italic';
   FontBold = 'bold';
 
   //Errors messages
   ERRUnableFindCell = 'Unable find cell';
   ERRIllegalDOMStructure = 'Illegal DOM structure';
   ERRUnableFindAutomaticStylesNode = 'Unable find automatic-styles node';
   XMLOfficeDocument = '</office:document>';
   FILESinglefileXml = 'singlefile.xml';
 
 Const
   TTextPositionName: Array [1..4] Of String =
     ('center', 'start', 'end', 'justify');
 
 { BODTTableClass }
 
 Function BODTTableClass.GetRowNode(Const aRow: Integer): TDomNode;
 var
   i:integer;
   aNode: TDOMNode;
   aList: TDOMNodeList;
   aRowIndex: Integer = 0;
 begin
   Result := nil;
   aList := bRootNode.ChildNodes;
   For i := 0 To aList.Count - 1 Do
     If aList[i].NodeName = XMLTableTableRow Then
       Begin
         If aRowIndex = ARow Then
           Exit(aList[i]);
         aRowIndex += 1;
       End;
 End;
 
 Function BODTTableClass.GetRowCount: Integer;
 Var
   i: Integer;
   aNodes: TDOMNodeList;
 Begin
   Result := 0;
   aNodes := bRootNode.ChildNodes;
   For i := 0 To aNodes.Count - 1 Do
     If aNodes[i].NodeName = XMLTableTableRow Then
       Begin
         Inc(Result);
       End;
 end;
 
 Function BODTTableClass.GetCellNode(Const aCol, aRow: Integer): TDOMNode;
 Var
   aRowNode: TDomNode;
 Begin
   Result := nil;
   aRowNode := GetRowNode(aRow);
   If aRowNode = nil Then Exit;
   Result := aRowNode.ChildNodes[aCol].FirstChild;
 End;
 
 Procedure BODTTableClass.MultiplyRow(Const aRow, aCount: Integer);
 Var
   i: Integer;
   aNode, aClone: TDomNode;
 Begin
   For i := 0 to aCount - 1 Do
     Begin
       aNode := GetRowNode(aRow);
       aClone := aNode.CloneNode(TRUE);
       bRootNode.InsertBefore(aClone, aNode);
     End;
 End;
 
 Procedure BODTTableClass.RemoveRow;
 Begin
   bRootNode.RemoveChild(bRootNode.LastChild);
 End;
 
 Procedure BODTTableClass.SetCellValue(Const aCol, aRow: Integer;
   Const aValue: String; Const aStyleName: String);
 Var
   aCellNode: TDOMNode;
   aStyleNode: TDOMNode;
 Begin
   aCellNode := GetCellNode(aCol, aRow);
   If aCellNode = nil Then
     Raise Exception.Create(ERRUnableFindCell);
   aCellNode.TextContent := UTF8Decode(aValue);
   If Not(aStyleName = '') Then
     Begin
       aStyleNode := aCellNode.Attributes.GetNamedItem(XMLTextStyleName);
       If Not(aStyleNode = nil) Then
         aStyleNode.NodeValue := aStyleName;
     End;
 End;
 
 Procedure BODTTableClass.SetCellColSpan(Const aCol, aRow: Integer;
   Const aColSpan: Integer);
 Var
   i: Integer;
   aNode: TDOMNode;
   aSpanNode: TDOMNode;
 Begin
   aNode := GetCellNode(aCol, aRow).ParentNode;
   If aNode = nil Then
     Raise Exception.Create(ERRIllegalDOMStructure);
 
   aSpanNode := aNode.Attributes.GetNamedItem(XMLTableNumberColumnsSpanned);
   If aSpanNode = nil Then
     Begin
       aSpanNode := bODT.Content.CreateAttribute(XMLTableNumberColumnsSpanned);
       aNode.Attributes.SetNamedItem(aSpanNode);
     End;
 
   aSpanNode.NodeValue := IntToStr(aColSpan);
   For i := 1 To aColSpan - 1 Do
     aNode.ParentNode.RemoveChild(aNode.NextSibling);
 End;
 
 Procedure BODTTableClass.SetCellValue(Const aCol, aRow: Integer;
   Const aValueMask: String; Const aParams: Array Of Const;
   Const aStyleName: String);
 Begin
   SetCellValue(aCol, aRow, Format(aValueMask, aParams), aStyleName);
 End;
 
 Procedure BODTTableClass.SetCellValue(Const aCol, aRow: Integer;
   Const aValue: Integer; Const aStyleName: String);
 Begin
   SetCellValue(aCol, aRow, IntToStr(aValue), aStyleName);
 End;
 
 Procedure BODTTableClass.SetCellValue(Const aCol, aRow: Integer;
   Const aValue: Boolean; Const aTrueString, aFalseString: String;
   Const aStyleName: String);
 Begin
   SetCellValue(aCol, aRow, BoolToStr(aValue, aTrueString, aFalseString),
     aStyleName);
 End;
 
 Procedure BODTTableClass.DeleteTable;
 Begin
   bRootNode.Free;
 End;
 
 Constructor BODTTableClass.Build(Const aODT: BODTClass;
   Const aTableName: String);
 Var
   aNodes: TDOMNodeList;
   i: Integer;
 Begin
   bODT := aODT;
   bTableName := aTableName;
   aNodes := ODT.Content.DocumentElement.GetElementsByTagName(XMLTableTable);
   For i := 0 To aNodes.Count - 1 Do
     If aNodes[i].Attributes.GetNamedItem(XMLTableName).NodeValue=aTableName Then
       Begin
         bRootNode := aNodes[i];
         Break;
       End;
   aNodes.Free;
 End;
 
 Destructor BODTTableClass.Burn;
 Begin
   bTableName := '';
 End;
 
 { BODTClass }
 
 Procedure BODTClass.RegisterStyle(Const aName, aFontName: String;
   Const aFontSize: Integer; Const aFontStyle: TFontStyles;
   Const aTextPosition: TTextPosition);
 Const
   MASK_POINTER = '%dpt';
   STR_PARAGRAPH = 'paragraph';
   STR_STANDART = 'Standart';
 Var
   i: Integer;
   aNode, aFontNode, aParagraphNode: TDOMElement;
   aFontStyles: TStringList;
   aStyles: TDOMNodeList;
 Begin
   aNode := bContent.CreateElement(XMLStyleStyle);
   aNode.SetAttribute(XMLStyleName, aName);
   aNode.SetAttribute(XMLStyleFamily, STR_PARAGRAPH);
   aNode.SetAttribute(XMLStyleParentStyleName, STR_STANDART);
 
   aFontNode := bContent.CreateElement(XMLStyleTextProperties);
   aFontNode.SetAttribute(XMLFoFontSize, Format(MASK_POINTER, [aFontSize]));
   aFontNode.SetAttribute(XMLStyleFontName, aFontName);
   If ftItalic In aFontStyle Then
     Begin
       aFontNode.SetAttribute(XMLFoFontStyle, FontItalic);
       aFontNode.SetAttribute(XMLStyleFontStyleAsian, FontItalic);
       aFontNode.SetAttribute(XMLStyleFontStyleComplex, FontItalic);
     End;
   If ftBold In aFontStyle Then
     Begin
       aFontNode.SetAttribute(XMLFoFontWeight, FontBold);
       aFontNode.SetAttribute(XMLStyleFontWeightAsian, FontBold);
       aFontNode.SetAttribute(XMLStyleFontWeightComplex, FontBold);
     End;
   aParagraphNode := bContent.CreateElement(XMLStyleParagraphProperies);
   aParagraphNode.SetAttribute(XMLFoTextAlign,
     TTextPositionName[Integer(aTextPosition)]);
   aParagraphNode.SetAttribute(XMLStyleJustifySingleWord, BoolToStr(FALSE));
 
   aFontNode.AppendChild(aParagraphNode);
   aNode.AppendChild(aFontNode);
 
   aStyles := bContent.GetElementsByTagName(XMLOfficeAutomaticStyles);
   Try
     If aStyles.Count = 1 Then
       aStyles[0].AppendChild(aNode)
     Else
       Raise Exception.Create(ERRUnableFindAutomaticStylesNode);
   Finally
     aStyles.Free;
   End;
 End;
 
 Function BODTClass.LoadTemplate(Const aFileName: String): Boolean;
 Var
   aUnZipper: TUnZipper;
 Begin
   Result := FALSE;
   aUnZipper := TUnZipper.Create;
   Try
     aUnZipper.OutputPath := bTempDir;
     aUnZipper.UnZipAllFiles(aFileName);
 
     ReadXMLFile(bStyles, bTempDir + FILEstylesxml);
     ReadXMLFile(bContent, bTempDir + FILEcontentxml);
     ReadXMLFile(bManifest, bTempDir + FILEmanifestxml);
     ReadXMLFile(bMeta, bTempDir + FILEmetaxml);
     ReadXMLFile(bSettings, bTempDir + FILEsettingsxml);
 
   Finally
     aUnZipper.Free;
   End;
   Result := TRUE;
 End;
 
 Procedure BODTClass.GenerateDocument(Const aFileName: String);
 Var
   aZipper: TZipper;
   aStringList: TStringList;
   i: Integer;
   aBuffer: String;
   Procedure AddEntries(Const aDir:string; Const aFilesList: TStringList);
   Const
     STR_DOT = '.';
     STR_DOUBLE_DOT = '..';
   Var
     aSearchRec: TSearchRec;
     aResult: integer;
     aBuffer: String;
   Begin
     aResult := FindFirst(aDir+'*', faAnyFile, aSearchRec);
     While aResult = 0 Do
       Begin
         If Not((aSearchRec.Name = STR_DOT) Or
           (aSearchRec.Name = STR_DOUBLE_DOT)) Then
           Begin
             If (aSearchRec.Attr And faDirectory > 0) Then
               Begin
                 aFilesList.Add(aDir +  aSearchRec.Name + '/');
                 AddEntries(aDir + aSearchRec.Name + PathDelim, aFilesList)
               End
             Else
               aFilesList.Add(aDir +  aSearchRec.Name);
           End;
         aResult := FindNext(aSearchRec);
       End;
     FindClose(aSearchRec);
   End;
 Begin
   aZipper := TZipper.Create;
   aStringList := TStringList.Create;
   Try
     WriteXMLFile(bContent, bTempDir + FILEcontentxml);
     WriteXMLFile(bStyles, bTempDir + FILEstylesxml);
     WriteXMLFile(bMeta, bTempDir + FILEmetaxml);
     WriteXMLFile(bSettings, bTempDir + FILEsettingsxml);
     WriteXMLFile(bManifest, bTempDir + FILEmanifestxml);
 
     aZipper.FileName := aFileName;
     AddEntries(bTempDir, aStringList);
     For i := 0 To aStringList.Count - 1 Do
       Begin
         aBuffer := aStringList[i];
         Delete(aBuffer, 1, Length(bTempDir));
         aZipper.Entries.AddFileEntry(aStringList[i], aBuffer);
       End;
     aZipper.ZipAllFiles;
   Finally
     aStringList.Free;
     aZipper.Free;
   End;
 End;
 
 Procedure BODTClass.GenerateHTML(Const aFileName: String);
 Const
   XSLT_BIN_MASK = '%sxsltproc -o "%s" "%s" "%s"';
 Var
   i: Integer;
   aBuffer: TStringList;
   aSingleFile: TFileStream;
   Procedure WriteString(Const aString: String; Const aForce: Boolean = FALSE);
   Const
     STR_XML = '<?xml';
     STR_005pt = '0.05pt';
     STR_1px = '1px';
     STR_BORDER = 'border';
   Var
     aBuffer: String;
   Begin
     If Not((Pos(STR_XML, aString) = 0) Or aForce) Then Exit;
     // dirty workarounds for clean HTML view
     If Pos(STR_BORDER, aString) > 0 Then
       Begin
         aBuffer := StringReplace(aString, STR_005pt, STR_1px, [rfReplaceAll]);
         aSingleFile.Write(PChar(aBuffer)[0],Length(aBuffer));
         Exit;
       End;
     aSingleFile.Write(PChar(aString)[0],Length(aString));
   End;
 Begin
   WriteXMLFile(bMeta, bTempDir + FILEmetaxml);
   WriteXMLFile(bContent, bTempDir + FILEcontentxml);
   WriteXMLFile(bStyles, bTempDir + FILEstylesxml);
 
   aSingleFile := TFileStream.Create(bTempDir + FILESinglefileXml,
     fmCreate Or fmOpenReadWrite);
   WriteString(XMLXmlVersion10EncodingUTF8, TRUE);
   WriteString(XMLOfficeDocumentXmlns);
 
   aBuffer := TStringList.Create;
   aBuffer.LoadFromFile(bTempDir + FILEmetaxml);
   For i := 0 To aBuffer.Count - 1 Do
     WriteString(aBuffer[i]);
   aBuffer.LoadFromFile(bTempDir + FILEcontentxml);
   For i := 0 To aBuffer.Count - 1 Do
     WriteString(aBuffer[i]);
   aBuffer.LoadFromFile(bTempDir + FILEstylesxml);
   For i := 0 To aBuffer.Count - 1 Do
     WriteString(aBuffer[i]);
   aBuffer.Free;
   WriteString(XMLOfficeDocument);
   aSingleFile.Free;
 
   {$ifdef unix}
   fpSystem(Format(XSLT_BIN_MASK, [XSLTProcPath, aFileName, StyleSheetFile,
     bTempDir + FILESinglefileXml]));
   {$else}
   WinExec(Format(XSLT_BIN_MASK, [XSLTProcPath, aFileName, StyleSheetFile,
     bTempDir + File]), SW_HIDE);
   {$endif}
 End;
 
 Constructor BODTClass.Build;
 Begin
   bTempDir := GetTempDir(FALSE) + IntToStr(Random(MaxInt)) + PathDelim;
 End;
 
 Destructor BODTClass.Burn;
 Const
   {$ifdef unix}
     PROG_REMOVER_MASK = 'rm -r "%s"';
   {$else}
     PROG_REMOVER_MASK = 'rmdir /S /Q "%s"';
   {$endif}
 Begin
   //dirty workaround
   {$ifdef unix}
   fpSystem(Format(PROG_REMOVER_MASK, [bTempDir]));
   {$else}
   WinExec(Format(PROG_REMOVER_MASK, [bTempDir]), SW_HIDE);
   {$endif}
 
   bContent.Free;
   bStyles.Free;
   bMeta.Free;
   bSettings.Free;
   bManifest.Free;
 End;
 
 End.