fpspreadsheet: Extend wikitables writer to write cell alignment, text color, borders and merged cells.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3605 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/examples/wikitabledemo/wikitablewrite.lpr

@@ -42,10 +42,51 @@ begin
   // Write some cells
   MyWorksheet.WriteUTF8Text(0, 0, 'This is a text:');
   MyWorksheet.WriteUTF8Text(0, 1, 'Hello world!');
-  MyWorksheet.WriteUTF8Text(1, 0, 'This is a number:');
+
-  MyWorksheet.WriteNumber(1, 1, 3.141592);
+  MyWorksheet.WriteUTF8Text(1, 0, 'This is bold text:');
-  MyWorksheet.WriteUTF8Text(2, 0, 'This is a date:');
+  Myworksheet.WriteUTF8Text(1, 1, 'Hello world!');
-  Myworksheet.WriteDateTime(2, 1, date());
+  Myworksheet.WriteFontStyle(1, 1, [fssBold]);
+
+  MyWorksheet.WriteUTF8Text(2, 0, 'This is a number:');
+  MyWorksheet.WriteNumber(2, 1, 3.141592);
+  MyWorksheet.WriteBackgroundColor(2, 1, scMagenta);
+  Myworksheet.WriteHorAlignment(2, 1, haRight);
+
+  MyWorksheet.WriteUTF8Text(3, 0, 'This is a date:');
+  Myworksheet.WriteDateTime(3, 1, date());
+
+  MyWorksheet.WriteUTF8Text(4, 0, 'This is a long text:');
+  MyWorksheet.WriteUTF8Text(4, 1, 'A very, very, very, very long text, indeed');
+
+  MyWorksheet.WriteUTF8Text(5, 0, 'This is long text with line break:');
+  Myworksheet.WriteVertAlignment(5, 0, vaTop);
+
+  MyWorksheet.WriteUTF8Text(5, 1, 'A very, very, very, very long text,<br /> indeed');
+
+  MyWorksheet.WriteUTF8Text(6, 0, 'Merged rows');
+  Myworksheet.MergeCells(6, 0, 7, 0);
+  MyWorksheet.WriteUTF8Text(6, 1, 'A');
+  MyWorksheet.WriteUTF8Text(7, 1, 'B');
+
+  MyWorksheet.WriteUTF8Text(8, 0, 'Merged columns');
+  MyWorksheet.WriteHorAlignment(8, 0, haCenter);
+  MyWorksheet.MergeCells(8, 0, 8, 1);
+
+  MyWorksheet.WriteUTF8Text(10, 0, 'Right borders:');
+  MyWorksheet.WriteBorders(10, 0, [cbEast]);
+
+  MyWorksheet.WriteUTF8Text(10, 1, 'medium / blue');
+  MyWorksheet.WriteBorders(10, 1, [cbEast]);
+  MyWorksheet.WriteBorderLineStyle(10, 1, cbEast, lsMedium);
+  MyWorksheet.WriteBorderColor(10, 1, cbEast, scBlue);
+
+  MyWorksheet.WriteUTF8Text(11, 0, 'Top borders:');
+  MyWorksheet.WriteBorders(11, 0, [cbNorth]);
+  MyWorksheet.WriteBorderLineStyle(11, 0, cbNorth, lsDashed);
+
+  MyWorksheet.WriteUTF8Text(11, 1, '(dotted)');
+  MyWorksheet.WriteBorders(11, 1, [cbNorth]);
+  MyWorksheet.WriteBorderLineStyle(11, 1, cbNorth, lsDotted);
 
   // Save the spreadsheet to a file
   MyWorkbook.WriteToFile(MyDir + 'test.wikitable_wikimedia', sfWikitable_wikimedia);

components/fpspreadsheet/fpspreadsheet.pas

@@ -530,8 +530,10 @@ type
     { Reading of cell attributes }
     function GetNumberFormatAttributes(ACell: PCell; out ADecimals: Byte;
       out ACurrencySymbol: String): Boolean;
