From e9ae26952fab34b123115755f40aa32f4e1ead4e Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Fri, 26 Sep 2014 13:47:47 +0000 Subject: [PATCH] fpspreadsheet: Complete writing of all cell styles to wikitables (except for text rotation). Some cleanup of compiler warnings. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3606 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/wikitabledemo/wikitablewrite.lpr | 179 +++++++++++++----- components/fpspreadsheet/fpsexprparser.pas | 118 ++++++------ components/fpspreadsheet/fpsfunc.pas | 1 - components/fpspreadsheet/fpspreadsheet.pas | 47 ++--- components/fpspreadsheet/wikitable.pas | 100 +++++++--- 5 files changed, 280 insertions(+), 165 deletions(-) diff --git a/components/fpspreadsheet/examples/wikitabledemo/wikitablewrite.lpr b/components/fpspreadsheet/examples/wikitabledemo/wikitablewrite.lpr index b02c051ad..67f89f12f 100644 --- a/components/fpspreadsheet/examples/wikitabledemo/wikitablewrite.lpr +++ b/components/fpspreadsheet/examples/wikitabledemo/wikitablewrite.lpr @@ -12,81 +12,158 @@ program wikitablewrite; uses Classes, SysUtils, fpspreadsheet, wikitable; -const - Str_First = 'First'; - Str_Second = 'Second'; - Str_Third = 'Third'; - Str_Fourth = 'Fourth'; - Str_Worksheet1 = 'Meu Relatório'; - Str_Worksheet2 = 'My Worksheet 2'; - Str_Total = 'Total:'; var MyWorkbook: TsWorkbook; MyWorksheet: TsWorksheet; - MyRPNFormula: TsRPNFormula; MyDir: string; - number: Double; - lCell: PCell; - lCol: TCol; - i: Integer; - r: Integer = 10; - s: String; + row: Integer; begin MyDir := ExtractFilePath(ParamStr(0)); // Create the spreadsheet MyWorkbook := TsWorkbook.Create; + MyWorkbook.SetDefaultFont('Times New Roman', 9); - MyWorksheet := MyWorkbook.AddWorksheet(Str_Worksheet1); + MyWorksheet := MyWorkbook.AddWorksheet('Sheet'); + + // Use first row and column as a header + Myworksheet.Options := MyWorksheet.Options + [soHasFrozenPanes]; + Myworksheet.TopPaneHeight := 1; + Myworksheet.LeftPaneWidth := 1; + + // Write colwidth + Myworksheet.WriteColWidth(1, 25); // 25 characters // Write some cells - MyWorksheet.WriteUTF8Text(0, 0, 'This is a text:'); - MyWorksheet.WriteUTF8Text(0, 1, 'Hello world!'); + row := 0; - MyWorksheet.WriteUTF8Text(1, 0, 'This is bold text:'); - Myworksheet.WriteUTF8Text(1, 1, 'Hello world!'); - Myworksheet.WriteFontStyle(1, 1, [fssBold]); + MyWorksheet.WriteBlank(row, 0); + MyWorksheet.WriteUTF8Text(row, 1, 'Description'); + MyWorksheet.WriteUTF8Text(row, 2, 'Example'); + inc(row); - 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.WriteNumber(row, 0, row); + MyWorksheet.WriteUTF8Text(row, 1, 'This is a text:'); + MyWorksheet.WriteUTF8Text(row, 2, 'Hello world!'); + inc(row); - MyWorksheet.WriteUTF8Text(3, 0, 'This is a date:'); - Myworksheet.WriteDateTime(3, 1, date()); + MyWorksheet.WriteNumber(row, 0, row); + MyWorksheet.WriteUTF8Text(row, 1, 'This is bold text:'); + Myworksheet.WriteUTF8Text(row, 2, 'Hello world!'); + Myworksheet.WriteFontStyle(row, 2, [fssBold]); + inc(row); - MyWorksheet.WriteUTF8Text(4, 0, 'This is a long text:'); - MyWorksheet.WriteUTF8Text(4, 1, 'A very, very, very, very long text, indeed'); + MyWorksheet.WriteNumber(row, 0, row); + MyWorksheet.WriteUTF8Text(row, 1, 'This is a number:'); + MyWorksheet.WriteNumber(row, 2, 3.141592); + Myworksheet.WriteHorAlignment(row, 2, haRight); + inc(row); - MyWorksheet.WriteUTF8Text(5, 0, 'This is long text with line break:'); - Myworksheet.WriteVertAlignment(5, 0, vaTop); + MyWorksheet.WriteNumber(row, 0, row); + MyWorksheet.WriteUTF8Text(row, 1, 'This is a date:'); + Myworksheet.WriteDateTime(row, 2, date()); + inc(row); - MyWorksheet.WriteUTF8Text(5, 1, 'A very, very, very, very long text,
indeed'); + MyWorksheet.WriteNumber(row, 0, row); + MyWorksheet.WriteUTF8Text(row, 1, 'This is a long text:'); + MyWorksheet.WriteUTF8Text(row, 2, 'A very, very, very, very long text, indeed'); + inc(row); - MyWorksheet.WriteUTF8Text(6, 0, 'Merged rows'); - Myworksheet.MergeCells(6, 0, 7, 0); - MyWorksheet.WriteUTF8Text(6, 1, 'A'); - MyWorksheet.WriteUTF8Text(7, 1, 'B'); + MyWorksheet.WriteNumber(row, 0, row); + MyWorksheet.WriteUTF8Text(row, 1, 'Centered text:'); + MyWorksheet.WriteUTF8Text(row, 2, 'I am in the center.'); + MyWorksheet.WriteHorAlignment(row, 2, haCenter); + inc(row); - MyWorksheet.WriteUTF8Text(8, 0, 'Merged columns'); - MyWorksheet.WriteHorAlignment(8, 0, haCenter); - MyWorksheet.MergeCells(8, 0, 8, 1); + MyWorksheet.WriteNumber(row, 0, row); + MyWorksheet.WriteUTF8Text(row, 1, 'This is a long text with line break:'); + Myworksheet.WriteVertAlignment(row, 1, vaTop); + MyWorksheet.WriteUTF8Text(row, 2, 'A very, very, very, very long text,
indeed'); + inc(row); - MyWorksheet.WriteUTF8Text(10, 0, 'Right borders:'); - MyWorksheet.WriteBorders(10, 0, [cbEast]); + MyWorksheet.WriteNumber(row, 0, row); + MyWorksheet.WriteUTF8Text(row, 1, 'Merged rows'); + Myworksheet.MergeCells(row, 1, row+1, 1); + MyWorksheet.WriteUTF8Text(row, 2, 'A'); + inc(row); + MyWorksheet.WriteUTF8Text(row, 2, 'B'); + inc(row); - MyWorksheet.WriteUTF8Text(10, 1, 'medium / blue'); - MyWorksheet.WriteBorders(10, 1, [cbEast]); - MyWorksheet.WriteBorderLineStyle(10, 1, cbEast, lsMedium); - MyWorksheet.WriteBorderColor(10, 1, cbEast, scBlue); + MyWorksheet.WriteNumber(row, 0, row); + MyWorksheet.WriteUTF8Text(row, 1, 'Merged columns'); + MyWorksheet.WriteHorAlignment(row, 1, haCenter); + MyWorksheet.MergeCells(row, 1, row, 2); + inc(row); - MyWorksheet.WriteUTF8Text(11, 0, 'Top borders:'); - MyWorksheet.WriteBorders(11, 0, [cbNorth]); - MyWorksheet.WriteBorderLineStyle(11, 0, cbNorth, lsDashed); + MyWorksheet.WriteNumber(row, 0, row); + MyWorksheet.WriteUTF8Text(row, 1, 'Right border:'); + MyWorksheet.WriteUTF8Text(row, 2, 'medium / red'); + MyWorksheet.WriteBorders(row, 2, [cbEast]); + MyWorksheet.WriteBorderStyle(row, 2, cbEast, lsMedium, scRed); + inc(row); - MyWorksheet.WriteUTF8Text(11, 1, '(dotted)'); - MyWorksheet.WriteBorders(11, 1, [cbNorth]); - MyWorksheet.WriteBorderLineStyle(11, 1, cbNorth, lsDotted); + MyWorksheet.WriteNumber(row, 0, row); + MyWorksheet.WriteUTF8Text(row, 1, 'Top border:'); + MyWorksheet.WriteUTF8Text(row, 2, 'top / dashed'); + MyWorksheet.WriteBorders(row, 2, [cbNorth]); + MyWorksheet.WriteBorderLineStyle(row, 2, cbNorth, lsDashed); + inc(row); + + MyWorksheet.WriteNumber(row, 0, row); + MyWorksheet.WriteUTF8Text(row, 1, 'Left border:'); + MyWorksheet.WriteUTF8Text(row, 2, 'left / dotted'); + MyWorksheet.WriteBorders(row, 2, [cbWest]); + MyWorksheet.WriteBorderLineStyle(row, 2, cbWest, lsDotted); + inc(row); + + MyWorksheet.WriteNumber(row, 0, row); + MyWorksheet.WriteUTF8Text(row, 1, 'Bottom border:'); + MyWorksheet.WriteUTF8Text(row, 2, 'bottom / double'); + MyWorksheet.WriteBorders(row, 2, [cbSouth]); + MyWorksheet.WriteBorderLineStyle(row, 2, cbSouth, lsDouble); + inc(row); + + MyWorksheet.WriteNumber(row, 0, row); + MyWorksheet.WriteUTF8Text(row, 1, 'This row is high'); + MyWorksheet.WriteRowHeight(row, 5); + inc(row); + + MyWorksheet.WriteNumber(row, 0, row); + MyWorksheet.WriteUTF8Text(row, 1, 'Colors:'); + MyWorksheet.WriteUTF8Text(row, 2, 'yellow on blue'); + MyWorksheet.WriteFontColor(row, 2, scYellow); + MyWorksheet.WriteBackgroundColor(row, 2, scBlue); + inc(row); + + MyWorksheet.WriteNumber(row, 0, row); + MyWorksheet.WriteUTF8Text(row, 1, 'RGB background color:'); + MyWorksheet.WriteUTF8Text(row, 2, 'color #FF77C3'); + MyWorksheet.WriteBackgroundColor(row, 2, MyWorkbook.AddColorToPalette($C377FF)); + inc(row); + + MyWorksheet.WriteNumber(row, 0, row); + MyWorksheet.WriteUTF8Text(row, 1, 'Bold text:'); + MyWorksheet.WriteUTF8Text(row, 2, 'Bold text'); + MyWorksheet.WriteFontStyle(row, 2, [fssBold]); + inc(row); + + MyWorksheet.WriteNumber(row, 0, row); + MyWorksheet.WriteUTF8Text(row, 1, 'Italic text:'); + MyWorksheet.WriteUTF8Text(row, 2, 'Italic text'); + MyWorksheet.WriteFontStyle(row, 2, [fssItalic]); + inc(row); + + MyWorksheet.WriteNumber(row, 0, row); + MyWorksheet.WriteUTF8Text(row, 1, 'Underlined text:'); + MyWorksheet.WriteUTF8Text(row, 2, 'Underlined text'); + MyWorksheet.WriteFontStyle(row, 2, [fssUnderline]); + inc(row); + + MyWorksheet.WriteNumber(row, 0, row); + MyWorksheet.WriteUTF8Text(row, 1, 'Strike-through text:'); + MyWorksheet.WriteUTF8Text(row, 2, 'Strike-through text'); + MyWorksheet.WriteFontStyle(row, 2, [fssStrikeout]); + inc(row); // Save the spreadsheet to a file MyWorkbook.WriteToFile(MyDir + 'test.wikitable_wikimedia', sfWikitable_wikimedia); diff --git a/components/fpspreadsheet/fpsexprparser.pas b/components/fpspreadsheet/fpsexprparser.pas index 498d873ed..4c6b77a46 100644 --- a/components/fpspreadsheet/fpsexprparser.pas +++ b/components/fpspreadsheet/fpsexprparser.pas @@ -112,7 +112,7 @@ type procedure CheckNodeType(ANode: TsExprNode; Allowed: TsResultTypes); // A procedure with var saves an implicit try/finally in each node // A marked difference in execution speed. - procedure GetNodeValue(var Result: TsExpressionResult); virtual; abstract; + procedure GetNodeValue(out Result: TsExpressionResult); virtual; abstract; public function AsRPNItem(ANext: PRPNItem): PRPNItem; virtual; abstract; function AsString: string; virtual; abstract; @@ -160,7 +160,7 @@ type { TsEqualExprNode } TsEqualExprNode = class(TsBooleanResultExprNode) protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsString: string; override; @@ -169,7 +169,7 @@ type { TsNotEqualExprNode } TsNotEqualExprNode = class(TsEqualExprNode) protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsString: string; override; @@ -184,7 +184,7 @@ type { TsLessExprNode } TsLessExprNode = class(TsOrderingExprNode) protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsString: string; override; @@ -193,7 +193,7 @@ type { TsGreaterExprNode } TsGreaterExprNode = class(TsOrderingExprNode) protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsString: string; override; @@ -202,7 +202,7 @@ type { TsLessEqualExprNode } TsLessEqualExprNode = class(TsGreaterExprNode) protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsString: string; override; @@ -211,7 +211,7 @@ type { TsGreaterEqualExprNode } TsGreaterEqualExprNode = class(TsLessExprNode) protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsString: string; override; @@ -221,7 +221,7 @@ type TsConcatExprNode = class(TsBinaryOperationExprNode) protected procedure CheckSameNodeTypes; override; - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsString: string ; override; @@ -241,7 +241,7 @@ type { TsAddExprNode } TsAddExprNode = class(TsMathOperationExprNode) protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsString: string ; override; @@ -250,7 +250,7 @@ type { TsSubtractExprNode } TsSubtractExprNode = class(TsMathOperationExprNode) protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsString: string ; override; @@ -259,7 +259,7 @@ type { TsMultiplyExprNode } TsMultiplyExprNode = class(TsMathOperationExprNode) protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsString: string ; override; @@ -268,7 +268,7 @@ type { TsDivideExprNode } TsDivideExprNode = class(TsMathOperationExprNode) protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsString: string ; override; @@ -278,7 +278,7 @@ type { TsPowerExprNode } TsPowerExprNode = class(TsMathOperationExprNode) protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsString: string ; override; @@ -305,7 +305,7 @@ type { TsNotExprNode } TsNotExprNode = class(TsUnaryOperationExprNode) protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsString: String; override; @@ -322,7 +322,7 @@ type { TsIntToFloatExprNode } TsIntToFloatExprNode = class(TsConvertToIntExprNode) protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public function NodeType: TsResultType; override; end; @@ -330,7 +330,7 @@ type { TsIntToDateTimeExprNode } TsIntToDateTimeExprNode = class(TsConvertToIntExprNode) protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public function NodeType: TsResultType; override; end; @@ -338,7 +338,7 @@ type { TsFloatToDateTimeExprNode } TsFloatToDateTimeExprNode = class(TsConvertExprNode) protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public procedure Check; override; function NodeType: TsResultType; override; @@ -347,7 +347,7 @@ type { TsUPlusExprNode } TsUPlusExprNode = class(TsUnaryOperationExprNode) protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsString: String; override; @@ -358,7 +358,7 @@ type { TsUMinusExprNode } TsUMinusExprNode = class(TsUnaryOperationExprNode) protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsString: String; override; @@ -369,7 +369,7 @@ type { TsPercentExprNode } TsPercentExprNode = class(TsUnaryOperationExprNode) protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsString: String; override; @@ -380,7 +380,7 @@ type { TsParenthesisExprNode } TsParenthesisExprNode = class(TsUnaryOperationExprNode) protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsString: String; override; @@ -392,7 +392,7 @@ type private FValue: TsExpressionResult; protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public procedure Check; override; constructor CreateString(AParser: TsExpressionParser; AValue: String); @@ -529,7 +529,7 @@ type PResult: PsExpressionResult; FResultType: TsResultType; protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public constructor CreateIdentifier(AParser: TsExpressionParser; AID: TsExprIdentifierDef); function NodeType: TsResultType; override; @@ -567,7 +567,7 @@ type private FCallBack: TsExprFunctionCallBack; protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public constructor CreateFunction(AParser: TsExpressionParser; AID: TsExprIdentifierDef; const Args: TsExprArgumentArray); override; @@ -579,7 +579,7 @@ type private FCallBack: TsExprFunctionEvent; protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public constructor CreateFunction(AParser: TsExpressionParser; AID: TsExprIdentifierDef; const Args: TsExprArgumentArray); override; @@ -597,7 +597,7 @@ type protected function GetCol: Cardinal; function GetRow: Cardinal; - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public constructor Create(AParser: TsExpressionParser; AWorksheet: TsWorksheet; ACellString: String); overload; @@ -618,7 +618,7 @@ type FCol1, FCol2: Cardinal; FFlags: TsRelFlags; protected - procedure GetNodeValue(var Result: TsExpressionResult); override; + procedure GetNodeValue(out Result: TsExpressionResult); override; public constructor Create(AParser: TsExpressionParser; AWorksheet: TsWorksheet; ACellRangeString: String); overload; @@ -730,7 +730,7 @@ type function IdentifierByName(AName: ShortString): TsExprIdentifierDef; virtual; procedure Clear; function Evaluate: TsExpressionResult; - procedure EvaluateExpression(var Result: TsExpressionResult); + procedure EvaluateExpression(out Result: TsExpressionResult); function ResultType: TsResultType; function SharedFormulaMode: Boolean; @@ -995,7 +995,6 @@ end; function TsExpressionScanner.DoError: TsTokenType; var C: Char; - s: String; begin C := CurrentChar; while (not IsWordDelim(C)) and (C <> cNull) do @@ -1003,7 +1002,6 @@ begin FToken := FToken + C; C := NextPos; end; - S := UpperCase(Token); Result := ttError; end; @@ -1338,7 +1336,7 @@ begin EvaluateExpression(Result); end; -procedure TsExpressionParser.EvaluateExpression(var Result: TsExpressionResult); +procedure TsExpressionParser.EvaluateExpression(out Result: TsExpressionResult); begin if (FExpression = '') then ParserError(SErrInExpressionEmpty); @@ -1403,14 +1401,9 @@ begin end; function TsExpressionParser.IdentifierByName(AName: ShortString): TsExprIdentifierDef; -var - s: String; begin if FDirty then CreateHashList; - s := FHashList.NameOfIndex(0); - s := FHashList.NameOfIndex(25); - s := FHashList.NameOfIndex(36); Result := TsExprIdentifierDef(FHashList.Find(UpperCase(AName))); end; @@ -1545,7 +1538,6 @@ end; function TsExpressionParser.Level5: TsExprNode; var isPlus, isMinus: Boolean; - tt: TsTokenType; begin {$ifdef debugexpr} Writeln('Level 5 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr} isPlus := false; @@ -2693,7 +2685,7 @@ begin Result := FValue.ResultType; end; -procedure TsConstExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsConstExprNode.GetNodeValue(out Result: TsExpressionResult); begin Result := FValue; end; @@ -2747,7 +2739,7 @@ begin RaiseParserError(SErrNoUPlus, [ResultTypeName(Operand.NodeType), Operand.AsString]) end; -procedure TsUPlusExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsUPlusExprNode.GetNodeValue(out Result: TsExpressionResult); var cell: PCell; begin @@ -2806,7 +2798,7 @@ begin RaiseParserError(SErrNoNegation, [ResultTypeName(Operand.NodeType), Operand.AsString]) end; -procedure TsUMinusExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsUMinusExprNode.GetNodeValue(out Result: TsExpressionResult); var cell: PCell; begin @@ -2867,7 +2859,7 @@ begin RaiseParserError(SErrNoPercentOperation, [ResultTypeName(Operand.NodeType), Operand.AsString]) end; -procedure TsPercentExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsPercentExprNode.GetNodeValue(out Result: TsExpressionResult); begin Operand.GetNodeValue(Result); case Result.ResultType of @@ -2906,7 +2898,7 @@ begin Result := Operand.NodeType; end; -procedure TsParenthesisExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsParenthesisExprNode.GetNodeValue(out Result: TsExpressionResult); begin Result := Operand.NodeValue; end; @@ -2935,7 +2927,7 @@ begin RaiseParserError(SErrNoNotOperation, [ResultTypeName(Operand.NodeType), Operand.AsString]) end; -procedure TsNotExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsNotExprNode.GetNodeValue(out Result: TsExpressionResult); begin Operand.GetNodeValue(Result); case Result.ResultType of @@ -2985,7 +2977,7 @@ begin Result := Left.AsString + '=' + Right.AsString; end; -procedure TsEqualExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsEqualExprNode.GetNodeValue(out Result: TsExpressionResult); var RRes: TsExpressionResult; begin @@ -3038,7 +3030,7 @@ begin Result := Left.AsString + '<>' + Right.AsString; end; -procedure TsNotEqualExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsNotEqualExprNode.GetNodeValue(out Result: TsExpressionResult); begin inherited GetNodeValue(Result); Result.ResBoolean := not Result.ResBoolean; @@ -3074,7 +3066,7 @@ begin Result := Left.AsString + '<' + Right.AsString; end; -procedure TsLessExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsLessExprNode.GetNodeValue(out Result: TsExpressionResult); var RRes: TsExpressionResult; begin @@ -3121,7 +3113,7 @@ begin Result := Left.AsString + '>' + Right.AsString; end; -procedure TsGreaterExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsGreaterExprNode.GetNodeValue(out Result: TsExpressionResult); var RRes: TsExpressionResult; begin @@ -3168,7 +3160,7 @@ begin Result := Left.AsString + '>=' + Right.AsString; end; -procedure TsGreaterEqualExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsGreaterEqualExprNode.GetNodeValue(out Result: TsExpressionResult); begin inherited GetNodeValue(Result); Result.ResBoolean := not Result.ResBoolean; @@ -3191,7 +3183,7 @@ begin Result := Left.AsString + '<=' + Right.AsString; end; -procedure TsLessEqualExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsLessEqualExprNode.GetNodeValue(out Result: TsExpressionResult); begin inherited GetNodeValue(Result); Result.ResBoolean := not Result.ResBoolean; @@ -3225,7 +3217,7 @@ begin // Same node types are checked in GetNodevalue end; -procedure TsConcatExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsConcatExprNode.GetNodeValue(out Result: TsExpressionResult); var RRes : TsExpressionResult; begin @@ -3287,7 +3279,7 @@ begin Result := Left.AsString + '+' + Right.AsString; end; -procedure TsAddExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsAddExprNode.GetNodeValue(out Result: TsExpressionResult); var RRes: TsExpressionResult; begin @@ -3330,7 +3322,7 @@ begin Result := Left.AsString + '-' + Right.asString; end; -procedure TsSubtractExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsSubtractExprNode.GetNodeValue(out Result: TsExpressionResult); var RRes: TsExpressionResult; begin @@ -3373,7 +3365,7 @@ begin Result := Left.AsString + '*' + Right.AsString; end; -procedure TsMultiplyExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsMultiplyExprNode.GetNodeValue(out Result: TsExpressionResult); var RRes: TsExpressionResult; begin @@ -3416,7 +3408,7 @@ begin Result := Left.AsString + '/' + Right.asString; end; -procedure TsDivideExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsDivideExprNode.GetNodeValue(out Result: TsExpressionResult); var RRes: TsExpressionResult; y: TsExprFloat; @@ -3465,7 +3457,7 @@ begin Result := Left.AsString + '^' + Right.AsString; end; -procedure TsPowerExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsPowerExprNode.GetNodeValue(out Result: TsExpressionResult); var RRes: TsExpressionResult; begin @@ -3517,7 +3509,7 @@ begin CheckNodeType(Operand, [rtInteger, rtCell]) end; -procedure TsIntToFloatExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsIntToFloatExprNode.GetNodeValue(out Result: TsExpressionResult); begin Operand.GetNodeValue(Result); if Result.ResultType in [rtInteger, rtCell] then @@ -3537,7 +3529,7 @@ begin Result := rtDatetime; end; -procedure TsIntToDateTimeExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsIntToDateTimeExprNode.GetNodeValue(out Result: TsExpressionResult); begin Operand.GetnodeValue(Result); if Result.ResultType in [rtInteger, rtCell] then @@ -3558,7 +3550,7 @@ begin Result := rtDateTime; end; -procedure TsFloatToDateTimeExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsFloatToDateTimeExprNode.GetNodeValue(out Result: TsExpressionResult); begin Operand.GetNodeValue(Result); if Result.ResultType in [rtFloat, rtCell] then @@ -3582,7 +3574,7 @@ begin Result := FResultType; end; -procedure TsIdentifierExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsIdentifierExprNode.GetNodeValue(out Result: TsExpressionResult); begin Result := PResult^; Result.ResultType := FResultType; @@ -3735,7 +3727,7 @@ begin FCallBack := AID.OnGetFunctionValueCallBack; end; -procedure TsFunctionCallBackExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsFunctionCallBackExprNode.GetNodeValue(out Result: TsExpressionResult); begin Result.ResultType := NodeType; // was at end! if Length(FArgumentParams) > 0 then @@ -3753,7 +3745,7 @@ begin FCallBack := AID.OnGetFunctionValue; end; -procedure TFPFunctionEventHandlerExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TFPFunctionEventHandlerExprNode.GetNodeValue(out Result: TsExpressionResult); begin Result.ResultType := NodeType; // was at end if Length(FArgumentParams) > 0 then @@ -3832,7 +3824,7 @@ begin Result := FCol; end; -procedure TsCellExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsCellExprNode.GetNodeValue(out Result: TsExpressionResult); var cell: PCell; begin @@ -3931,7 +3923,7 @@ begin // Nothing to check; end; -procedure TsCellRangeExprNode.GetNodeValue(var Result: TsExpressionResult); +procedure TsCellRangeExprNode.GetNodeValue(out Result: TsExpressionResult); var r,c: Cardinal; cell: PCell; diff --git a/components/fpspreadsheet/fpsfunc.pas b/components/fpspreadsheet/fpsfunc.pas index 8e85a1ee6..130acad8d 100644 --- a/components/fpspreadsheet/fpsfunc.pas +++ b/components/fpspreadsheet/fpsfunc.pas @@ -1033,7 +1033,6 @@ var n: Integer; r, c: Cardinal; cell: PCell; - arg: TsExpressionResult; begin n := 0; case Args[0].ResultType of diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 9e5589611..5c5053339 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -28,7 +28,7 @@ type TsSpreadsheetFormatLimitations = record MaxRowCount: Cardinal; MaxColCount: Cardinal; - MaxPaletteSize: Cardinal; + MaxPaletteSize: Integer; end; const @@ -42,6 +42,9 @@ const MAX_COL_COUNT = 65535; + DEFAULTFONTNAME = 'Arial'; + DEFAULTFONTSIZE = 10; + type {@@ Possible encodings for a non-unicode encoded text } @@ -1770,11 +1773,11 @@ end; procedure TsWorksheet.DeleteColCallback(data, arg: Pointer); var cell: PCell; - col: PtrInt; + col: Cardinal; formula: TsRPNFormula; i: Integer; begin - col := PtrInt(arg); + col := Cardinal(PtrInt(arg)); cell := PCell(data); if cell = nil then // This should not happen. Just to make sure... exit; @@ -1825,11 +1828,11 @@ end; procedure TsWorksheet.DeleteRowCallback(data, arg: Pointer); var cell: PCell; - row: PtrInt; + row: Cardinal; formula: TsRPNFormula; i: Integer; begin - row := PtrInt(arg); + row := Cardinal(PtrInt(arg)); cell := PCell(data); if cell = nil then // This should not happen. Just to make sure... exit; @@ -2148,7 +2151,6 @@ end; -------------------------------------------------------------------------------} function TsWorksheet.GetLastColIndex(AForceCalculation: Boolean = false): Cardinal; var - AVLNode: TAVLTreeNode; i: Integer; begin if AForceCalculation then @@ -2192,9 +2194,6 @@ end; function TsWorksheet.GetLastOccupiedColIndex: Cardinal; var AVLNode: TAVLTreeNode; - i: Integer; - c: Cardinal; - w: Single; begin Result := 0; // Traverse the tree from lowest to highest. @@ -2300,7 +2299,6 @@ end; -------------------------------------------------------------------------------} function TsWorksheet.GetLastRowIndex(AForceCalculation: Boolean = false): Cardinal; var - AVLNode: TAVLTreeNode; i: Integer; begin if AForceCalculation then @@ -2331,7 +2329,6 @@ end; function TsWorksheet.GetLastOccupiedRowIndex: Cardinal; var AVLNode: TAVLTreeNode; - i: Integer; begin Result := 0; AVLNode := FCells.FindHighest; @@ -4994,7 +4991,7 @@ var cellnode: TAVLTreeNode; col: PCol; i: Integer; - r, c, rr, cc: Cardinal; + r, rr, cc: Cardinal; r1, c1, r2, c2: Cardinal; cell, nextcell, basecell: PCell; firstRow, lastCol, lastRow: Cardinal; @@ -5083,7 +5080,7 @@ var cellnode: TAVLTreeNode; row: PRow; i: Integer; - r, c, rr, cc: Cardinal; + c, rr, cc: Cardinal; r1, c1, r2, c2: Cardinal; firstCol, lastCol, lastRow: Cardinal; cell, nextcell, basecell: PCell; @@ -5174,10 +5171,9 @@ var cellnode: TAVLTreeNode; col: PCol; i: Integer; - r, c, cc: Cardinal; - r1, c1, r2, c2: Cardinal; - rFirst, rLast, cLast: Cardinal; - cell, nextcell, gapcell, oldbase, newbase: PCell; + r, c: Cardinal; + rFirst, rLast: Cardinal; + cell, nextcell, gapcell: PCell; begin // Handling of shared formula references is too complicated for me... // Splits them into isolated cell formulas @@ -5211,7 +5207,6 @@ begin begin rFirst := GetFirstRowIndex; rLast := GetLastOccupiedRowIndex; - cLast := GetlastOccupiedColIndex; c := ACol - 1; // Seek along the column immediately to the left of the inserted column for r := rFirst to rLast do @@ -5240,11 +5235,11 @@ end; procedure TsWorksheet.InsertColCallback(data, arg: Pointer); var cell: PCell; - col: PtrInt; + col: Cardinal; formula: TsRPNFormula; i: Integer; begin - col := PtrInt(arg); + col := Cardinal(PtrInt(arg)); cell := PCell(data); if cell = nil then // This should not happen. Just to make sure... exit; @@ -5288,7 +5283,7 @@ var row: PRow; cellnode: TAVLTreeNode; i: Integer; - r, c, cc, r1, c1, r2, c2: Cardinal; + r, c: Cardinal; cell, nextcell, gapcell: PCell; begin // Handling of shared formula references is too complicated for me... @@ -5349,11 +5344,11 @@ end; procedure TsWorksheet.InsertRowCallback(data, arg: Pointer); var cell: PCell; - row: PtrInt; + row: Cardinal; i: Integer; formula: TsRPNFormula; begin - row := PtrInt(arg); + row := Cardinal(PtrInt(arg)); cell := PCell(data); // Update row index of moved cells @@ -5614,7 +5609,7 @@ begin FormatSettings.LongDateFormat := MakeLongDateFormat(FormatSettings.ShortDateFormat); UseDefaultPalette; FFontList := TFPList.Create; - SetDefaultFont('Arial', 10.0); + SetDefaultFont(DEFAULTFONTNAME, DEFAULTFONTSIZE); InitFonts; end; @@ -6572,7 +6567,6 @@ type TRgba = packed record R,G,B,A: Byte; end; var i: Integer; - c: TsColorvalue; begin // Find color value in default palette for i:=0 to High(DEFAULT_PALETTE) do @@ -7200,7 +7194,7 @@ begin { A good starting point valid for many formats ... } FLimitations.MaxColCount := 256; FLimitations.MaxRowCount := 65536; - FLimitations.MaxPaletteSize := $FFFFFFFF; + FLimitations.MaxPaletteSize := MaxInt; // Number formats CreateNumFormatList; end; @@ -7296,7 +7290,6 @@ const EPS = 1E-3; var r: Cardinal; - rLast: Cardinal; h: Single; begin if AWorksheet.Rows.Count <= 1 then diff --git a/components/fpspreadsheet/wikitable.pas b/components/fpspreadsheet/wikitable.pas index 0b080e1a6..6c107195c 100644 --- a/components/fpspreadsheet/wikitable.pas +++ b/components/fpspreadsheet/wikitable.pas @@ -378,10 +378,10 @@ procedure TsWikiTableWriter.WriteToStrings_WikiMedia(AStrings: TStrings); const // (cbNorth, cbWest, cbEast, cbSouth, cbDiagUp, cbDiagDown) BORDERNAMES: array[TsCellBorder] of string = - ('top', 'left', 'right', 'south', '', ''); + ('top', 'left', 'right', 'bottom', '', ''); // (lsThin, lsMedium, lsDashed, lsDotted, lsThick, lsDouble, lsHair) LINESTYLES: array[TsLineStyle] of string = - ('1pt solid', 'medium', 'dahsed', 'dotted', 'thick', 'double', 'dashed'); + ('1pt solid', 'medium solid', 'dashed', 'dotted', 'thick solid', 'double', 'dotted'); var ls: TsLineStyle; clr: TsColor; @@ -396,51 +396,99 @@ procedure TsWikiTableWriter.WriteToStrings_WikiMedia(AStrings: TStrings); const PIPE_CHAR: array[boolean] of String = ('|', '!'); var - i, j: Integer; + i, j: cardinal; lCurStr: string = ''; lCurUsedFormatting: TsUsedFormattingFields; lCurColor: TsColor; lStyleStr: String; lColSpanStr: String; lRowSpanStr: String; + lColWidthStr: String; + lRowHeightStr: String; lCell: PCell; + lCol: PCol; + lRow: PRow; lFont: TsFont; horalign: TsHorAlignment; vertalign: TsVertAlignment; - r1,c1,r2,c2: Cardinal; - isBold: Boolean; + r1, c1, r2, c2: Cardinal; + isHeader: Boolean; begin - AStrings.Add('{| border="1" cellpadding="2" class="wikitable sortable"'); FWorksheet := Workbook.GetFirstWorksheet(); FWorksheet.UpdateCaches; - r1 := 0; - c1 := 0; - r2 := 0; - c2 := 0; + AStrings.Add(''); + + // Show/hide grid lines + if soShowGridLines in FWorksheet.Options then + lCurStr := '{| class="wikitable"' // sortable"' + else + lCurStr := '{| border="0" cellpadding="2"'; + + // Default font + lStyleStr := ''; + lFont := FWorkbook.GetDefaultFont; + if fssBold in lFont.Style then + lStyleStr := lStyleStr + 'font-weight:bold;'; + if fssItalic in lFont.Style then + lStyleStr := lStyleStr + 'font-style:italic;'; + if fssUnderline in lFont.Style then + lStyleStr := lStyleStr + 'text-decoration:underline;'; + if lFont.Size <> DEFAULTFONTSIZE then + lStyleStr := lStyleStr + Format('font-size:%.0fpt;', [lFont.Size]); + if lStyleStr <> '' then + lCurStr := lCurStr + ' style="' + lStyleStr + '"'; + + AStrings.Add(lCurStr); for i := 0 to FWorksheet.GetLastRowIndex() do begin AStrings.Add('|-'); + for j := 0 to FWorksheet.GetLastColIndex do begin lCell := FWorksheet.FindCell(i, j); lCurStr := FWorksheet.ReadAsUTF8Text(lCell); + if lCurStr = '' then lCurStr := ' '; lStyleStr := ''; lColSpanStr := ''; lRowSpanStr := ''; + lColWidthStr := ''; + lRowHeightStr := ''; lCurUsedFormatting := FWorksheet.ReadUsedFormatting(lCell); + // Row header + isHeader := (soHasFrozenPanes in FWorksheet.Options) and + ((i < cardinal(FWorksheet.TopPaneHeight)) or (j < cardinal(FWorksheet.LeftPaneWidth))); + + // Column width (to be considered in first row) + if i = 0 then + begin + lCol := FWorksheet.FindCol(j); + if lCol <> nil then + lColWidthStr := Format(' width="%.0fpt"', [lCol^.Width*FWorkbook.GetDefaultFontSize*0.5]); + end; + + // Row height (to be considered in first column) + if j = 0 then + begin + lRow := FWorksheet.FindRow(i); + if lRow <> nil then + lRowHeightStr := Format(' height="%.0fpt"', [lRow^.Height*FWorkbook.GetDefaultFontSize]); + end; + // Font + lFont := FWorkbook.GetDefaultFont; if (uffFont in lCurUsedFormatting) then begin lFont := FWorkbook.GetFont(lCell^.FontIndex); - isBold := fssBold in lFont.Style; + if fssBold in lFont.Style then lCurStr := '' + lCurStr + ''; + if fssItalic in lFont.Style then lCurStr := '' + lCurStr + ''; + if fssUnderline in lFont.Style then lCurStr := '' + lCurStr + ''; + if fssStrikeout in lFont.Style then lCurStr := '' + lCurStr + ''; end else - begin - lFont := FWorkbook.GetDefaultFont; - isBold := (uffBold in lCurUsedFormatting); - end; + if uffBold in lCurUsedFormatting then + lCurStr := '' + lCurStr + ''; // Background color if uffBackgroundColor in lCurUsedFormatting then @@ -464,7 +512,7 @@ begin else horAlign := haLeft; end; case horAlign of - haLeft : ; // cells are left-aligned by default + haLeft : lStyleStr := lStyleStr + 'text-align:left;'; haCenter : lStyleStr := lStyleStr + 'text-align:center;'; haRight : lStyleStr := lStyleStr + 'text-align:right'; end; @@ -476,7 +524,7 @@ begin vertAlign := lCell^.VertAlignment; case vertAlign of vaTop : lStyleStr := lStyleStr + 'vertical-align:top;'; - //vaCenter : lStyleStr := lStyleStr + 'vertical-align:center;'; default is center + vaCenter : lStyleStr := lStyleStr + 'vertical-align:center;'; vaBottom : lStyleStr := lStyleStr + 'vertical-align:bottom;'; end; end; @@ -485,13 +533,13 @@ begin if uffBorder in lCurUsedFormatting then begin if (cbWest in lCell^.Border) then - lStyleStr := lStyleStr + DoBorder(cbWest,lCell); + lStyleStr := lStyleStr + DoBorder(cbWest, lCell); if (cbEast in lCell^.Border) then - lStyleStr := lStyleStr + DoBorder(cbEast,lCell); + lStyleStr := lStyleStr + DoBorder(cbEast, lCell); if (cbNorth in lCell^.Border) then - lStyleStr := lStyleStr + DoBorder(cbNorth,lCell); + lStyleStr := lStyleStr + DoBorder(cbNorth, lCell); if (cbSouth in lCell^.Border) then - lStyleStr := lStyleStr + DoBorder(cbSouth,lCell); + lStyleStr := lStyleStr + DoBorder(cbSouth, lCell); end; // Merged cells @@ -506,7 +554,7 @@ begin lColSpanStr := Format(' colspan="%d"', [c2-c1+1]); end else - if (i > r1) or (j > c1) then + if (i >= r1) and (i <= r2) and (j >= c1) and (j <= c2) then Continue; end; @@ -520,13 +568,19 @@ begin if lColSpanStr <> '' then lStyleStr := lColSpanStr + lStyleStr; + if lColWidthStr <> '' then + lStyleStr := lColWidthStr + lStyleStr; + + if lRowHeightStr <> '' then + lStyleStr := lRowHeightStr + lStyleStr; + if lCurStr <> '' then lCurStr := ' ' + lCurStr; if lStyleStr <> '' then lCurStr := lStyleStr + ' |' + lCurStr; - lCurStr := PIPE_CHAR[isBold] + lCurStr; + lCurStr := PIPE_CHAR[isHeader] + lCurStr; // Add to list AStrings.Add(lCurStr);