Еще один блог о Delphi: XML Spreadsheet, Delphi, RTTI...

Как уже все знают, в Delphi 2010 механизм RTTI претерпел значительные изменения, став еще более простым в применении. Я же постараюсь показать на примере, как можно, используя обновленный RTTI, включить в собственное приложение поддержку форматов файлов, основанных на XML.

В качестве объекта для экспериментов выберем SpreadsheetML.

SpreadsheetML - основанный на XML язык разметки, разработанный Microsoft для представления табличных данных в Excel. Используется во всех версиях MS Excel, начиная с MS Excel 2002. SpreadsheetML может быть использован когда:

ваше приложение должно обмениваться данными с мобильными устройствами;
ваше приложение должно уметь создавать XML-документы для передачи на дльнейшую обработку другим приложениям, в том числе и работающих на других платформах;
вам необходимо избегать использования COM;
вам необходимо открывать файлы текстовым редактором для их последующего анализа.

Содержимое типичного SML-файла выглядит так:

Посмотреть код

<workbook xmlns:html="http://www.w3.org/TR/REC-html40" xmlns:o="urn:schemas-microsoft-com:office:office" xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet" xmlns:x="urn:schemas-microsoft-com:office:excel" xmlns="urn:schemas-microsoft-com:office:spreadsheet">
  <documentproperties xmlns="urn:schemas-microsoft-com:office:office">
    <author>Bill Gates</author>
    <lastauthor>Bill Gates</lastauthor>
    <company>Microsoft</company>
    <version>12.00</version>
    <created>2013-07-12T02:43:10Z</created>
  </documentproperties>
  <styles>
    <style ss:id="Default" ss:name="Normal">
      <alignment ss:Horizontal="Left" ss:Vertical="Center"/>
      <font ss:FontName="Arial" ss:Color="#080000"/>
    </style>
    <style ss:id="s:title">
      <alignment ss:Horizontal="Center"/>
      <font ss:FontName="Arial" ss:Bold="1" ss:Color="#0000FF"/>
      <interior ss:Color="#C0C0C0"/>
    </style>
    <style ss:id="s:cell">
      <font ss:FontName="Arial" ss:Color="#080000" ss:Size="8"/>
    </style>
    <style ss:id="cell:GeneralNumber" ss:parent="s:cell">
      <font ss:FontName="Arial" ss:Color="#080000" ss:Size="8"/>
      <numberformat ss:Format="General Number"/>
    </style>
    <style ss:id="cell:Currency" ss:parent="s:cell">
      <font ss:FontName="Arial" ss:Color="#080000" ss:Size="8"/>
      <numberformat ss:Format="Currency"/>
    </style>
  </styles>
  <worksheet ss:name="Page 1">
    <table ss:expandedcolumncount="7" ss:expandedrowcount="2" x:fullcolumns="1" x:fullrows="1">
      <column ss:autofitwidth="1" ss:index="1">
      <column ss:autofitwidth="1" ss:index="2">
      <column ss:autofitwidth="1" ss:index="3">
      <column ss:autofitwidth="1" ss:index="4">
      <column ss:autofitwidth="1" ss:index="5">
      <column ss:autofitwidth="1" ss:index="6">
      <column ss:autofitwidth="1" ss:index="7">
      <row ss:autofitheight="0" ss:index="1">
        <cell ss:index="1" ss:styleid="s:title">
          <data ss:type="String">Column 1</data>
        </cell>
        <cell ss:index="2" ss:styleid="s:title">
          <data ss:type="String">Column 2</data>
        </cell>
        <cell ss:index="3" ss:styleid="s:title">
          <data ss:type="String">Column 3</data>
        </cell>
        <cell ss:index="4" ss:styleid="s:title">
          <data ss:type="String">Column 4</data>
        </cell>
        <cell ss:index="5" ss:styleid="s:title">
          <data ss:type="String">Column 5</data>
        </cell>
        <cell ss:index="6" ss:styleid="s:title">
          <data ss:type="String">Column 6</data>
        </cell>
        <cell ss:index="7" ss:styleid="s:title">
          <data ss:type="String">Column 7</data>
        </cell>
      </row>
      <row ss:autofitheight="0" ss:index="2">
        <cell ss:index="1" ss:styleid="s:cell">
          <data ss:type="String">Cell Value</data>
        </cell>
        <cell ss:index="2" ss:styleid="s:cell">
          <data ss:type="String">Cell Value</data>
        </cell>
        <cell ss:index="3" ss:styleid="s:cell">
          <data ss:type="String">Cell Value</data>
        </cell>
        <cell ss:index="4" ss:styleid="cell:GeneralNumber">
          <data ss:type="String">75</data>
        </cell>
        <cell ss:index="5" ss:styleid="s:cell">
          <data ss:type="String">Cell Value</data>
        </cell>
        <cell ss:index="6" ss:styleid="s:cell">
          <data ss:type="String">Cell Value</data>
        </cell>
        <cell ss:index="7" ss:styleid="cell:Currency">
          <data ss:type="String">7300.00</data>
        </cell>
      </row>    
    </table>
  </worksheet>