-    function  ReadUsedFormatting(ARow, ACol: Cardinal): TsUsedFormattingFields;
+    function  ReadUsedFormatting(ARow, ACol: Cardinal): TsUsedFormattingFields; overload;
-    function  ReadBackgroundColor(ARow, ACol: Cardinal): TsColor;
+    function  ReadUsedFormatting(ACell: PCell): TsUsedFormattingFields; overload;
+    function  ReadBackgroundColor(ARow, ACol: Cardinal): TsColor; overload;
+    function  ReadBackgroundColor(ACell: PCell): TsColor; overload;
 
     { Merged cells }
     procedure MergeCells(ARow1, ACol1, ARow2, ACol2: Cardinal); overload;
@@ -2671,17 +2673,26 @@ end;
   @return Set of elements used in formatting the cell
 -------------------------------------------------------------------------------}
 function TsWorksheet.ReadUsedFormatting(ARow, ACol: Cardinal): TsUsedFormattingFields;
-var
-  ACell: PCell;
 begin
-  ACell := FindCell(ARow, ACol);
+  Result := ReadUsedFormatting(FindCell(ARow, ACol));
+end;
 
+{@@ ----------------------------------------------------------------------------
+  Reads the set of used formatting fields of a cell.
+
+  Each cell contains a set of "used formatting fields". Formatting is applied
+  only if the corresponding element is contained in the set.
+
+  @param  ACell   Pointer to the cell
+  @return Set of elements used in formatting the cell
+-------------------------------------------------------------------------------}
+function TsWorksheet.ReadUsedFormatting(ACell: PCell): TsUsedFormattingFields;
+begin
   if ACell = nil then
   begin
     Result := [];
     Exit;
   end;
-
   Result := ACell^.UsedFormattingFields;
 end;
 
@@ -2693,14 +2704,21 @@ end;
   @return Index of the cell background color into the workbook's color palette
 -------------------------------------------------------------------------------}
 function TsWorksheet.ReadBackgroundColor(ARow, ACol: Cardinal): TsColor;
-var
-  ACell: PCell;
 begin
-  ACell := FindCell(ARow, ACol);
+  Result := ReadBackgroundColor(FindCell(ARow, ACol));
+end;
 
+{@@ ----------------------------------------------------------------------------
+  Returns the background color of a cell as index into the workbook's color palette.
+
+  @param  ACell  Pointer to the cell
+  @return Index of the cell background color into the workbook's color palette
+-------------------------------------------------------------------------------}
+function TsWorksheet.ReadBackgroundColor(ACell: PCell): TsColor;
+begin
   if ACell = nil then
   begin
-    Result := scWhite;
+    Result := scNotDefined;
     Exit;
   end;
 

components/fpspreadsheet/fpsutils.pas

@@ -136,6 +136,7 @@ function HTMLColorStrToColor(AValue: String): TsColorValue;
 function ColorToHTMLColorStr(AValue: TsColorValue; AExcelDialect: Boolean = false): String;
 function UTF8TextToXMLText(AText: ansistring): ansistring;
 function TintedColor(AColor: TsColorValue; tint: Double): TsColorValue;
+function HighContrastColor(AColorValue: TsColorValue): TsColor;
 
 function AnalyzeCompareStr(AString: String; out ACompareOp: TsCompareOperation): String;
 
@@ -2186,6 +2187,16 @@ begin
 end;
 
 
+{@@ Returns the color index for black or white depending on a color belng "bright"
+  or "dark". }
+function HighContrastColor(AColorValue: TsColorvalue): TsColor;
+begin
+  if TRGBA(AColorValue).r + TRGBA(AColorValue).g + TRGBA(AColorValue).b < 3*128 then
+    Result := scWhite
+  else
+    Result := scBlack;
+end;
+
 {$PUSH}{$HINTS OFF}
 {@@ Silence warnings due to an unused parameter }
 procedure Unused(const A1);

components/fpspreadsheet/wikitable.pas

@@ -373,55 +373,162 @@ Format mediawiki:
 |}
 *)
 procedure TsWikiTableWriter.WriteToStrings_WikiMedia(AStrings: TStrings);
