From 89c7433d5dcb63b58042dae24fbb97171ba3e6e1 Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Tue, 11 Jun 2013 14:15:59 +0000 Subject: [PATCH] fpspreadsheet: Adds read/write wiki table format support and some improvements to the base routines git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2747 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/fpspreadsheet/fpsallformats.pas | 2 +- components/fpspreadsheet/fpspreadsheet.pas | 105 ++++- .../fpspreadsheet/laz_fpspreadsheet.lpk | 6 +- .../fpspreadsheet/laz_fpspreadsheet.pas | 10 +- components/fpspreadsheet/wikitable.pas | 414 ++++++++++++++++++ 5 files changed, 528 insertions(+), 9 deletions(-) create mode 100644 components/fpspreadsheet/wikitable.pas diff --git a/components/fpspreadsheet/fpsallformats.pas b/components/fpspreadsheet/fpsallformats.pas index eb29ca86e..fd4719b9c 100755 --- a/components/fpspreadsheet/fpsallformats.pas +++ b/components/fpspreadsheet/fpsallformats.pas @@ -10,7 +10,7 @@ unit fpsallformats; interface uses - xlsbiff2, xlsbiff5, xlsbiff8, fpsopendocument, xlsxooxml; + xlsbiff2, xlsbiff5, xlsbiff8, fpsopendocument, xlsxooxml, wikitable; implementation diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 4970635ab..6ed4fdf5a 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -18,7 +18,7 @@ uses type TsSpreadsheetFormat = (sfExcel2, sfExcel3, sfExcel4, sfExcel5, sfExcel8, - sfOOXML, sfOpenDocument, sfCSV); + sfOOXML, sfOpenDocument, sfCSV, sfWikiTable_Pipes, sfWikiTable_WikiMedia); const { Default extensions } @@ -26,6 +26,8 @@ const STR_OOXML_EXCEL_EXTENSION = '.xlsx'; STR_OPENDOCUMENT_CALC_EXTENSION = '.ods'; STR_COMMA_SEPARATED_EXTENSION = '.csv'; + STR_WIKITABLE_PIPES = '.wikitable_pipes'; + STR_WIKITABLE_WIKIMEDIA = '.wikitable_wikimedia'; type @@ -210,6 +212,7 @@ type { Utils } class function CellPosToText(ARow, ACol: Cardinal): string; { Data manipulation methods - For Cells } + procedure CopyCell(AFromRow, AFromCol, AToRow, AToCol: Cardinal; AFromWorksheet: TsWorksheet); function FindCell(ARow, ACol: Cardinal): PCell; function GetCell(ARow, ACol: Cardinal): PCell; function GetCellCount: Cardinal; @@ -220,6 +223,8 @@ type function ReadAsUTF8Text(ARow, ACol: Cardinal): ansistring; function ReadAsNumber(ARow, ACol: Cardinal): Double; function ReadAsDateTime(ARow, ACol: Cardinal; out AResult: TDateTime): Boolean; + function ReadUsedFormatting(ARow, ACol: Cardinal): TsUsedFormattingFields; + function ReadBackgroundColor(ARow, ACol: Cardinal): TsColor; procedure RemoveAllCells; procedure WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring); procedure WriteNumber(ARow, ACol: Cardinal; ANumber: double); @@ -228,6 +233,7 @@ type procedure WriteRPNFormula(ARow, ACol: Cardinal; AFormula: TsRPNFormula); procedure WriteTextRotation(ARow, ACol: Cardinal; ARotation: TsTextRotation); procedure WriteUsedFormatting(ARow, ACol: Cardinal; AUsedFormatting: TsUsedFormattingFields); + procedure WriteBackgroundColor(ARow, ACol: Cardinal; AColor: TsColor); { Data manipulation methods - For Rows and Cols } function FindRow(ARow: Cardinal): PRow; function FindCol(ACol: Cardinal): PCol; @@ -292,6 +298,7 @@ type { General writing methods } procedure ReadFromFile(AFileName: string; AData: TsWorkbook); virtual; procedure ReadFromStream(AStream: TStream; AData: TsWorkbook); virtual; + procedure ReadFromStrings(AStrings: TStrings; AData: TsWorkbook); virtual; { Record reading methods } procedure ReadFormula(AStream: TStream); virtual; abstract; procedure ReadLabel(AStream: TStream); virtual; abstract; @@ -329,6 +336,7 @@ type procedure WriteToFile(const AFileName: string; AData: TsWorkbook; const AOverwriteExisting: Boolean = False); virtual; procedure WriteToStream(AStream: TStream; AData: TsWorkbook); virtual; + procedure WriteToStrings(AStrings: TStrings; AData: TsWorkbook); virtual; { Record writing methods } procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TsFormula; ACell: PCell); virtual; procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TsRPNFormula; ACell: PCell); virtual; @@ -450,6 +458,24 @@ begin Result := Format('%s%d', [lStr, ARow+1]); end; +procedure TsWorksheet.CopyCell(AFromRow, AFromCol, AToRow, AToCol: Cardinal; + AFromWorksheet: TsWorksheet); +var + lCurStr: String; + lCurUsedFormatting: TsUsedFormattingFields; + lCurColor: TsColor; +begin + lCurStr := AFromWorksheet.ReadAsUTF8Text(AFromRow, AFromCol); + lCurUsedFormatting := AFromWorksheet.ReadUsedFormatting(AFromRow, AFromCol); + lCurColor := AFromWorksheet.ReadBackgroundColor(AFromRow, AFromCol); + WriteUTF8Text(AToRow, AToCol, lCurStr); + WriteUsedFormatting(AToRow, AToCol, lCurUsedFormatting); + if uffBackgroundColor in lCurUsedFormatting then + begin + WriteBackgroundColor(AToRow, AToCol, lCurColor); + end; +end; + {@@ Tryes to locate a Cell in the list of already written Cells @@ -711,6 +737,36 @@ begin Result := True; end; +function TsWorksheet.ReadUsedFormatting(ARow, ACol: Cardinal): TsUsedFormattingFields; +var + ACell: PCell; +begin + ACell := FindCell(ARow, ACol); + + if ACell = nil then + begin + Result := []; + Exit; + end; + + Result := ACell^.UsedFormattingFields; +end; + +function TsWorksheet.ReadBackgroundColor(ARow, ACol: Cardinal): TsColor; +var + ACell: PCell; +begin + ACell := FindCell(ARow, ACol); + + if ACell = nil then + begin + Result := scWhite; + Exit; + end; + + Result := ACell^.BackgroundColor; +end; + {@@ Clears the list of Cells and releases their memory. } @@ -832,6 +888,17 @@ begin ACell^.UsedFormattingFields := AUsedFormatting; end; +procedure TsWorksheet.WriteBackgroundColor(ARow, ACol: Cardinal; + AColor: TsColor); +var + ACell: PCell; +begin + ACell := GetCell(ARow, ACol); + + ACell^.UsedFormattingFields := ACell^.UsedFormattingFields + [uffBackgroundColor]; + ACell^.BackgroundColor := AColor; +end; + function TsWorksheet.FindRow(ARow: Cardinal): PRow; var LElement: TRow; @@ -983,6 +1050,8 @@ begin else if suffix = STR_OOXML_EXCEL_EXTENSION then SheetType := sfOOXML else if suffix = STR_OPENDOCUMENT_CALC_EXTENSION then SheetType := sfOpenDocument else if suffix = STR_COMMA_SEPARATED_EXTENSION then SheetType := sfCSV + else if suffix = STR_WIKITABLE_PIPES then SheetType := sfWikiTable_Pipes + else if suffix = STR_WIKITABLE_WIKIMEDIA then SheetType := sfWikiTable_WikiMedia else Result := False; end; @@ -1277,6 +1346,25 @@ end; This routine should be overriden in descendent classes. } procedure TsCustomSpreadReader.ReadFromStream(AStream: TStream; AData: TsWorkbook); +var + AStringStream: TStringStream; + AStrings: TStringList; +begin + AStringStream := TStringStream.Create(''); + AStrings := TStringList.Create; + try + AStringStream.CopyFrom(AStream, AStream.Size); + AStringStream.Seek(0, soFromBeginning); + AStrings.Text := AStringStream.DataString; + ReadFromStrings(AStrings, AData); + finally + AStringStream.Free; + AStrings.Free; + end; +end; + +procedure TsCustomSpreadReader.ReadFromStrings(AStrings: TStrings; + AData: TsWorkbook); begin raise Exception.Create(lpUnsupportedReadFormat); end; @@ -1502,9 +1590,22 @@ end; This routine should be overriden in descendent classes. } procedure TsCustomSpreadWriter.WriteToStream(AStream: TStream; AData: TsWorkbook); +var + lStringList: TStringList; +begin + lStringList := TStringList.Create; + try + WriteToStrings(lStringList, AData); + lStringList.SaveToStream(AStream); + finally + lStringList.Free; + end; +end; + +procedure TsCustomSpreadWriter.WriteToStrings(AStrings: TStrings; + AData: TsWorkbook); begin raise Exception.Create(lpUnsupportedWriteFormat); - end; procedure TsCustomSpreadWriter.WriteFormula(AStream: TStream; const ARow, diff --git a/components/fpspreadsheet/laz_fpspreadsheet.lpk b/components/fpspreadsheet/laz_fpspreadsheet.lpk index 84071573d..879784266 100644 --- a/components/fpspreadsheet/laz_fpspreadsheet.lpk +++ b/components/fpspreadsheet/laz_fpspreadsheet.lpk @@ -27,7 +27,7 @@ - + @@ -100,6 +100,10 @@ + + + + diff --git a/components/fpspreadsheet/laz_fpspreadsheet.pas b/components/fpspreadsheet/laz_fpspreadsheet.pas index 8acfa4c05..ef96bb767 100644 --- a/components/fpspreadsheet/laz_fpspreadsheet.pas +++ b/components/fpspreadsheet/laz_fpspreadsheet.pas @@ -2,7 +2,7 @@ This source is only used to compile and install the package. } -unit laz_fpspreadsheet; +unit laz_fpspreadsheet; interface @@ -11,14 +11,14 @@ uses xlsbiff5, xlsbiff8, xlsxooxml, fpsutils, fpszipper, uvirtuallayer_types, uvirtuallayer, uvirtuallayer_ole, uvirtuallayer_ole_helpers, uvirtuallayer_ole_types, uvirtuallayer_stream, fpolebasic, xlscommon, - LazarusPackageIntf; + wikitable, LazarusPackageIntf; implementation -procedure Register; +procedure Register; begin -end; +end; initialization - RegisterPackage('laz_fpspreadsheet', @Register); + RegisterPackage('laz_fpspreadsheet', @Register); end. diff --git a/components/fpspreadsheet/wikitable.pas b/components/fpspreadsheet/wikitable.pas new file mode 100644 index 000000000..dc00cc973 --- /dev/null +++ b/components/fpspreadsheet/wikitable.pas @@ -0,0 +1,414 @@ +(* +wikitable.pas + +One unit which handles multiple wiki table formats + +Format simplepipes: + +|| || title1 || title2 || title3 +| [link_to_something|http://google.com]| {color:red}FAILED{color}| {color:red}FAILED{color}| {color:green}PASS{color} + +Format mediawiki: + +{| border="1" cellpadding="2" class="wikitable sortable" +|- +| +! Title +|- +| [http://google.com link_to_something] +! style="background-color:green;color:white;" | PASS +|} + +AUTHORS: Felipe Monteiro de Carvalho +*) +unit wikitable; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + fpimage, fgl, + fpspreadsheet, xlscommon, fpsutils, lconvencoding; + +type + + TWikiTableToken = class + public + BackgroundColor: TsColor; + UseBackgroundColor: Boolean; + Bold: Boolean; + Value: string; + end; + + TWikiTableTokenList = specialize TFPGList; + + { TWikiTableTokenizer } + + TWikiTableTokenizer = class + public + Tokens: TWikiTableTokenList; + constructor Create; virtual; + destructor Destroy; override; + procedure Clear; + function AddToken(AValue: string): TWikiTableToken; + procedure TokenizeString_Pipes(AStr: string); + end; + + { TsWikiTableReader } + + TsWikiTableReader = class(TsCustomSpreadReader) + private + FWorksheet: TsWorksheet; + public + SubFormat: TsSpreadsheetFormat; + { General reading methods } + procedure ReadFromStrings(AStrings: TStrings; AData: TsWorkbook); override; + procedure ReadFromStrings_Pipes(AStrings: TStrings; AData: TsWorkbook); + end; + + { TsWikiTable_PipesReader } + + TsWikiTable_PipesReader = class(TsWikiTableReader) + public + constructor Create; override; + end; + + { TsWikiTableWriter } + + TsWikiTableWriter = class(TsCustomSpreadWriter) + private + FWorksheet: TsWorksheet; + public + SubFormat: TsSpreadsheetFormat; + { General writing methods } + procedure WriteToStrings(AStrings: TStrings; AData: TsWorkbook); override; + procedure WriteToStrings_WikiMedia(AStrings: TStrings; AData: TsWorkbook); + end; + + { TsWikiTable_WikiMediaWriter } + + TsWikiTable_WikiMediaWriter = class(TsWikiTableWriter) + public + constructor Create; override; + end; + +implementation + +{ TWikiTableTokenizer } + +constructor TWikiTableTokenizer.Create; +begin + inherited Create; + Tokens := TWikiTableTokenList.Create; +end; + +destructor TWikiTableTokenizer.Destroy; +begin + Clear; + Tokens.Free; + inherited Destroy; +end; + +procedure TWikiTableTokenizer.Clear; +var + i: Integer; +begin + for i := 0 to Tokens.Count-1 do + Tokens.Items[i].Free; + Tokens.Clear; +end; + +function TWikiTableTokenizer.AddToken(AValue: string): TWikiTableToken; +begin + Result := TWikiTableToken.Create; + Result.Value := AValue; + Tokens.Add(Result); +end; + +(* +Format simplepipes: + +|| || title1 || title2 || title3 +| [link_to_something|http://google.com]| {color:red}FAILED{color}| {color:red}FAILED{color}| {color:green}PASS{color} +*) +procedure TWikiTableTokenizer.TokenizeString_Pipes(AStr: string); +const + Str_Pipe: Char = '|'; + Str_LinkStart: Char = '['; + Str_LinkEnd: Char = ']'; + Str_FormatStart: Char = '{'; + Str_FormatEnd: Char = '}'; + Str_EmptySpaces: set of Char = [' ']; +var + i: Integer; + lTmpStr: string = ''; + lFormatStr: string = ''; + lState: Integer; + lLookAheadChar, lCurChar: Char; + lIsTitle: Boolean = False; + lCurBackgroundColor: TsColor; + lUseBackgroundColor: Boolean = False; + lCurToken: TWikiTableToken; + + procedure DoAddToken(); + begin + lCurToken := AddToken(lTmpStr); + lCurToken.Bold := lIsTitle; + lCurToken.UseBackgroundColor := lUseBackgroundColor; + if lUseBackgroundColor then + lCurToken.BackgroundColor := lCurBackgroundColor; + end; + +begin + Clear; + + lState := 0; + + i := 1; + while i <= Length(AStr) do + begin + lCurChar := AStr[i]; + if i < Length(AStr) then lLookAheadChar := AStr[i+1]; + + case lState of + 0: // Line-start or otherwise reading a pipe separator, expecting a | or || + begin + if lCurChar = Str_Pipe then + begin + lState := 1; + lIsTitle := False; + if lLookAheadChar = Str_Pipe then + begin + Inc(i); + lIsTitle := True; + end; + Inc(i); + + lUseBackgroundColor := False; + lTmpStr := ''; + end + else if lCurChar in Str_EmptySpaces then + begin + // Do nothing + Inc(i); + end + else + begin + // Error!!! + raise Exception.Create('[TWikiTableTokenizer.TokenizeString] Wrong char!'); + end; + end; + 1: // Reading cell text + begin + if lCurChar = Str_Pipe then + begin + lState := 0; + DoAddToken(); + end + else if lCurChar = Str_LinkStart then + begin + lState := 2; + Inc(i); + end + else if lCurChar = Str_FormatStart then + begin + lState := 4; + Inc(i); + end + else + begin + lTmpStr := lTmpStr + lCurChar; + Inc(i); + end; + end; + 2: // Link text reading + begin + if lCurChar = Str_Pipe then + begin + lState := 3; + Inc(i); + end + else + begin + lTmpStr := lTmpStr + lCurChar; + Inc(i); + end; + end; + 3: // Link target reading + begin + if lCurChar = Str_LinkEnd then + begin + lState := 1; + Inc(i); + end + else + begin + Inc(i); + end; + end; + 4: // Color start reading + begin + if lCurChar = Str_FormatEnd then + begin + lState := 1; + Inc(i); + lFormatStr := LowerCase(Trim(lFormatStr)); + if lFormatStr = 'color:red' then lCurBackgroundColor := scRED + else if lFormatStr = 'color:green' then lCurBackgroundColor := scGREEN; + lFormatStr := ''; + end + else + begin + lFormatStr := lFormatStr + lCurChar; + Inc(i); + end; + end; + end; + end; + + // rest after the last || is also a token + if lTmpStr <> '' then DoAddToken(); + + // If there is a token still to be added, add it now + if (lState = 0) and (lTmpStr <> '') then AddToken(lTmpStr); +end; + +{ TsWikiTableReader } + +procedure TsWikiTableReader.ReadFromStrings(AStrings: TStrings; + AData: TsWorkbook); +begin + case SubFormat of + sfWikiTable_Pipes: ReadFromStrings_Pipes(AStrings, AData); + end; +end; + +procedure TsWikiTableReader.ReadFromStrings_Pipes(AStrings: TStrings; + AData: TsWorkbook); +var + i, j: Integer; + lCurLine: String; + lLineSplitter: TWikiTableTokenizer; + lCurToken: TWikiTableToken; +begin + FWorksheet := AData.AddWorksheet('Table'); + lLineSplitter := TWikiTableTokenizer.Create; + try + for i := 0 to AStrings.Count-1 do + begin + lCurLine := AStrings[i]; + lLineSplitter.TokenizeString_Pipes(lCurLine); + for j := 0 to lLineSplitter.Tokens.Count-1 do + begin + lCurToken := lLineSplitter.Tokens[j]; + FWorksheet.WriteUTF8Text(i, j, lCurToken.Value); + if lCurToken.Bold then FWorksheet.WriteUsedFormatting(i, j, [uffBold]); + if lCurToken.UseBackgroundColor then FWorksheet.WriteBackgroundColor(i, j, lCurToken.BackgroundColor); + end; + end; + finally + lLineSplitter.Free; + end; +end; + +{ TsWikiTable_PipesReader } + +constructor TsWikiTable_PipesReader.Create; +begin + inherited Create; + SubFormat := sfWikiTable_Pipes; +end; + +{ TsWikiTableWriter } + +procedure TsWikiTableWriter.WriteToStrings(AStrings: TStrings; AData: TsWorkbook); +begin + case SubFormat of + sfWikiTable_WikiMedia: WriteToStrings_WikiMedia(AStrings, AData); + end; +end; + +(* +Format mediawiki: + +{| border="1" cellpadding="2" class="wikitable sortable" +|- +| +! Title +|- +| [http://google.com link_to_something] +! style="background-color:green;color:white;" | PASS +|} +*) +procedure TsWikiTableWriter.WriteToStrings_WikiMedia(AStrings: TStrings; + AData: TsWorkbook); +var + i, j: Integer; + lCurStr: string = ''; + lCurCell: PCell; + lCurUsedFormatting: TsUsedFormattingFields; + lCurColor: TsColor; + lColorStr: String; +begin + AStrings.Add('{| border="1" cellpadding="2" class="wikitable sortable"'); + FWorksheet := AData.GetFirstWorksheet(); + for i := 0 to FWorksheet.GetLastRowNumber() do + begin + AStrings.Add('|-'); + for j := 0 to FWorksheet.GetLastColNumber() do + begin + lCurStr := FWorksheet.ReadAsUTF8Text(i, j); + lCurUsedFormatting := FWorksheet.ReadUsedFormatting(i, j); + + if uffBackgroundColor in lCurUsedFormatting then + begin + lCurColor := FWorksheet.ReadBackgroundColor(i, j); + case lCurColor of + {scBlack, // 000000H + scWhite, // FFFFFFH} + scRed: lColorStr := 'red'; + scGREEN: lColorStr := 'green'; + {scBLUE, // 0000FFH + scYELLOW, // FFFF00H + scMAGENTA, // FF00FFH + scCYAN, // 00FFFFH + scDarkRed, // 800000H + scDarkGreen,// 008000H + scDarkBlue, // 000080H + scOLIVE, // 808000H + scPURPLE, // 800080H + scTEAL, // 008080H + scSilver, // C0C0C0H + scGrey, // 808080H + // + scGrey10pct,// E6E6E6H + scGrey20pct // CCCCCCH } + end; + lCurStr := 'style="background-color:'+lColorStr+';color:white;" |' + lCurStr + end; + + if uffBold in lCurUsedFormatting then lCurStr := '!' + lCurStr + else lCurStr := '|' + lCurStr; + + AStrings.Add(lCurStr); + end; + end; + AStrings.Add('|}'); +end; + +{ TsWikiTable_WikiMediaWriter } + +constructor TsWikiTable_WikiMediaWriter.Create; +begin + inherited Create; + SubFormat := sfWikiTable_WikiMedia; +end; + +initialization + + RegisterSpreadFormat(TsWikiTable_PipesReader, nil, sfWikiTable_Pipes); + RegisterSpreadFormat(nil, TsWikiTable_WikiMediaWriter, sfWikiTable_WikiMedia); + +end.