You've already forked lazarus-ccr
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
This commit is contained in:
wp_xxyyzz
@ -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,<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);
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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;
|
||||
|
||||
Reference in New Issue
Block a user