+
+  function DoBorder(ABorder: TsCellBorder; ACell: PCell): String;
+  const
+    // (cbNorth, cbWest, cbEast, cbSouth, cbDiagUp, cbDiagDown)
+    BORDERNAMES: array[TsCellBorder] of string =
+      ('top', 'left', 'right', 'south', '', '');
+    // (lsThin, lsMedium, lsDashed, lsDotted, lsThick, lsDouble, lsHair)
+    LINESTYLES: array[TsLineStyle] of string =
+      ('1pt solid', 'medium', 'dahsed', 'dotted', 'thick', 'double', 'dashed');
+  var
+    ls: TsLineStyle;
+    clr: TsColor;
+  begin
+    ls := ACell^.BorderStyles[ABorder].LineStyle;
+    clr := ACell^.BorderStyles[ABorder].Color;
+    Result := Format('border-%s:%s', [BORDERNAMES[ABorder], LINESTYLES[ls]]);
+    if clr <> scBlack then
+      Result := Result + ' ' + FWorkbook.GetPaletteColorAsHTMLStr(clr);
+  end;
+
+const
+  PIPE_CHAR: array[boolean] of String = ('|', '!');
 var
   i, j: Integer;
   lCurStr: string = '';
   lCurUsedFormatting: TsUsedFormattingFields;
   lCurColor: TsColor;
-  lColorStr: String;
+  lStyleStr: String;
+  lColSpanStr: String;
+  lRowSpanStr: String;
+  lCell: PCell;
+  lFont: TsFont;
+  horalign: TsHorAlignment;
+  vertalign: TsVertAlignment;
+  r1,c1,r2,c2: Cardinal;
+  isBold: Boolean;
 begin
   AStrings.Add('{| border="1" cellpadding="2" class="wikitable sortable"');
   FWorksheet := Workbook.GetFirstWorksheet();
   FWorksheet.UpdateCaches;
+
+  r1 := 0;
+  c1 := 0;
+  r2 := 0;
+  c2 := 0;
+
   for i := 0 to FWorksheet.GetLastRowIndex() do
   begin
     AStrings.Add('|-');
-    for j := 0 to FWorksheet.GetLastColIndex() do
+    for j := 0 to FWorksheet.GetLastColIndex do
     begin
-      lCurStr := FWorksheet.ReadAsUTF8Text(i, j);
+      lCell := FWorksheet.FindCell(i, j);
-      lCurUsedFormatting := FWorksheet.ReadUsedFormatting(i, j);
+      lCurStr := FWorksheet.ReadAsUTF8Text(lCell);
+      lStyleStr := '';
+      lColSpanStr := '';
+      lRowSpanStr := '';
+      lCurUsedFormatting := FWorksheet.ReadUsedFormatting(lCell);
 
-      if uffBackgroundColor in lCurUsedFormatting then
+      // Font
+      if (uffFont in lCurUsedFormatting) then
       begin
