fpspreadsheet: Add worksheet-BiDiMode. Read/write for Excel5, Excel8, xlsx, ods.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4474 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2016-01-26 11:26:57 +00:00
parent 85dd9bc35d
commit aa29b42ebc
7 changed files with 147 additions and 20 deletions
--- a/components/fpspreadsheet/fpsopendocument.pas
+++ b/components/fpspreadsheet/fpsopendocument.pas
@@ -82,6 +82,7 @@ type

  TsSpreadOpenDocReader = class(TsSpreadXMLReader)
  private
+    FTableStyleList: TFPList;
    FColumnStyleList: TFPList;
    FColumnList: TFPList;
    FRowStyleList: TFPList;
@@ -95,6 +96,7 @@ type
    FRichTextFontList: TFPList;
    procedure ApplyColWidths;
    function ApplyStyleToCell(ACell: PCell; AStyleName: String): Boolean;
+    function ApplyTableStyle(ASheet: TsWorksheet; AStyleName: String): Boolean;
    function ExtractBoolFromNode(ANode: TDOMNode): Boolean;
    function ExtractDateTimeFromNode(ANode: TDOMNode;
      ANumFormat: TsNumberFormat; const AFormatStr: String): TDateTime;
@@ -103,6 +105,7 @@ type
    function FindColStyleByName(AStyleName: String): integer;
    function FindNumFormatByName(ANumFmtName: String): Integer;
    function FindRowStyleByName(AStyleName: String): Integer;
+    function FindTableStyleByName(AStyleName: String): Integer;
    procedure ReadColumns(ATableNode: TDOMNode);
    procedure ReadColumnStyle(AStyleNode: TDOMNode);
    procedure ReadDateMode(SpreadSheetNode: TDOMNode);
@@ -117,6 +120,7 @@ type
    function ReadHeaderFooterText(ANode: TDOMNode): String;
    procedure ReadRowsAndCells(ATableNode: TDOMNode);
    procedure ReadRowStyle(AStyleNode: TDOMNode);
+    procedure ReadTableStyle(AStyleNode: TDOMNode);

  protected
    FPointSeparatorSettings: TFormatSettings;
@@ -312,6 +316,13 @@ const

 type

+  { Table style items stored in TableStyleList of the reader }
+  TTableStyleData = class
+  public
+    Name: String;
+    BiDiMode: TsBiDiMode;
+  end;
+
  { Column style items stored in ColStyleList of the reader }
  TColumnStyleData = class
  public
@@ -911,6 +922,8 @@ begin

  FCellFormatList := TsCellFormatList.Create(true);
    // true = allow duplicates because style names used in cell records will not be found any more.
+
+  FTableStyleList := TFPList.Create;
  FColumnStyleList := TFPList.Create;
  FColumnList := TFPList.Create;
  FRowStyleList := TFPList.Create;
@@ -937,6 +950,9 @@ begin
  for j := FColumnList.Count-1 downto 0 do TObject(FColumnList[j]).Free;
  FColumnList.Free;

+  for j := FTableStyleList.Count-1 downto 0 do TObject(FTableStyleList[j]).Free;
+  FTableStyleList.Free;
+
  for j := FColumnStyleList.Count-1 downto 0 do TObject(FColumnStyleList[j]).Free;
  FColumnStyleList.Free;

@@ -1033,6 +1049,25 @@ begin
  Result := true;
 end;

+function TsSpreadOpenDocReader.ApplyTableStyle(ASheet: TsWorksheet;
+  AStyleName: String): Boolean;
+var
+  styleIndex: Integer;
+  tableStyle: TTableStyleData;
+begin
+  Result := false;
+  if (AStyleName = '') or (ASheet = nil) then
+    exit;
+  styleIndex := FindTableStyleByName(AStyleName);
+  if styleIndex = -1 then
+    exit;
+  tableStyle := TTableStyleData(FTableStyleList[styleIndex]);
+  if (tableStyle.BiDiMode = bdRTL) or (tableStyle.BiDiMode = bdLTR) then
+    ASheet.BiDiMode := tableStyle.BiDiMode;
+  Result := true;
+end;
+
+
 { Extracts a boolean value from a "boolean" cell node.
  Is called from ReadBoolean }
 function TsSpreadOpenDocReader.ExtractBoolFromNode(ANode: TDOMNode): Boolean;