</workbook>

Очевидно, что и сам файл, и отдельные его части можно представить в виде объектов, а задача сводится к их сериализации в нужный нам формат текстового файла. Итак, SML-файл должен содержать:

коллекцию стилей ячеек (коллекция объектов "Стиль");
коллекцию листов (worksheets) рабочей книги (коллекция объектов "Лист").

Значения свойств указанных объектов могут быть записаны в файл как значения XML-атрибутов и как значения XML-узлов. К тому же нам необходимо будет указать и соответствующие свойствам имена XML-узлов (XML-атрибутов). Для этого опишем атрибуты

Посмотреть код

TSMLTag = class(TCustomAttribute)
  strict private
    FName: string;
  public
    constructor Create(const AName: string); virtual;

    /// 
    ///   Имя SpreadsheetML-тэга
    /// 
    property Name: string read FName write FName;
  end;

  TSMLAttribute = class(TSMLTag);

  TSMLTagValue = class(TCustomAttribute);

  TSMLEnumValue = class(TSMLTag);

  TSMLTagNamespace = class(TSMLTag)
  strict private
    FSchemaUrl: string;
  public
    /// <summary>
    ///   Конструктор класса
    /// </summary>
    /// <param name="AName">
    ///   Имя пространства имен
    /// </param>
    /// <param name="ASchemaUrl">
    ///   Ссылка на DTD-опеределение пространства имен
    /// </param>
    constructor Create(const AName, ASchemaUrl: string); reintroduce;

    /// <summary>
    ///   Ссылка на DTD-опеределение пространства имен
    /// </summary>
    property SchemaUrl: string read FSchemaUrl write FSchemaUrl;
  end;

Атрибут TSMLTag соответствует узлу SpreadsheetML-документа, имеющему дочерние узлы, т.е. фактически соответствует объекту. Атрибут TSMLAttribute соответствует свойству объекта, значение которого должно записываться в виде значения XML-атрибута. И, наконец, атрибут TSMLTagValue будет соответствовать свойству объекта, значение которого запишется как значение XML-узла.

Дополнительно мы описали атрибуты TSMLTagNamespace для описания пространства имен XML-узла и TSMLEnumValue для хранения допустимых значений перечислимых типов. Теперь приступим к написанию кода классов, экземпляры которых и составят стройное здание SpreadsheetML-документа. Создадим класс, описывающий сам документ:

Посмотреть код

  [TSMLTag('Workbook')]
  [TSMLTagNamespace('xmlns', 'urn:schemas-microsoft-com:office:spreadsheet')]
  [TSMLTagNamespace('xmlns:o', 'urn:schemas-microsoft-com:office:office')]
  [TSMLTagNamespace('xmlns:x', 'urn:schemas-microsoft-com:office:excel')]
  [TSMLTagNamespace('xmlns:ss', 'urn:schemas-microsoft-com:office:spreadsheet')]
  [TSMLTagNamespace('xmlns:html', 'http://www.w3.org/TR/REC-html40')]
  TSimpleSpreadsheet = class(TObjectList<TSMLWorksheet>)
  strict private
    ...
  private
    ...
  protected
    function ObjectAsNode(AXml: TNativeXml; AParent: TXmlNode; AObject: TObject;
      AObjectClass: TClass): TXmlNode; virtual;
  public
    constructor Create; reintroduce;
    destructor Destroy; override;

    procedure SaveToFile(const AFilename: string); virtual;
    procedure SaveToStream(AStream: TStream); virtual;

    function NewStyle(const ID: string): TSMLStyle;
    function NewWorksheet(const AName: string): TSMLWorksheet;

    procedure DeleteWorksheet(const AName: string);
    function WorksheetExists(const AName: string): Boolean;

    [RefAttribute]
    property DocumentProperties: TDocumentProperties read FDocProps;

    [RefAttribute]
    property Styles: TSMLStyles read FStyles;

    property Worksheet[AName: string]: TSMLWorksheet read GetWorksheet;
    property Style[ID: string]: TSMLStyle read GetStyle;
  end;