-        lCurColor := FWorksheet.ReadBackgroundColor(i, j);
+        lFont := FWorkbook.GetFont(lCell^.FontIndex);
-        case lCurColor of
+        isBold := fssBold in lFont.Style;
-        scBlack:    lColorStr := 'style="background-color:black;color:white;"';
+      end else
-        scWhite:    lColorStr := 'style="background-color:white;color:black;"';
+      begin
-        scRed:      lColorStr := 'style="background-color:red;color:white;"';
+        lFont := FWorkbook.GetDefaultFont;
-        scGREEN:    lColorStr := 'style="background-color:green;color:white;"';
+        isBold := (uffBold in lCurUsedFormatting);
-        scBLUE:     lColorStr := 'style="background-color:blue;color:white;"';
-        scYELLOW:   lColorStr := 'style="background-color:yellow;color:black;"';
-        {scMAGENTA,  // FF00FFH
-        scCYAN,     // 00FFFFH
-        scDarkRed,  // 800000H
-        scDarkGreen,// 008000H
-        scDarkBlue, // 000080H
-        scOLIVE,    // 808000H
-        scPURPLE,   // 800080H
-        scTEAL,     // 008080H
-        scSilver,   // C0C0C0H
-        scGrey,     // 808080H
-        //
-        scGrey10pct,// E6E6E6H
-        scGrey20pct // CCCCCCH  }
-        scOrange:   lColorStr := 'style="background-color:orange;color:white;"';
-        end;
-        lCurStr := lColorStr + ' |' + lCurStr;
       end;
 
-      if uffBold in lCurUsedFormatting then lCurStr := '!' + lCurStr
+      // Background color
-      else lCurStr := '|' + lCurStr;
+      if uffBackgroundColor in lCurUsedFormatting then
+      begin
+        lCurColor := FWorksheet.ReadBackgroundColor(lCell);
+        lStyleStr := Format('background-color:%s;color:%s;', [
+          FWorkbook.GetPaletteColorAsHTMLStr(lCurColor),
+          FWorkbook.GetPaletteColorAsHTMLStr(lFont.Color)
+        ]);
+      end;
 
+      // Horizontal alignment
+      if uffHorAlign in lCurUsedFormatting then
+      begin
+        horAlign := lCell^.HorAlignment;
+        if horAlign = haDefault then
+          case lCell^.ContentType of
+            cctNumber,
+            cctDateTime : horAlign := haRight;
+            cctBool     : horAlign := haCenter;
+            else          horAlign := haLeft;
+          end;
+        case horAlign of
+          haLeft   : ;   // cells are left-aligned by default
+          haCenter : lStyleStr := lStyleStr + 'text-align:center;';
+          haRight  : lStyleStr := lStyleStr + 'text-align:right';
+        end;
+      end;
+
+      // vertical alignment
+      if uffVertAlign in lCurUsedFormatting then
+      begin
+        vertAlign := lCell^.VertAlignment;
+        case vertAlign of
+          vaTop    : lStyleStr := lStyleStr + 'vertical-align:top;';
+          //vaCenter : lStyleStr := lStyleStr + 'vertical-align:center;';  default is center
+          vaBottom : lStyleStr := lStyleStr + 'vertical-align:bottom;';
+        end;
+      end;
+
+      // borders
+      if uffBorder in lCurUsedFormatting then
+      begin
+        if (cbWest in lCell^.Border) then
+          lStyleStr := lStyleStr + DoBorder(cbWest,lCell);
+        if (cbEast in lCell^.Border) then
+          lStyleStr := lStyleStr + DoBorder(cbEast,lCell);
+        if (cbNorth in lCell^.Border) then
+          lStyleStr := lStyleStr + DoBorder(cbNorth,lCell);
+        if (cbSouth in lCell^.Border) then
+          lStyleStr := lStyleStr + DoBorder(cbSouth,lCell);
+      end;
+
+      // Merged cells
+      if FWorksheet.IsMerged(lCell) then
+      begin
+        FWorksheet.FindMergedRange(lCell, r1, c1, r2, c2);
+        if (i = r1) and (j = c1) then
+        begin
+          if r1 < r2 then
+            lRowSpanStr := Format(' rowspan="%d"', [r2-r1+1]);
+          if c1 < c2 then
+            lColSpanStr := Format(' colspan="%d"', [c2-c1+1]);
+        end
+        else
+        if (i > r1) or (j > c1) then
+          Continue;
+      end;
+
+      // Put everything together...
+      if lStyleStr <> '' then
+        lStyleStr := Format(' style="%s"', [lStyleStr]);
+
+      if lRowSpanStr <> '' then
+        lStyleStr := lRowSpanStr + lStyleStr;
+
+      if lColSpanStr <> '' then
+        lStyleStr := lColSpanStr + lStyleStr;
+
+      if lCurStr <> '' then
+        lCurStr := ' ' + lCurStr;
+
+      if lStyleStr <> '' then
+        lCurStr := lStyleStr + ' |' + lCurStr;
+
+      lCurStr := PIPE_CHAR[isBold] + lCurStr;
+
+      // Add to list
       AStrings.Add(lCurStr);
     end;
   end;