@@ -1210,6 +1245,14 @@ begin
  Result := -1;
 end;

+function TsSpreadOpenDocReader.FindTableStyleByName(AStyleName: String): Integer;
+begin
+  for Result := 0 to FTableStyleList.Count-1 do
+    if TTableStyleData(FTableStyleList[Result]).Name = AStyleName then
+      exit;
+  Result := -1;
+end;
+
 procedure TsSpreadOpenDocReader.ReadAutomaticStyles(AStylesNode: TDOMNode);
 var
  nodeName: String;
@@ -2071,6 +2114,7 @@ var
  pageLayout: PsPageLayout;
  XMLStream: TStream;
  sheet: TsWorksheet;
+  tablestyleName: String;

  function CreateXMLStream: TStream;
  begin
@@ -2144,6 +2188,7 @@ begin
        continue;
      end;
      FWorkSheet := FWorkbook.AddWorksheet(GetAttrValue(TableNode, 'table:name'), true);
+      tablestyleName := GetAttrValue(TableNode, 'table:style-name');
      // Collect column styles used
      ReadColumns(TableNode);
      // Process each row inside the sheet and process each cell of the row
@@ -2152,6 +2197,8 @@ begin
      pageLayout := ReadPageLayout(StylesNode, GetAttrValue(TableNode, 'table:style-name'));
      if pageLayout <> nil then
        FWorksheet.PageLayout := pagelayout^;
+      // Apply table style
+      ApplyTableStyle(FWorksheet, tablestylename);
      // Handle columns and rows
      ApplyColWidths;
      // Page layout
@@ -3373,6 +3420,10 @@ begin
      family := GetAttrValue(styleNode, 'style:family');
      parentstyle := GetAttrValue(stylenode, 'style:parent-style-name');

+      // Table styles
+      if family = 'table' then
+        ReadTableStyle(styleNode);
+
      // Column styles
      if family = 'table-column' then
        ReadColumnStyle(styleNode);
@@ -3604,15 +3655,6 @@ begin
            fmt.FontIndex := fntIndex;
            Include(fmt.UsedFormattingFields, uffFont);
            FCellFormatList.Add(fmt);
-            {
-            fmt.FontIndex := FWorkbook.FindFont(fntName, fntSize, fntStyle, fntColor, fntPos);
-            if fmt.FontIndex = -1 then
-              fmt.FontIndex := FWorkbook.AddFont(fntName, fntSize, fntStyle, fntColor, fntPos);
-//            fmt.FontIndex := ReadFont(styleChildNode);
-            if fmt.FontIndex > 0 then
-              Include(fmt.UsedFormattingFields, uffFont);
-            FCellFormatList.Add(fmt);
-            }
          end;
          styleChildNode := stylechildNode.NextSibling;
        end;
@@ -3622,6 +3664,37 @@ begin
  end;
 end;

+procedure TsSpreadOpenDocReader.ReadTableStyle(AStyleNode: TDOMNode);
+var
+  stylename, nodename: String;
+  styleChildNode: TDOMNode;
+  bidi: String;
+  tablestyle: TTableStyleData;
+begin
+ // nodeName := GetAttrValue(AStyleNode, 'style:name');
+  stylename := GetAttrValue(AStyleNode, 'style:name');
+  styleChildNode := AStyleNode.FirstChild;
+
+  while Assigned(styleChildNode) do
+  begin
+    nodename := styleChildNode.NodeName;
+    if nodeName = 'style:table-properties' then
+    begin
+//      stylename := GetAttrValue(styleChildNode, 'style:name');
+      bidi := GetAttrValue(styleChildNode, 'style:writing-mode');
+    end;
+    styleChildNode := styleChildNode.NextSibling;
+  end;
+
+  if bidi = 'rl-tb' then
+  begin
+    tablestyle := TTableStyleData.Create;
+    tablestyle.Name := styleName;
+    tablestyle.BiDiMode := bdRTL;
+    FTableStyleList.Add(tablestyle);
+  end;
+end;
+

 { TsSpreadOpenDocWriter }