По приведенному коду видно, что корневым элементом документа будет XML-узел с именем Workbook, и для этого узла указаны 5 пространств имен. Сам документ является коллекцией объектов "Лист" (TSMLWorksheet). Значения свойств класса TSimpleSpreadsheet, отмеченных атрибутами-наследниками TCustomAttribute, записываются в файл.

"Сердцем" (или "мозгом", если угодно) является метод ObjectAsNode, который и представляет экземпляр класса TSimpleSpreadsheet в виде корневого узла документа, основываясь на RTTI и описанных нами выше атрибутах. Вызывая, если необходимо - рекурсивно, вложенную процедуру _SerializeObject, метод обходит все свойства экземпляра класса TSimpleSpreadsheet и "вложенных" в него объектов, составляющих документ, и создает иерархию XML-узлов, сохраняя значения свойств в эти узлы и их атрибуты.

Посмотреть код

function TSimpleSpreadsheet.ObjectAsNode(AXml: TNativeXml; AParent: TXmlNode;
  AObject: TObject; AObjectClass: TClass): TXmlNode;
var
  RttiCtx: TRttiContext;
  ...
  function _SerializeObject(ANextParent: TXmlNode; NextObject: TObject;
    NextObjectClass: TClass): TXmlNode;
  var
    Value: TValue;
    RttiType: TRttiType;
    Method: TRttiMethod;
    PropInfo: PPropInfo;
    i, ListCount: Integer;
    Tag, StrValue: string;
    Attr: TCustomAttribute;
    RttiProp: TRttiProperty;
    EncodeFlags: TSMLChunkFlags;
    PropNode: TXmlNode;
  begin
    if not Assigned(NextObject) then Exit(nil);

    Tag := GetClassTagName(NextObjectClass);
    if Tag = EmptyStr then Exit(nil);

    if Assigned(ANextParent) then
      Result := ANextParent.NodeNew(Tag)
    else
      Result := AXml.NodeNew(Tag);

    EncodeFlags := [];

    if NextObject is TCustomSpreadsheetChunk then
      EncodeFlags := TCustomSpreadsheetChunk(NextObject).Flags;

    RttiType := RttiCtx.GetType(NextObjectClass);

    for Attr in RttiType.GetAttributes do
    begin
      if Attr is TSMLTagNamespace then
        Result.AttributeAdd(TSMLTagNamespace(Attr).Name,
          TSMLTagNamespace(Attr).SchemaUrl);
    end;

    for RttiProp in RttiType.GetProperties do
    begin
      StrValue := EmptyStr;
      PropInfo := TRttiInstanceProperty(RttiProp).PropInfo;

      for Attr in RttiProp.GetAttributes do
      begin
        Value := RttiProp.GetValue(NextObject);

        if Value.IsObject then
          _SerializeObject(Result, Value.AsObject, Value.TypeData^.ClassType)
        else
        begin
          if System.TypInfo.IsStoredProp(NextObject, PropInfo) then
          begin
            StrValue := ValueToString(Value, EncodeFlags);

            if Attr is TSMLAttribute then
            begin
              if StrValue <> EmptyStr then
                Result.AttributeAdd(TSMLAttribute(Attr).Name, StrValue);
            end
            else
            begin
              if Attr is TSMLTag then
              begin
                if StrValue <> EmptyStr then
                begin
                  PropNode := Result.NodeNew(TSMLTag(Attr).Name);
                  PropNode.Value := StrValue;
                end;
              end
              else
              begin
                if Attr is TSMLTagValue then
                  Result.Value := StrValue;
              end;
            end;
          end;
        end;
      end;
    end;

    Method := RttiType.GetMethod('ToArray');

    if Assigned(Method) then
    begin
      Value := Method.Invoke(NextObject, []);

      if Value.IsArray then
      begin
        ListCount := Value.GetArrayLength;

        for i := 0 to ListCount - 1 do
          _SerializeObject(Result, Value.GetArrayElement(i).AsObject,
            Value.GetArrayElement(i).TypeData^.ClassType);
      end;
    end;
  end;

