From 5e4d7d4825e9b00fad6aa5917d8f92ede40a08c8 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Thu, 25 Sep 2014 15:48:44 +0000 Subject: [PATCH] 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 --- .../examples/wikitabledemo/wikitablewrite.lpr | 49 ++++- components/fpspreadsheet/fpspreadsheet.pas | 38 ++-- components/fpspreadsheet/fpsutils.pas | 11 ++ components/fpspreadsheet/wikitable.pas | 169 ++++++++++++++---- 4 files changed, 222 insertions(+), 45 deletions(-) diff --git a/components/fpspreadsheet/examples/wikitabledemo/wikitablewrite.lpr b/components/fpspreadsheet/examples/wikitabledemo/wikitablewrite.lpr index e4eb7aac0..b02c051ad 100644 --- a/components/fpspreadsheet/examples/wikitabledemo/wikitablewrite.lpr +++ b/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(2, 0, 'This is a date:'); - Myworksheet.WriteDateTime(2, 1, date()); + + MyWorksheet.WriteUTF8Text(1, 0, 'This is bold text:'); + Myworksheet.WriteUTF8Text(1, 1, 'Hello world!'); + 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,
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); diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 3b518d399..9e5589611 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/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 ReadBackgroundColor(ARow, ACol: Cardinal): TsColor; + function ReadUsedFormatting(ARow, ACol: Cardinal): TsUsedFormattingFields; overload; + 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; diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 793bccd51..65965d228 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/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); diff --git a/components/fpspreadsheet/wikitable.pas b/components/fpspreadsheet/wikitable.pas index 0c24dc3a1..0b080e1a6 100644 --- a/components/fpspreadsheet/wikitable.pas +++ b/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); - lCurUsedFormatting := FWorksheet.ReadUsedFormatting(i, j); + lCell := FWorksheet.FindCell(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); - case lCurColor of - scBlack: lColorStr := 'style="background-color:black;color:white;"'; - scWhite: lColorStr := 'style="background-color:white;color:black;"'; - scRed: lColorStr := 'style="background-color:red;color:white;"'; - scGREEN: lColorStr := 'style="background-color:green;color:white;"'; - 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; + lFont := FWorkbook.GetFont(lCell^.FontIndex); + isBold := fssBold in lFont.Style; + end else + begin + lFont := FWorkbook.GetDefaultFont; + isBold := (uffBold in lCurUsedFormatting); end; - if uffBold in lCurUsedFormatting then lCurStr := '!' + lCurStr - else lCurStr := '|' + lCurStr; + // Background color + 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;