pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Complete writing of all cell styles to wikitables (except for text rotation). Some cleanup of compiler warnings.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3606 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-09-26 13:47:47 +00:00
parent 5e4d7d4825
commit e9ae26952f
5 changed files with 280 additions and 165 deletions
Download Patch File Download Diff File Expand all files Collapse all files

179
components/fpspreadsheet/examples/wikitabledemo/wikitablewrite.lpr
View File

@ -12,81 +12,158 @@ program wikitablewrite;
uses uses
Classes, SysUtils, fpspreadsheet, wikitable; 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 var
MyWorkbook: TsWorkbook; MyWorkbook: TsWorkbook;
MyWorksheet: TsWorksheet; MyWorksheet: TsWorksheet;
MyRPNFormula: TsRPNFormula;
MyDir: string; MyDir: string;
number: Double; row: Integer;
lCell: PCell;
lCol: TCol;
i: Integer;
r: Integer = 10;
s: String;
begin begin
MyDir := ExtractFilePath(ParamStr(0)); MyDir := ExtractFilePath(ParamStr(0));
// Create the spreadsheet // Create the spreadsheet
MyWorkbook := TsWorkbook.Create; 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 // Write some cells
MyWorksheet.WriteUTF8Text(0, 0, 'This is a text:'); row := 0;
MyWorksheet.WriteUTF8Text(0, 1, 'Hello world!');
MyWorksheet.WriteUTF8Text(1, 0, 'This is bold text:'); MyWorksheet.WriteBlank(row, 0);
Myworksheet.WriteUTF8Text(1, 1, 'Hello world!'); MyWorksheet.WriteUTF8Text(row, 1, 'Description');
Myworksheet.WriteFontStyle(1, 1, [fssBold]); MyWorksheet.WriteUTF8Text(row, 2, 'Example');
inc(row);
MyWorksheet.WriteUTF8Text(2, 0, 'This is a number:'); MyWorksheet.WriteNumber(row, 0, row);
MyWorksheet.WriteNumber(2, 1, 3.141592); MyWorksheet.WriteUTF8Text(row, 1, 'This is a text:');
MyWorksheet.WriteBackgroundColor(2, 1, scMagenta); MyWorksheet.WriteUTF8Text(row, 2, 'Hello world!');
Myworksheet.WriteHorAlignment(2, 1, haRight); inc(row);
MyWorksheet.WriteUTF8Text(3, 0, 'This is a date:'); MyWorksheet.WriteNumber(row, 0, row);
Myworksheet.WriteDateTime(3, 1, date()); 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.WriteNumber(row, 0, row);
MyWorksheet.WriteUTF8Text(4, 1, 'A very, very, very, very long text, indeed'); 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.WriteNumber(row, 0, row);
Myworksheet.WriteVertAlignment(5, 0, vaTop); 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,<br /> 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.WriteNumber(row, 0, row);
Myworksheet.MergeCells(6, 0, 7, 0); MyWorksheet.WriteUTF8Text(row, 1, 'Centered text:');
MyWorksheet.WriteUTF8Text(6, 1, 'A'); MyWorksheet.WriteUTF8Text(row, 2, 'I am in the center.');
MyWorksheet.WriteUTF8Text(7, 1, 'B'); MyWorksheet.WriteHorAlignment(row, 2, haCenter);
inc(row);
MyWorksheet.WriteUTF8Text(8, 0, 'Merged columns'); MyWorksheet.WriteNumber(row, 0, row);
MyWorksheet.WriteHorAlignment(8, 0, haCenter); MyWorksheet.WriteUTF8Text(row, 1, 'This is a long text with line break:');
MyWorksheet.MergeCells(8, 0, 8, 1); Myworksheet.WriteVertAlignment(row, 1, vaTop);
MyWorksheet.WriteUTF8Text(row, 2, 'A very, very, very, very long text,<br /> indeed');
inc(row);
MyWorksheet.WriteUTF8Text(10, 0, 'Right borders:'); MyWorksheet.WriteNumber(row, 0, row);
MyWorksheet.WriteBorders(10, 0, [cbEast]); 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.WriteNumber(row, 0, row);
MyWorksheet.WriteBorders(10, 1, [cbEast]); MyWorksheet.WriteUTF8Text(row, 1, 'Merged columns');
MyWorksheet.WriteBorderLineStyle(10, 1, cbEast, lsMedium); MyWorksheet.WriteHorAlignment(row, 1, haCenter);
MyWorksheet.WriteBorderColor(10, 1, cbEast, scBlue); MyWorksheet.MergeCells(row, 1, row, 2);
inc(row);
MyWorksheet.WriteUTF8Text(11, 0, 'Top borders:'); MyWorksheet.WriteNumber(row, 0, row);
MyWorksheet.WriteBorders(11, 0, [cbNorth]); MyWorksheet.WriteUTF8Text(row, 1, 'Right border:');
MyWorksheet.WriteBorderLineStyle(11, 0, cbNorth, lsDashed); 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.WriteNumber(row, 0, row);
MyWorksheet.WriteBorders(11, 1, [cbNorth]); MyWorksheet.WriteUTF8Text(row, 1, 'Top border:');
MyWorksheet.WriteBorderLineStyle(11, 1, cbNorth, lsDotted); 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 // Save the spreadsheet to a file
MyWorkbook.WriteToFile(MyDir + 'test.wikitable_wikimedia', sfWikitable_wikimedia); MyWorkbook.WriteToFile(MyDir + 'test.wikitable_wikimedia', sfWikitable_wikimedia);

118
components/fpspreadsheet/fpsexprparser.pas
View File