begin
  RttiCtx := TRttiContext.Create;
  try
    Result := _SerializeObject(AParent, AObject, AObjectClass);
  finally
    RttiCtx.Free;
  end;
end;

Дальше открываем XML Spreadsheet Reference, и описываем классы, соответствующие остальным узлам документа, обязательно указывая необходимые RTTI-атрибуты:

TDocumentProperties - свойства документа (автор, дата создания и т.п.);
TSMLStyleAlignment - выравнивание текста внутри ячейки;
TSMLBorder, TSMLBorders - границы ячейки;
TSMLFont - шрифт текста в ячейке;
TSMLInterior - заливка ячейки;
TSMLNumberFormat - формат текста в ячейке;
TSMLStyle - стиль ячейки (выравнивание и формат текста, шрифт, заливка, границы...);
TSMLTableColumn, TSMLTableRow - колонка и строка таблицы;
TSMLTableCell - ячейка таблицы;
TSMLTable - таблица
и, наконец, TSMLWorksheet - лист рабочей книги.

Осталось только привести пример создания документа. В начале создаем экземпляр TSimpleSpreadsheet:

Sml := TSimpleSpreadsheet.Create();

Затем создаем стиль, который будет использоваться по умолчанию для всех ячеек (стиль обязательно должен называться "Default"):

Style := Sml.Styles.NewStyle('Default');
Style.Name := 'Normal';
Style.Alignment.Horizontal := TSMLTextAlignment.taLeft;
Style.Alignment.Vertical := TSMLTextAlignment.taCenter;

Аналогично можно указать и еще несколько стилей. Стили могут наследовать свойства от других стилей. Для этого в свойстве Style.ParentStyle укажите имя стиля, от которого необходимо наследовать. Если указанное свойство пусто, то стиль наследует от стиля Default.

Style := Sml.Styles.NewStyle('cell');
Style.ParentStyle := 'Default';
Style.Font.Bold := True;

Теперь создадим рабочую книгу:

Worksheet := Sml.NewWorksheet('Лист');

Заполняем ячейки

for Column := 1 to 3 do
begin
  for Row := 1 to 10 do
  begin
    Cell := Worksheet.Cell[Row, Column];
    Cell.Value := Format('%d:%d', [Row, Column]);
    Cell.StyleID := 'cell';
  end; 
end;

Не обязательно указывать стиль для каждой ячейки. Например, вам необходимо, чтобы все ячейки одной колонки использовали одинаковый стиль. В этом случае наш пример с заполнением ячеек станет таким:

for Column := 1 to 3 do
begin
  for Row := 1 to 10 do
  begin
    Cell := Worksheet.Cell[Row, Column];
    Cell.Value := Format('%d:%d', [Row, Column]);
  end; 
end;

Col := Worksheet.Column[1];
Col.StyleID := 'column';

Естественно, стиль column должен быть определен заранее. Теперь сохраняем полученный документ в файл

Sml.SaveToFile('spreadsheet.xml');

и удаляем объект.

И, под занавес, ссылки:

Dive into SpreadsheetML
XML Spreadsheet Reference
SpreadsheetML.pas (необходима библиотека NativeXML)
DatasetHelper.pas - демонстрация сохранения набора данных в файлы CSV и XML Spreadsheet

Еще один блог о Delphi

18 июл. 2013 г.

XML Spreadsheet, Delphi, RTTI...

Комментариев нет:

Отправить комментарий

18 июл. 2013 г.

XML Spreadsheet, Delphi, RTTI...

Комментариев нет:

Отправить комментарий

18 июл. 2013 г.