@@ -5457,15 +5530,22 @@ procedure TsSpreadOpenDocWriter.WriteTableStyles(AStream: TStream);
 var
  i: Integer;
  sheet: TsWorksheet;
+  bidi: String;
 begin
  for i:=0 to FWorkbook.GetWorksheetCount-1 do
  begin
    sheet := FWorkbook.GetWorksheetByIndex(i);
+    case sheet.BiDiMode of
+      bdDefault: bidi := '';
+      bdLTR    : bidi := 'style:writing-mode="lr-tb" ';
+      bdRTL    : bidi := 'style:writing-mode="rl-tb" ';
+    end;
    AppendToStream(AStream, Format(
      '<style:style style:name="ta%d" style:family="table" style:master-page-name="PageStyle_5f_%s">' +
-        '<style:table-properties table:display="true" style:writing-mode="lr-tb"/>' +
+        '<style:table-properties table:display="true" %s/>' +
      '</style:style>', [
-      i+1, sheet.Name
+      i+1, sheet.Name,
+      bidi
    ]));
  end;
 end;
--- a/components/fpspreadsheet/fpspreadsheet.pas
+++ b/components/fpspreadsheet/fpspreadsheet.pas
@@ -126,6 +126,7 @@ type
    FDefaultColWidth: Single;   // in "characters". Excel uses the width of char "0" in 1st font
    FDefaultRowHeight: Single;  // in "character heights", i.e. line count
    FSortParams: TsSortParams;  // Parameters of the current sorting operation
+    FBiDiMode: TsBiDiMode;
    FOnChangeCell: TsCellEvent;
    FOnChangeFont: TsCellEvent;
    FOnCompareCells: TsCellCompareEvent;
@@ -133,6 +134,7 @@ type

    { Setter/Getter }
    function GetFormatSettings: TFormatSettings;
+    procedure SetBiDiMode(AValue: TsBiDiMode);
    procedure SetName(const AName: String);

    { Callback procedures called when iterating through all cells }
@@ -520,6 +522,7 @@ type
    property DefaultRowHeight: Single read FDefaultRowHeight write FDefaultRowHeight;

    // These are properties to interface to TsWorksheetGrid
+    property BiDiMode: TsBiDiMode read FBiDiMode write SetBiDiMode;
    {@@ Parameters controlling visibility of grid lines and row/column headers,
        usage of frozen panes etc. }
    property  Options: TsSheetOptions read FOptions write FOptions;
@@ -3338,6 +3341,15 @@ begin
  FCells.DeleteCell(ARow, ACol);
 end;