@ -112,7 +112,7 @@ type
procedure CheckNodeType(ANode: TsExprNode; Allowed: TsResultTypes); procedure CheckNodeType(ANode: TsExprNode; Allowed: TsResultTypes);
// A procedure with var saves an implicit try/finally in each node // A procedure with var saves an implicit try/finally in each node
// A marked difference in execution speed. // A marked difference in execution speed.
procedure GetNodeValue(var Result: TsExpressionResult); virtual; abstract; procedure GetNodeValue(out Result: TsExpressionResult); virtual; abstract;
public public
function AsRPNItem(ANext: PRPNItem): PRPNItem; virtual; abstract; function AsRPNItem(ANext: PRPNItem): PRPNItem; virtual; abstract;
function AsString: string; virtual; abstract; function AsString: string; virtual; abstract;
@ -160,7 +160,7 @@ type
{ TsEqualExprNode } { TsEqualExprNode }
TsEqualExprNode = class(TsBooleanResultExprNode) TsEqualExprNode = class(TsBooleanResultExprNode)
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: string; override; function AsString: string; override;
@ -169,7 +169,7 @@ type
{ TsNotEqualExprNode } { TsNotEqualExprNode }
TsNotEqualExprNode = class(TsEqualExprNode) TsNotEqualExprNode = class(TsEqualExprNode)
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: string; override; function AsString: string; override;
@ -184,7 +184,7 @@ type
{ TsLessExprNode } { TsLessExprNode }
TsLessExprNode = class(TsOrderingExprNode) TsLessExprNode = class(TsOrderingExprNode)
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: string; override; function AsString: string; override;
@ -193,7 +193,7 @@ type
{ TsGreaterExprNode } { TsGreaterExprNode }
TsGreaterExprNode = class(TsOrderingExprNode) TsGreaterExprNode = class(TsOrderingExprNode)
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: string; override; function AsString: string; override;
@ -202,7 +202,7 @@ type
{ TsLessEqualExprNode } { TsLessEqualExprNode }
TsLessEqualExprNode = class(TsGreaterExprNode) TsLessEqualExprNode = class(TsGreaterExprNode)
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: string; override; function AsString: string; override;
@ -211,7 +211,7 @@ type
{ TsGreaterEqualExprNode } { TsGreaterEqualExprNode }
TsGreaterEqualExprNode = class(TsLessExprNode) TsGreaterEqualExprNode = class(TsLessExprNode)
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: string; override; function AsString: string; override;
@ -221,7 +221,7 @@ type
TsConcatExprNode = class(TsBinaryOperationExprNode) TsConcatExprNode = class(TsBinaryOperationExprNode)
protected protected
procedure CheckSameNodeTypes; override; procedure CheckSameNodeTypes; override;
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: string ; override; function AsString: string ; override;
@ -241,7 +241,7 @@ type
{ TsAddExprNode } { TsAddExprNode }
TsAddExprNode = class(TsMathOperationExprNode) TsAddExprNode = class(TsMathOperationExprNode)
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: string ; override; function AsString: string ; override;
@ -250,7 +250,7 @@ type
{ TsSubtractExprNode } { TsSubtractExprNode }
TsSubtractExprNode = class(TsMathOperationExprNode) TsSubtractExprNode = class(TsMathOperationExprNode)
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: string ; override; function AsString: string ; override;
@ -259,7 +259,7 @@ type
{ TsMultiplyExprNode } { TsMultiplyExprNode }
TsMultiplyExprNode = class(TsMathOperationExprNode) TsMultiplyExprNode = class(TsMathOperationExprNode)
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: string ; override; function AsString: string ; override;
@ -268,7 +268,7 @@ type
{ TsDivideExprNode } { TsDivideExprNode }
TsDivideExprNode = class(TsMathOperationExprNode) TsDivideExprNode = class(TsMathOperationExprNode)
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: string ; override; function AsString: string ; override;
@ -278,7 +278,7 @@ type
{ TsPowerExprNode } { TsPowerExprNode }
TsPowerExprNode = class(TsMathOperationExprNode) TsPowerExprNode = class(TsMathOperationExprNode)
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: string ; override; function AsString: string ; override;
@ -305,7 +305,7 @@ type
{ TsNotExprNode } { TsNotExprNode }
TsNotExprNode = class(TsUnaryOperationExprNode) TsNotExprNode = class(TsUnaryOperationExprNode)
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: String; override; function AsString: String; override;
@ -322,7 +322,7 @@ type
{ TsIntToFloatExprNode } { TsIntToFloatExprNode }
TsIntToFloatExprNode = class(TsConvertToIntExprNode) TsIntToFloatExprNode = class(TsConvertToIntExprNode)
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
function NodeType: TsResultType; override; function NodeType: TsResultType; override;
end; end;
@ -330,7 +330,7 @@ type
{ TsIntToDateTimeExprNode } { TsIntToDateTimeExprNode }
TsIntToDateTimeExprNode = class(TsConvertToIntExprNode) TsIntToDateTimeExprNode = class(TsConvertToIntExprNode)
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
function NodeType: TsResultType; override; function NodeType: TsResultType; override;
end; end;
@ -338,7 +338,7 @@ type
{ TsFloatToDateTimeExprNode } { TsFloatToDateTimeExprNode }
TsFloatToDateTimeExprNode = class(TsConvertExprNode) TsFloatToDateTimeExprNode = class(TsConvertExprNode)
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
procedure Check; override; procedure Check; override;
function NodeType: TsResultType; override; function NodeType: TsResultType; override;
@ -347,7 +347,7 @@ type
{ TsUPlusExprNode } { TsUPlusExprNode }
TsUPlusExprNode = class(TsUnaryOperationExprNode) TsUPlusExprNode = class(TsUnaryOperationExprNode)
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: String; override; function AsString: String; override;
@ -358,7 +358,7 @@ type
{ TsUMinusExprNode } { TsUMinusExprNode }
TsUMinusExprNode = class(TsUnaryOperationExprNode) TsUMinusExprNode = class(TsUnaryOperationExprNode)
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: String; override; function AsString: String; override;
@ -369,7 +369,7 @@ type
{ TsPercentExprNode } { TsPercentExprNode }
TsPercentExprNode = class(TsUnaryOperationExprNode) TsPercentExprNode = class(TsUnaryOperationExprNode)
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: String; override; function AsString: String; override;
@ -380,7 +380,7 @@ type
{ TsParenthesisExprNode } { TsParenthesisExprNode }
TsParenthesisExprNode = class(TsUnaryOperationExprNode) TsParenthesisExprNode = class(TsUnaryOperationExprNode)
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: String; override; function AsString: String; override;
@ -392,7 +392,7 @@ type
private private
FValue: TsExpressionResult; FValue: TsExpressionResult;
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
procedure Check; override; procedure Check; override;
constructor CreateString(AParser: TsExpressionParser; AValue: String); constructor CreateString(AParser: TsExpressionParser; AValue: String);
@ -529,7 +529,7 @@ type
PResult: PsExpressionResult; PResult: PsExpressionResult;
FResultType: TsResultType; FResultType: TsResultType;
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
constructor CreateIdentifier(AParser: TsExpressionParser; AID: TsExprIdentifierDef); constructor CreateIdentifier(AParser: TsExpressionParser; AID: TsExprIdentifierDef);
function NodeType: TsResultType; override; function NodeType: TsResultType; override;
@ -567,7 +567,7 @@ type
private private
FCallBack: TsExprFunctionCallBack; FCallBack: TsExprFunctionCallBack;
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
constructor CreateFunction(AParser: TsExpressionParser; constructor CreateFunction(AParser: TsExpressionParser;
AID: TsExprIdentifierDef; const Args: TsExprArgumentArray); override; AID: TsExprIdentifierDef; const Args: TsExprArgumentArray); override;
@ -579,7 +579,7 @@ type
private private
FCallBack: TsExprFunctionEvent; FCallBack: TsExprFunctionEvent;
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
constructor CreateFunction(AParser: TsExpressionParser; constructor CreateFunction(AParser: TsExpressionParser;
AID: TsExprIdentifierDef; const Args: TsExprArgumentArray); override; AID: TsExprIdentifierDef; const Args: TsExprArgumentArray); override;
@ -597,7 +597,7 @@ type
protected protected
function GetCol: Cardinal; function GetCol: Cardinal;
function GetRow: Cardinal; function GetRow: Cardinal;
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
constructor Create(AParser: TsExpressionParser; AWorksheet: TsWorksheet; constructor Create(AParser: TsExpressionParser; AWorksheet: TsWorksheet;
ACellString: String); overload; ACellString: String); overload;
@ -618,7 +618,7 @@ type
FCol1, FCol2: Cardinal; FCol1, FCol2: Cardinal;
FFlags: TsRelFlags; FFlags: TsRelFlags;
protected protected
procedure GetNodeValue(var Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
public public
constructor Create(AParser: TsExpressionParser; AWorksheet: TsWorksheet; constructor Create(AParser: TsExpressionParser; AWorksheet: TsWorksheet;
ACellRangeString: String); overload; ACellRangeString: String); overload;
@ -730,7 +730,7 @@ type
function IdentifierByName(AName: ShortString): TsExprIdentifierDef; virtual; function IdentifierByName(AName: ShortString): TsExprIdentifierDef; virtual;
procedure Clear; procedure Clear;
function Evaluate: TsExpressionResult; function Evaluate: TsExpressionResult;
procedure EvaluateExpression(var Result: TsExpressionResult); procedure EvaluateExpression(out Result: TsExpressionResult);
function ResultType: TsResultType; function ResultType: TsResultType;
function SharedFormulaMode: Boolean; function SharedFormulaMode: Boolean;
@ -995,7 +995,6 @@ end;
function TsExpressionScanner.DoError: TsTokenType; function TsExpressionScanner.DoError: TsTokenType;
var var
C: Char; C: Char;
s: String;
begin begin
C := CurrentChar; C := CurrentChar;
while (not IsWordDelim(C)) and (C <> cNull) do while (not IsWordDelim(C)) and (C <> cNull) do
@ -1003,7 +1002,6 @@ begin
FToken := FToken + C; FToken := FToken + C;
C := NextPos; C := NextPos;
end; end;
S := UpperCase(Token);
Result := ttError; Result := ttError;
end; end;
@ -1338,7 +1336,7 @@ begin
EvaluateExpression(Result); EvaluateExpression(Result);
end; end;
procedure TsExpressionParser.EvaluateExpression(var Result: TsExpressionResult); procedure TsExpressionParser.EvaluateExpression(out Result: TsExpressionResult);
begin begin
if (FExpression = '') then if (FExpression = '') then
ParserError(SErrInExpressionEmpty); ParserError(SErrInExpressionEmpty);
@ -1403,14 +1401,9 @@ begin
end; end;
function TsExpressionParser.IdentifierByName(AName: ShortString): TsExprIdentifierDef; function TsExpressionParser.IdentifierByName(AName: ShortString): TsExprIdentifierDef;
var
s: String;
begin begin
if FDirty then if FDirty then
CreateHashList; CreateHashList;
s := FHashList.NameOfIndex(0);
s := FHashList.NameOfIndex(25);
s := FHashList.NameOfIndex(36);
Result := TsExprIdentifierDef(FHashList.Find(UpperCase(AName))); Result := TsExprIdentifierDef(FHashList.Find(UpperCase(AName)));
end; end;
@ -1545,7 +1538,6 @@ end;
function TsExpressionParser.Level5: TsExprNode; function TsExpressionParser.Level5: TsExprNode;
var var
isPlus, isMinus: Boolean; isPlus, isMinus: Boolean;
tt: TsTokenType;
begin begin
{$ifdef debugexpr} Writeln('Level 5 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr} {$ifdef debugexpr} Writeln('Level 5 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
isPlus := false; isPlus := false;
@ -2693,7 +2685,7 @@ begin
Result := FValue.ResultType; Result := FValue.ResultType;
end; end;
procedure TsConstExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsConstExprNode.GetNodeValue(out Result: TsExpressionResult);
begin begin
Result := FValue; Result := FValue;
end; end;
@ -2747,7 +2739,7 @@ begin
RaiseParserError(SErrNoUPlus, [ResultTypeName(Operand.NodeType), Operand.AsString]) RaiseParserError(SErrNoUPlus, [ResultTypeName(Operand.NodeType), Operand.AsString])
end; end;
procedure TsUPlusExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsUPlusExprNode.GetNodeValue(out Result: TsExpressionResult);
var var
cell: PCell; cell: PCell;
begin begin
@ -2806,7 +2798,7 @@ begin
RaiseParserError(SErrNoNegation, [ResultTypeName(Operand.NodeType), Operand.AsString]) RaiseParserError(SErrNoNegation, [ResultTypeName(Operand.NodeType), Operand.AsString])
end; end;
procedure TsUMinusExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsUMinusExprNode.GetNodeValue(out Result: TsExpressionResult);
var var
cell: PCell; cell: PCell;
begin begin
@ -2867,7 +2859,7 @@ begin
RaiseParserError(SErrNoPercentOperation, [ResultTypeName(Operand.NodeType), Operand.AsString]) RaiseParserError(SErrNoPercentOperation, [ResultTypeName(Operand.NodeType), Operand.AsString])
end; end;
procedure TsPercentExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsPercentExprNode.GetNodeValue(out Result: TsExpressionResult);
begin begin
Operand.GetNodeValue(Result); Operand.GetNodeValue(Result);
case Result.ResultType of case Result.ResultType of
@ -2906,7 +2898,7 @@ begin
Result := Operand.NodeType; Result := Operand.NodeType;
end; end;
procedure TsParenthesisExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsParenthesisExprNode.GetNodeValue(out Result: TsExpressionResult);
begin begin
Result := Operand.NodeValue; Result := Operand.NodeValue;
end; end;
@ -2935,7 +2927,7 @@ begin
RaiseParserError(SErrNoNotOperation, [ResultTypeName(Operand.NodeType), Operand.AsString]) RaiseParserError(SErrNoNotOperation, [ResultTypeName(Operand.NodeType), Operand.AsString])
end; end;
procedure TsNotExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsNotExprNode.GetNodeValue(out Result: TsExpressionResult);
begin begin
Operand.GetNodeValue(Result); Operand.GetNodeValue(Result);
case Result.ResultType of case Result.ResultType of
@ -2985,7 +2977,7 @@ begin
Result := Left.AsString + '=' + Right.AsString; Result := Left.AsString + '=' + Right.AsString;
end; end;
procedure TsEqualExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsEqualExprNode.GetNodeValue(out Result: TsExpressionResult);
var var
RRes: TsExpressionResult; RRes: TsExpressionResult;
begin begin
@ -3038,7 +3030,7 @@ begin
Result := Left.AsString + '<>' + Right.AsString; Result := Left.AsString + '<>' + Right.AsString;
end; end;
procedure TsNotEqualExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsNotEqualExprNode.GetNodeValue(out Result: TsExpressionResult);
begin begin
inherited GetNodeValue(Result); inherited GetNodeValue(Result);
Result.ResBoolean := not Result.ResBoolean; Result.ResBoolean := not Result.ResBoolean;
@ -3074,7 +3066,7 @@ begin
Result := Left.AsString + '<' + Right.AsString; Result := Left.AsString + '<' + Right.AsString;
end; end;
procedure TsLessExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsLessExprNode.GetNodeValue(out Result: TsExpressionResult);
var var
RRes: TsExpressionResult; RRes: TsExpressionResult;
begin begin
@ -3121,7 +3113,7 @@ begin
Result := Left.AsString + '>' + Right.AsString; Result := Left.AsString + '>' + Right.AsString;
end; end;
procedure TsGreaterExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsGreaterExprNode.GetNodeValue(out Result: TsExpressionResult);
var var
RRes: TsExpressionResult; RRes: TsExpressionResult;
begin begin
@ -3168,7 +3160,7 @@ begin
Result := Left.AsString + '>=' + Right.AsString; Result := Left.AsString + '>=' + Right.AsString;
end; end;
procedure TsGreaterEqualExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsGreaterEqualExprNode.GetNodeValue(out Result: TsExpressionResult);
begin begin
inherited GetNodeValue(Result); inherited GetNodeValue(Result);
Result.ResBoolean := not Result.ResBoolean; Result.ResBoolean := not Result.ResBoolean;
@ -3191,7 +3183,7 @@ begin
Result := Left.AsString + '<=' + Right.AsString; Result := Left.AsString + '<=' + Right.AsString;
end; end;
procedure TsLessEqualExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsLessEqualExprNode.GetNodeValue(out Result: TsExpressionResult);
begin begin
inherited GetNodeValue(Result); inherited GetNodeValue(Result);
Result.ResBoolean := not Result.ResBoolean; Result.ResBoolean := not Result.ResBoolean;
@ -3225,7 +3217,7 @@ begin
// Same node types are checked in GetNodevalue // Same node types are checked in GetNodevalue
end; end;
procedure TsConcatExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsConcatExprNode.GetNodeValue(out Result: TsExpressionResult);
var var
RRes : TsExpressionResult; RRes : TsExpressionResult;
begin begin
@ -3287,7 +3279,7 @@ begin
Result := Left.AsString + '+' + Right.AsString; Result := Left.AsString + '+' + Right.AsString;
end; end;
procedure TsAddExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsAddExprNode.GetNodeValue(out Result: TsExpressionResult);
var var
RRes: TsExpressionResult; RRes: TsExpressionResult;
begin begin
@ -3330,7 +3322,7 @@ begin
Result := Left.AsString + '-' + Right.asString; Result := Left.AsString + '-' + Right.asString;
end; end;
procedure TsSubtractExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsSubtractExprNode.GetNodeValue(out Result: TsExpressionResult);
var var
RRes: TsExpressionResult; RRes: TsExpressionResult;
begin begin
@ -3373,7 +3365,7 @@ begin
Result := Left.AsString + '*' + Right.AsString; Result := Left.AsString + '*' + Right.AsString;
end; end;
procedure TsMultiplyExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsMultiplyExprNode.GetNodeValue(out Result: TsExpressionResult);
var var
RRes: TsExpressionResult; RRes: TsExpressionResult;
begin begin
@ -3416,7 +3408,7 @@ begin
Result := Left.AsString + '/' + Right.asString; Result := Left.AsString + '/' + Right.asString;
end; end;
procedure TsDivideExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsDivideExprNode.GetNodeValue(out Result: TsExpressionResult);
var var
RRes: TsExpressionResult; RRes: TsExpressionResult;
y: TsExprFloat; y: TsExprFloat;
@ -3465,7 +3457,7 @@ begin
Result := Left.AsString + '^' + Right.AsString; Result := Left.AsString + '^' + Right.AsString;
end; end;
procedure TsPowerExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsPowerExprNode.GetNodeValue(out Result: TsExpressionResult);
var var
RRes: TsExpressionResult; RRes: TsExpressionResult;
begin begin
@ -3517,7 +3509,7 @@ begin
CheckNodeType(Operand, [rtInteger, rtCell]) CheckNodeType(Operand, [rtInteger, rtCell])
end; end;
procedure TsIntToFloatExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsIntToFloatExprNode.GetNodeValue(out Result: TsExpressionResult);
begin begin
Operand.GetNodeValue(Result); Operand.GetNodeValue(Result);
if Result.ResultType in [rtInteger, rtCell] then if Result.ResultType in [rtInteger, rtCell] then
@ -3537,7 +3529,7 @@ begin
Result := rtDatetime; Result := rtDatetime;
end; end;
procedure TsIntToDateTimeExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsIntToDateTimeExprNode.GetNodeValue(out Result: TsExpressionResult);
begin begin
Operand.GetnodeValue(Result); Operand.GetnodeValue(Result);
if Result.ResultType in [rtInteger, rtCell] then if Result.ResultType in [rtInteger, rtCell] then
@ -3558,7 +3550,7 @@ begin
Result := rtDateTime; Result := rtDateTime;
end; end;
procedure TsFloatToDateTimeExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsFloatToDateTimeExprNode.GetNodeValue(out Result: TsExpressionResult);
begin begin
Operand.GetNodeValue(Result); Operand.GetNodeValue(Result);
if Result.ResultType in [rtFloat, rtCell] then if Result.ResultType in [rtFloat, rtCell] then
@ -3582,7 +3574,7 @@ begin
Result := FResultType; Result := FResultType;
end; end;
procedure TsIdentifierExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsIdentifierExprNode.GetNodeValue(out Result: TsExpressionResult);
begin begin
Result := PResult^; Result := PResult^;
Result.ResultType := FResultType; Result.ResultType := FResultType;
@ -3735,7 +3727,7 @@ begin
FCallBack := AID.OnGetFunctionValueCallBack; FCallBack := AID.OnGetFunctionValueCallBack;
end; end;
procedure TsFunctionCallBackExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsFunctionCallBackExprNode.GetNodeValue(out Result: TsExpressionResult);
begin begin
Result.ResultType := NodeType; // was at end! Result.ResultType := NodeType; // was at end!
if Length(FArgumentParams) > 0 then if Length(FArgumentParams) > 0 then
@ -3753,7 +3745,7 @@ begin
FCallBack := AID.OnGetFunctionValue; FCallBack := AID.OnGetFunctionValue;
end; end;
procedure TFPFunctionEventHandlerExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TFPFunctionEventHandlerExprNode.GetNodeValue(out Result: TsExpressionResult);
begin begin
Result.ResultType := NodeType; // was at end Result.ResultType := NodeType; // was at end
if Length(FArgumentParams) > 0 then if Length(FArgumentParams) > 0 then
@ -3832,7 +3824,7 @@ begin
Result := FCol; Result := FCol;
end; end;
procedure TsCellExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsCellExprNode.GetNodeValue(out Result: TsExpressionResult);
var var
cell: PCell; cell: PCell;
begin begin
@ -3931,7 +3923,7 @@ begin
// Nothing to check; // Nothing to check;
end; end;
procedure TsCellRangeExprNode.GetNodeValue(var Result: TsExpressionResult); procedure TsCellRangeExprNode.GetNodeValue(out Result: TsExpressionResult);
var var
r,c: Cardinal; r,c: Cardinal;
cell: PCell; cell: PCell;

1
components/fpspreadsheet/fpsfunc.pas
View File

@ -1033,7 +1033,6 @@ var
n: Integer; n: Integer;
r, c: Cardinal; r, c: Cardinal;
cell: PCell; cell: PCell;
arg: TsExpressionResult;
begin begin
n := 0; n := 0;
case Args[0].ResultType of case Args[0].ResultType of

47
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -28,7 +28,7 @@ type
TsSpreadsheetFormatLimitations = record TsSpreadsheetFormatLimitations = record
MaxRowCount: Cardinal; MaxRowCount: Cardinal;
MaxColCount: Cardinal; MaxColCount: Cardinal;
MaxPaletteSize: Cardinal; MaxPaletteSize: Integer;
end; end;
const const
@ -42,6 +42,9 @@ const
MAX_COL_COUNT = 65535; MAX_COL_COUNT = 65535;
DEFAULTFONTNAME = 'Arial';
DEFAULTFONTSIZE = 10;
type type
{@@ Possible encodings for a non-unicode encoded text } {@@ Possible encodings for a non-unicode encoded text }
@ -1770,11 +1773,11 @@ end;
procedure TsWorksheet.DeleteColCallback(data, arg: Pointer); procedure TsWorksheet.DeleteColCallback(data, arg: Pointer);
var var
cell: PCell; cell: PCell;
col: PtrInt; col: Cardinal;
formula: TsRPNFormula; formula: TsRPNFormula;
i: Integer; i: Integer;
begin begin
col := PtrInt(arg); col := Cardinal(PtrInt(arg));
cell := PCell(data); cell := PCell(data);
if cell = nil then // This should not happen. Just to make sure... if cell = nil then // This should not happen. Just to make sure...
exit; exit;
@ -1825,11 +1828,11 @@ end;
procedure TsWorksheet.DeleteRowCallback(data, arg: Pointer); procedure TsWorksheet.DeleteRowCallback(data, arg: Pointer);
var var
cell: PCell; cell: PCell;
row: PtrInt; row: Cardinal;
formula: TsRPNFormula; formula: TsRPNFormula;
i: Integer; i: Integer;
begin begin
row := PtrInt(arg); row := Cardinal(PtrInt(arg));
cell := PCell(data); cell := PCell(data);
if cell = nil then // This should not happen. Just to make sure... if cell = nil then // This should not happen. Just to make sure...
exit; exit;
@ -2148,7 +2151,6 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsWorksheet.GetLastColIndex(AForceCalculation: Boolean = false): Cardinal; function TsWorksheet.GetLastColIndex(AForceCalculation: Boolean = false): Cardinal;
var var
AVLNode: TAVLTreeNode;
i: Integer; i: Integer;
begin begin
if AForceCalculation then if AForceCalculation then
@ -2192,9 +2194,6 @@ end;
function TsWorksheet.GetLastOccupiedColIndex: Cardinal; function TsWorksheet.GetLastOccupiedColIndex: Cardinal;
var var
AVLNode: TAVLTreeNode; AVLNode: TAVLTreeNode;
i: Integer;
c: Cardinal;
w: Single;
begin begin
Result := 0; Result := 0;
// Traverse the tree from lowest to highest. // Traverse the tree from lowest to highest.
@ -2300,7 +2299,6 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsWorksheet.GetLastRowIndex(AForceCalculation: Boolean = false): Cardinal; function TsWorksheet.GetLastRowIndex(AForceCalculation: Boolean = false): Cardinal;
var var
AVLNode: TAVLTreeNode;
i: Integer; i: Integer;
begin begin
if AForceCalculation then if AForceCalculation then
@ -2331,7 +2329,6 @@ end;
function TsWorksheet.GetLastOccupiedRowIndex: Cardinal; function TsWorksheet.GetLastOccupiedRowIndex: Cardinal;
var var
AVLNode: TAVLTreeNode; AVLNode: TAVLTreeNode;
i: Integer;
begin begin
Result := 0; Result := 0;
AVLNode := FCells.FindHighest; AVLNode := FCells.FindHighest;
@ -4994,7 +4991,7 @@ var
cellnode: TAVLTreeNode; cellnode: TAVLTreeNode;
col: PCol; col: PCol;
i: Integer; i: Integer;
r, c, rr, cc: Cardinal; r, rr, cc: Cardinal;
r1, c1, r2, c2: Cardinal; r1, c1, r2, c2: Cardinal;
cell, nextcell, basecell: PCell; cell, nextcell, basecell: PCell;
firstRow, lastCol, lastRow: Cardinal; firstRow, lastCol, lastRow: Cardinal;
@ -5083,7 +5080,7 @@ var
cellnode: TAVLTreeNode; cellnode: TAVLTreeNode;
row: PRow; row: PRow;
i: Integer; i: Integer;
r, c, rr, cc: Cardinal; c, rr, cc: Cardinal;
r1, c1, r2, c2: Cardinal; r1, c1, r2, c2: Cardinal;
firstCol, lastCol, lastRow: Cardinal; firstCol, lastCol, lastRow: Cardinal;
cell, nextcell, basecell: PCell; cell, nextcell, basecell: PCell;
@ -5174,10 +5171,9 @@ var
cellnode: TAVLTreeNode; cellnode: TAVLTreeNode;
col: PCol; col: PCol;
i: Integer; i: Integer;
r, c, cc: Cardinal; r, c: Cardinal;
r1, c1, r2, c2: Cardinal; rFirst, rLast: Cardinal;
rFirst, rLast, cLast: Cardinal; cell, nextcell, gapcell: PCell;
cell, nextcell, gapcell, oldbase, newbase: PCell;
begin begin
// Handling of shared formula references is too complicated for me... // Handling of shared formula references is too complicated for me...
// Splits them into isolated cell formulas // Splits them into isolated cell formulas
@ -5211,7 +5207,6 @@ begin
begin begin
rFirst := GetFirstRowIndex; rFirst := GetFirstRowIndex;
rLast := GetLastOccupiedRowIndex; rLast := GetLastOccupiedRowIndex;
cLast := GetlastOccupiedColIndex;
c := ACol - 1; c := ACol - 1;
// Seek along the column immediately to the left of the inserted column // Seek along the column immediately to the left of the inserted column
for r := rFirst to rLast do for r := rFirst to rLast do
@ -5240,11 +5235,11 @@ end;
procedure TsWorksheet.InsertColCallback(data, arg: Pointer); procedure TsWorksheet.InsertColCallback(data, arg: Pointer);
var var
cell: PCell; cell: PCell;
col: PtrInt; col: Cardinal;
formula: TsRPNFormula; formula: TsRPNFormula;
i: Integer; i: Integer;
begin begin
col := PtrInt(arg); col := Cardinal(PtrInt(arg));
cell := PCell(data); cell := PCell(data);
if cell = nil then // This should not happen. Just to make sure... if cell = nil then // This should not happen. Just to make sure...
exit; exit;
@ -5288,7 +5283,7 @@ var
row: PRow; row: PRow;
cellnode: TAVLTreeNode; cellnode: TAVLTreeNode;
i: Integer; i: Integer;
r, c, cc, r1, c1, r2, c2: Cardinal; r, c: Cardinal;
cell, nextcell, gapcell: PCell; cell, nextcell, gapcell: PCell;
begin begin
// Handling of shared formula references is too complicated for me... // Handling of shared formula references is too complicated for me...
@ -5349,11 +5344,11 @@ end;
procedure TsWorksheet.InsertRowCallback(data, arg: Pointer); procedure TsWorksheet.InsertRowCallback(data, arg: Pointer);
var var
cell: PCell; cell: PCell;
row: PtrInt; row: Cardinal;
i: Integer; i: Integer;
formula: TsRPNFormula; formula: TsRPNFormula;
begin begin
row := PtrInt(arg); row := Cardinal(PtrInt(arg));
cell := PCell(data); cell := PCell(data);
// Update row index of moved cells // Update row index of moved cells
@ -5614,7 +5609,7 @@ begin
FormatSettings.LongDateFormat := MakeLongDateFormat(FormatSettings.ShortDateFormat); FormatSettings.LongDateFormat := MakeLongDateFormat(FormatSettings.ShortDateFormat);
UseDefaultPalette; UseDefaultPalette;
FFontList := TFPList.Create; FFontList := TFPList.Create;
SetDefaultFont('Arial', 10.0); SetDefaultFont(DEFAULTFONTNAME, DEFAULTFONTSIZE);
InitFonts; InitFonts;
end; end;
@ -6572,7 +6567,6 @@ type
TRgba = packed record R,G,B,A: Byte; end; TRgba = packed record R,G,B,A: Byte; end;
var var
i: Integer; i: Integer;
c: TsColorvalue;
begin begin
// Find color value in default palette // Find color value in default palette
for i:=0 to High(DEFAULT_PALETTE) do for i:=0 to High(DEFAULT_PALETTE) do
@ -7200,7 +7194,7 @@ begin
{ A good starting point valid for many formats ... } { A good starting point valid for many formats ... }
FLimitations.MaxColCount := 256; FLimitations.MaxColCount := 256;
FLimitations.MaxRowCount := 65536; FLimitations.MaxRowCount := 65536;
FLimitations.MaxPaletteSize := $FFFFFFFF; FLimitations.MaxPaletteSize := MaxInt;
// Number formats // Number formats
CreateNumFormatList; CreateNumFormatList;
end; end;
@ -7296,7 +7290,6 @@ const
EPS = 1E-3; EPS = 1E-3;
var var
r: Cardinal; r: Cardinal;
rLast: Cardinal;
h: Single; h: Single;
begin begin
if AWorksheet.Rows.Count <= 1 then if AWorksheet.Rows.Count <= 1 then

100
components/fpspreadsheet/wikitable.pas
View File

@ -378,10 +378,10 @@ procedure TsWikiTableWriter.WriteToStrings_WikiMedia(AStrings: TStrings);
const const
// (cbNorth, cbWest, cbEast, cbSouth, cbDiagUp, cbDiagDown) // (cbNorth, cbWest, cbEast, cbSouth, cbDiagUp, cbDiagDown)
BORDERNAMES: array[TsCellBorder] of string = BORDERNAMES: array[TsCellBorder] of string =
('top', 'left', 'right', 'south', '', ''); ('top', 'left', 'right', 'bottom', '', '');
// (lsThin, lsMedium, lsDashed, lsDotted, lsThick, lsDouble, lsHair) // (lsThin, lsMedium, lsDashed, lsDotted, lsThick, lsDouble, lsHair)
LINESTYLES: array[TsLineStyle] of string = LINESTYLES: array[TsLineStyle] of string =
('1pt solid', 'medium', 'dahsed', 'dotted', 'thick', 'double', 'dashed'); ('1pt solid', 'medium solid', 'dashed', 'dotted', 'thick solid', 'double', 'dotted');
var var
ls: TsLineStyle; ls: TsLineStyle;
clr: TsColor; clr: TsColor;
@ -396,51 +396,99 @@ procedure TsWikiTableWriter.WriteToStrings_WikiMedia(AStrings: TStrings);
const const
PIPE_CHAR: array[boolean] of String = ('|', '!'); PIPE_CHAR: array[boolean] of String = ('|', '!');
var var
i, j: Integer; i, j: cardinal;
lCurStr: string = ''; lCurStr: string = '';
lCurUsedFormatting: TsUsedFormattingFields; lCurUsedFormatting: TsUsedFormattingFields;
lCurColor: TsColor; lCurColor: TsColor;
lStyleStr: String; lStyleStr: String;
lColSpanStr: String; lColSpanStr: String;
lRowSpanStr: String; lRowSpanStr: String;
lColWidthStr: String;
lRowHeightStr: String;
lCell: PCell; lCell: PCell;
lCol: PCol;
lRow: PRow;
lFont: TsFont; lFont: TsFont;
horalign: TsHorAlignment; horalign: TsHorAlignment;
vertalign: TsVertAlignment; vertalign: TsVertAlignment;
r1,c1,r2,c2: Cardinal; r1, c1, r2, c2: Cardinal;
isBold: Boolean; isHeader: Boolean;
begin begin
AStrings.Add('{| border="1" cellpadding="2" class="wikitable sortable"');
FWorksheet := Workbook.GetFirstWorksheet(); FWorksheet := Workbook.GetFirstWorksheet();
FWorksheet.UpdateCaches; FWorksheet.UpdateCaches;
r1 := 0; AStrings.Add('<!-- generated by fpspreadsheet -->');
c1 := 0;
r2 := 0; // Show/hide grid lines
c2 := 0; 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 for i := 0 to FWorksheet.GetLastRowIndex() do
begin begin
AStrings.Add('|-'); AStrings.Add('|-');
for j := 0 to FWorksheet.GetLastColIndex do for j := 0 to FWorksheet.GetLastColIndex do
begin begin
lCell := FWorksheet.FindCell(i, j); lCell := FWorksheet.FindCell(i, j);
lCurStr := FWorksheet.ReadAsUTF8Text(lCell); lCurStr := FWorksheet.ReadAsUTF8Text(lCell);
if lCurStr = '' then lCurStr := '&nbsp;';
lStyleStr := ''; lStyleStr := '';
lColSpanStr := ''; lColSpanStr := '';
lRowSpanStr := ''; lRowSpanStr := '';
lColWidthStr := '';
lRowHeightStr := '';
lCurUsedFormatting := FWorksheet.ReadUsedFormatting(lCell); 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 // Font
lFont := FWorkbook.GetDefaultFont;
if (uffFont in lCurUsedFormatting) then if (uffFont in lCurUsedFormatting) then
begin begin
lFont := FWorkbook.GetFont(lCell^.FontIndex); lFont := FWorkbook.GetFont(lCell^.FontIndex);
isBold := fssBold in lFont.Style; if fssBold in lFont.Style then lCurStr := '<b>' + lCurStr + '</b>';
if fssItalic in lFont.Style then lCurStr := '<i>' + lCurStr + '</i>';
if fssUnderline in lFont.Style then lCurStr := '<u>' + lCurStr + '</u>';
if fssStrikeout in lFont.Style then lCurStr := '<s>' + lCurStr + '</s>';
end else end else
begin if uffBold in lCurUsedFormatting then
lFont := FWorkbook.GetDefaultFont; lCurStr := '<b>' + lCurStr + '</b>';
isBold := (uffBold in lCurUsedFormatting);
end;
// Background color // Background color
if uffBackgroundColor in lCurUsedFormatting then if uffBackgroundColor in lCurUsedFormatting then
@ -464,7 +512,7 @@ begin
else horAlign := haLeft; else horAlign := haLeft;
end; end;
case horAlign of case horAlign of
haLeft : ; // cells are left-aligned by default haLeft : lStyleStr := lStyleStr + 'text-align:left;';
haCenter : lStyleStr := lStyleStr + 'text-align:center;'; haCenter : lStyleStr := lStyleStr + 'text-align:center;';
haRight : lStyleStr := lStyleStr + 'text-align:right'; haRight : lStyleStr := lStyleStr + 'text-align:right';
end; end;
@ -476,7 +524,7 @@ begin
vertAlign := lCell^.VertAlignment; vertAlign := lCell^.VertAlignment;
case vertAlign of case vertAlign of
vaTop : lStyleStr := lStyleStr + 'vertical-align:top;'; 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;'; vaBottom : lStyleStr := lStyleStr + 'vertical-align:bottom;';
end; end;
end; end;
@ -485,13 +533,13 @@ begin
if uffBorder in lCurUsedFormatting then if uffBorder in lCurUsedFormatting then
begin begin
if (cbWest in lCell^.Border) then if (cbWest in lCell^.Border) then
lStyleStr := lStyleStr + DoBorder(cbWest,lCell); lStyleStr := lStyleStr + DoBorder(cbWest, lCell);
if (cbEast in lCell^.Border) then if (cbEast in lCell^.Border) then
lStyleStr := lStyleStr + DoBorder(cbEast,lCell); lStyleStr := lStyleStr + DoBorder(cbEast, lCell);
if (cbNorth in lCell^.Border) then if (cbNorth in lCell^.Border) then
lStyleStr := lStyleStr + DoBorder(cbNorth,lCell); lStyleStr := lStyleStr + DoBorder(cbNorth, lCell);
if (cbSouth in lCell^.Border) then if (cbSouth in lCell^.Border) then
lStyleStr := lStyleStr + DoBorder(cbSouth,lCell); lStyleStr := lStyleStr + DoBorder(cbSouth, lCell);
end; end;
// Merged cells // Merged cells
@ -506,7 +554,7 @@ begin
lColSpanStr := Format(' colspan="%d"', [c2-c1+1]); lColSpanStr := Format(' colspan="%d"', [c2-c1+1]);
end end
else else
if (i > r1) or (j > c1) then if (i >= r1) and (i <= r2) and (j >= c1) and (j <= c2) then
Continue; Continue;
end; end;
@ -520,13 +568,19 @@ begin
if lColSpanStr <> '' then if lColSpanStr <> '' then
lStyleStr := lColSpanStr + lStyleStr; lStyleStr := lColSpanStr + lStyleStr;
if lColWidthStr <> '' then
lStyleStr := lColWidthStr + lStyleStr;
if lRowHeightStr <> '' then
lStyleStr := lRowHeightStr + lStyleStr;
if lCurStr <> '' then if lCurStr <> '' then
lCurStr := ' ' + lCurStr; lCurStr := ' ' + lCurStr;
if lStyleStr <> '' then if lStyleStr <> '' then
lCurStr := lStyleStr + ' |' + lCurStr; lCurStr := lStyleStr + ' |' + lCurStr;
lCurStr := PIPE_CHAR[isBold] + lCurStr; lCurStr := PIPE_CHAR[isHeader] + lCurStr;
// Add to list // Add to list
AStrings.Add(lCurStr); AStrings.Add(lCurStr);