+procedure TsWorksheet.SetBiDiMode(AValue: TsBiDiMode);
+begin
+  if AValue = FBiDiMode then
+    exit;
+  FBiDiMode := AValue;
+  if (FWorkbook.FLockCount = 0) and Assigned(FWorkbook.FOnChangeWorksheet) then
+    FWorkbook.FOnChangeWorksheet(FWorkbook, self);
+end;
+
 {@@ ----------------------------------------------------------------------------
  Setter for the worksheet name property. Checks if the name is valid, and
  exits without any change if not. Creates an event OnChangeWorksheet.
@@ -3349,7 +3361,7 @@ begin
  if (FWorkbook <> nil) then //and FWorkbook.ValidWorksheetName(AName) then
  begin
    FName := AName;
-    if (FWorkbook.FLockCount = 0) and Assigned(FWorkbook.FOnChangeWorksheet) then
+    if (FWorkbook.FLockCount = 0) and Assigned(FWorkbook.FOnRenameWorksheet) then
      FWorkbook.FOnRenameWorksheet(FWorkbook, self);
  end;
 end;
--- a/components/fpspreadsheet/fpspreadsheetgrid.pas
+++ b/components/fpspreadsheet/fpspreadsheetgrid.pas
@@ -557,6 +557,8 @@ type
    {@@ inherited from TCustomGrid. Select the option goEditing to make the grid editable! }
    property Options;
    //property ParentBiDiMode;
+    {@@ inherited from ancestors }
+    property ParentBiDiMode;
    {@@ inherited from ancestors}
    property ParentColor default false;
    {@@ inherited from ancestors}
@@ -3936,6 +3938,17 @@ begin
        FrozenCols := 0;
        FrozenRows := 0;
      end;
+      case Worksheet.BiDiMode of
+        bdDefault: ParentBiDiMode := true;
+        bdLTR    : begin
+                     ParentBiDiMode := false;
+                     BiDiMode := bdLeftToRight;
+                   end;
+        bdRTL    : begin
+                     ParentBiDiMode := false;
+                     BiDiMode := bdRightToLeft;
+                   end;
+      end;
      dec(FLockSetup);
    end;
    Setup;
--- a/components/fpspreadsheet/xlsbiff5.pas
+++ b/components/fpspreadsheet/xlsbiff5.pas
@@ -1558,6 +1558,8 @@ begin
    Options := Options or MASK_WINDOW2_OPTION_SHOW_SHEET_HEADERS;
  if (soHasFrozenPanes in ASheet.Options) and ((ASheet.LeftPaneWidth > 0) or (ASheet.TopPaneHeight > 0)) then
    Options := Options or MASK_WINDOW2_OPTION_PANES_ARE_FROZEN;
+  if (ASheet.BiDiMode = bdRTL) then
+    Options := Options or MASK_WINDOW2_OPTION_COLUMNS_RIGHT_TO_LEFT;
  if FWorkbook.ActiveWorksheet <> nil then
    actSheet := FWorkbook.ActiveWorksheet else
    actSheet := Fworkbook.GetWorksheetByIndex(0);
--- a/components/fpspreadsheet/xlsbiff8.pas
+++ b/components/fpspreadsheet/xlsbiff8.pas
@@ -3236,6 +3236,8 @@ begin
    actSheet := Fworkbook.GetWorksheetByIndex(0);
  if (ASheet = actSheet) then
    Options := Options or MASK_WINDOW2_OPTION_SHEET_ACTIVE or MASK_WINDOW2_OPTION_SHEET_SELECTED;
+  if (ASheet.BiDiMode = bdRTL) then
+    Options := Options or MASK_WINDOW2_OPTION_COLUMNS_RIGHT_TO_LEFT;
  AStream.WriteWord(WordToLE(Options));

  { Index to first visible row }
--- a/components/fpspreadsheet/xlscommon.pas
+++ b/components/fpspreadsheet/xlscommon.pas
@@ -2340,6 +2340,9 @@ begin

  if (flags and MASK_WINDOW2_OPTION_SHEET_ACTIVE <> 0) then
    FWorkbook.SelectWorksheet(FWorksheet);
+
+  if (flags AND MASK_WINDOW2_OPTION_COLUMNS_RIGHT_TO_LEFT <> 0) then
+    FWorksheet.BiDiMode := bdRTL;
 end;

 { Reads the workbook globals. }
--- a/components/fpspreadsheet/xlsxooxml.pas
+++ b/components/fpspreadsheet/xlsxooxml.pas
@@ -1757,10 +1757,17 @@ begin
      s := GetAttrValue(sheetViewNode, 'showGridLines');
      if s = '0' then
        AWorksheet.Options := AWorksheet.Options - [soShowGridLines];
+
      s := GetAttrValue(sheetViewNode, 'showRowColHeaders');
      if s = '0' then
         AWorksheet.Options := AWorksheet.Options - [soShowHeaders];

+      s := GetAttrValue(sheetViewNode, 'rightToLeft');
+      if s = '0' then
+        AWorksheet.BiDiMode := bdLTR
+      else if s = '1' then
+        AWorksheet.BiDiMode := bdRTL;
+
      childNode := sheetViewNode.FirstChild;
      while Assigned(childNode) do begin
        nodeName := childNode.NodeName;
@@ -2885,6 +2892,7 @@ var
  bottomRightCell: String;
  actCell: String;
  tabSel: String;
+  bidi: String;
 begin
  // Show gridlines ?
  showGridLines := StrUtils.IfThen(soShowGridLines in AWorksheet.Options, ' ', 'showGridLines="0" ');
@@ -2892,6 +2900,13 @@ begin
  // Show headers?
  showHeaders := StrUtils.IfThen(soShowHeaders in AWorksheet.Options, ' ', 'showRowColHeaders="0" ');

+  // BiDiMode
+  case AWorksheet.BiDiMode of
+    bdDefault: bidi := '';
+    bdLTR    : bidi := 'rightToLeft="0" ';
+    bdRTL    : bidi := 'rightToLeft="1" ';
+  end;
+
  // Active cell
  if (AWorksheet.ActiveCellRow <> cardinal(-1)) and (AWorksheet.ActiveCellCol <> cardinal(-1)) then
    actCell := GetCellString(AWorksheet.ActiveCellRow, AWorksheet.ActiveCellCol) else
@@ -2908,11 +2923,11 @@ begin
    if actCell = '' then actCell := 'A1';
    AppendToStream(AStream, Format(
      '<sheetViews>' +
-        '<sheetView workbookViewId="0" %s%s%s>' +
+        '<sheetView workbookViewId="0" %s%s%s%s>' +
          '<selection activeCell="%s" sqref="%s" />' +
        '</sheetView>' +
      '</sheetViews>', [
-      showGridLines, showHeaders, tabSel,
+      showGridLines, showHeaders, tabSel, bidi,
      actCell, actCell
    ]))
  end else
@@ -2926,14 +2941,14 @@ begin
        actCell := bottomRightcell;
      AppendToStream(AStream, Format(
        '<sheetViews>' +
-          '<sheetView workbookViewId="0" %s%s%s>'+
+          '<sheetView workbookViewId="0" %s%s%s%s>'+
            '<pane xSplit="%d" ySplit="%d" topLeftCell="%s" activePane="bottomRight" state="frozen" />' +
            '<selection pane="topRight" activeCell="%s" sqref="%s" />' +
            '<selection pane="bottomLeft" activeCell="%s" sqref="%s" />' +
            '<selection pane="bottomRight" activeCell="%s" sqref="%s" />' +
          '</sheetView>' +
        '</sheetViews>', [
-        showGridLines, showHeaders, tabSel,
+        showGridLines, showHeaders, tabSel, bidi,
        AWorksheet.LeftPaneWidth, AWorksheet.TopPaneHeight, bottomRightCell,
        topRightCell, topRightCell,
        bottomLeftCell, bottomLeftCell,
@@ -2946,12 +2961,12 @@ begin
        actCell := topRightCell;
      AppendToStream(AStream, Format(
        '<sheetViews>' +
-          '<sheetView workbookViewId="0" %s%s%s>'+
+          '<sheetView workbookViewId="0" %s%s%s%s>'+
            '<pane xSplit="%d" topLeftCell="%s" activePane="topRight" state="frozen" />' +
            '<selection pane="topRight" activeCell="%s" sqref="%s" />' +
          '</sheetView>' +
        '</sheetViews>', [
-        showGridLines, showHeaders, tabSel,
+        showGridLines, showHeaders, tabSel, bidi,
        AWorksheet.LeftPaneWidth, topRightCell,
        actCell, actCell
      ]))
@@ -2962,12 +2977,12 @@ begin
        actCell := bottomLeftCell;
      AppendToStream(AStream, Format(
        '<sheetViews>'+
-          '<sheetView workbookViewId="0" %s%s%s>'+
+          '<sheetView workbookViewId="0" %s%s%s%s>'+
             '<pane ySplit="%d" topLeftCell="%s" activePane="bottomLeft" state="frozen" />'+
             '<selection pane="bottomLeft" activeCell="%s" sqref="%s" />' +
          '</sheetView>'+
        '</sheetViews>', [
-        showGridLines, showHeaders, tabSel,
+        showGridLines, showHeaders, tabSel, bidi,
        AWorksheet.TopPaneHeight, bottomLeftCell,
        actCell, actCell
      ]));