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

fpspreadsheet: Add parsing of cell range strings given in "R1C1" syntax

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4376 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-10-09 19:33:02 +00:00
parent ced66bed8b
commit 180a1d049d
2 changed files with 134 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

99
components/fpspreadsheet/fpsutils.pas
View File

@@ -53,6 +53,7 @@ function DWordLEtoN(AValue: Cardinal): Cardinal;
function WideStringLEToN(const AValue: WideString): WideString; function WideStringLEToN(const AValue: WideString): WideString;
// Cell, column and row strings // Cell, column and row strings
// -- "A1" syntax
function ParseIntervalString(const AStr: string; function ParseIntervalString(const AStr: string;
out AFirstCellRow, AFirstCellCol, ACount: Cardinal; out AFirstCellRow, AFirstCellCol, ACount: Cardinal;
out ADirection: TsSelectionDirection): Boolean; out ADirection: TsSelectionDirection): Boolean;
@@ -76,20 +77,28 @@ function ParseCellRowString(const AStr: string;
function ParseCellColString(const AStr: string; function ParseCellColString(const AStr: string;
out AResult: Cardinal): Boolean; out AResult: Cardinal): Boolean;
function ParseCellString_R1C1(const AStr: String; ABaseRow, ABaseCol: Cardinal;
out ACellRow, ACellCol: Cardinal; out AFlags: TsRelFlags): Boolean;
function GetColString(AColIndex: Integer): String;
function GetCellString(ARow,ACol: Cardinal;
AFlags: TsRelFlags = [rfRelRow, rfRelCol]): String;
function GetCellString_R1C1(ARow, ACol: Cardinal; AFlags: TsRelFlags = [rfRelRow, rfRelCol];
ARefRow: Cardinal = Cardinal(-1); ARefCol: Cardinal = Cardinal(-1)): String;
function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal; function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal;
AFlags: TsRelFlags = rfAllRel; Compact: Boolean = false): String; overload; AFlags: TsRelFlags = rfAllRel; Compact: Boolean = false): String; overload;
function GetCellRangeString(ARange: TsCellRange; function GetCellRangeString(ARange: TsCellRange;
AFlags: TsRelFlags = rfAllRel; Compact: Boolean = false): String; overload; AFlags: TsRelFlags = rfAllRel; Compact: Boolean = false): String; overload;
function GetCellString(ARow,ACol: Cardinal;
AFlags: TsRelFlags = [rfRelRow, rfRelCol]): String;
function GetColString(AColIndex: Integer): String;
// -- "R1C1" syntax
function ParseCellRangeString_R1C1(const AStr: string; ABaseRow, ABaseCol: Cardinal;
out AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol: Cardinal;
out AFlags: TsRelFlags): Boolean;
function ParseCellString_R1C1(const AStr: String; ABaseRow, ABaseCol: Cardinal;
out ACellRow, ACellCol: Cardinal; out AFlags: TsRelFlags): Boolean; overload;
function ParseCellString_R1C1(const AStr: string; ABaseRow, ABaseCol: Cardinal;
out ACellRow, ACellCol: Cardinal): Boolean; overload;
function GetCellString_R1C1(ARow, ACol: Cardinal; AFlags: TsRelFlags = [rfRelRow, rfRelCol];
ARefRow: Cardinal = Cardinal(-1); ARefCol: Cardinal = Cardinal(-1)): String;
// Error strings
function GetErrorValueStr(AErrorValue: TsErrorValue): String; function GetErrorValueStr(AErrorValue: TsErrorValue): String;
function TryStrToErrorValue(AErrorStr: String; out AErr: TsErrorValue): boolean; function TryStrToErrorValue(AErrorStr: String; out AErr: TsErrorValue): boolean;
@@ -587,6 +596,54 @@ begin
Result := Scan(1); Result := Scan(1);
end; end;
{@@ ----------------------------------------------------------------------------
Extracts information on cell range from a cellrange string in "R1C1" notation.
Returns in AFlags also information on relative/absolute cells.
@param AStr Cell range string, in R1C1 syntax,
such as R[2]C[3]:R[4]C[8]
@param ABaseRow Row index from which the cell reference is seen.
@param ABaseCol Column index from which the cell reference is seen.
@param AFirstCellRow Row index of the top/left cell of the range (output)
@param AFirstCellCol Column index of the top/left cell of the range (output)
@param ALastCellRow Row index of the bottom/right cell of the range (output)
@param ALastCellCol Column index of the bottom/right cell of the rng (output)
@param AFlags A set containing an element for AFirstCellRow,
AFirstCellCol, ALastCellRow, ALastCellCol if they
represent a relative cell address.
@return FALSE if the string is not a valid cell range
-------------------------------------------------------------------------------}
function ParseCellRangeString_R1C1(const AStr: string; ABaseRow, ABaseCol: Cardinal;
out AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol: Cardinal;
out AFlags: TsRelFlags): Boolean;
var
p: Integer;
s: String;
f: TsRelFlags;
begin
Result := True;
// First find the colon
p := pos(':', AStr);
if p = 0 then exit(false);
// Analyze part after the colon
s := copy(AStr, p+1, Length(AStr));
Result := ParseCellString_R1C1(s, ABaseRow, ABaseCol,
ALastCellRow, ALastCellCol, f);
if not Result then exit;
// Analyze part before the colon
s := copy(AStr, 1, p-1);
Result := ParseCellString_R1C1(s, ABaseRow, ABaseCol,
AFirstCellRow, AFirstCellCol, AFlags);
// Add flags of 2nd part
if rfRelRow in f then Include(AFlags, rfRelRow2);
if rfRelCol in f then Include(AFlags, rfRelCol2);
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Parses a cell string in "R1C1" notation into zero-based column and row numbers Parses a cell string in "R1C1" notation into zero-based column and row numbers
'AFlags' indicates relative addresses. 'AFlags' indicates relative addresses.
@@ -682,6 +739,28 @@ begin
Result := true; Result := true;
end; end;
{@@ ----------------------------------------------------------------------------
Parses a cell string in "R1C1" notation into zero-based column and row numbers
For compatibility with old version which does not return flags for relative
cell addresses.
@param AStr Cell reference in R1C1 syntax, such as R[2]C[3] or R1C5
@param ABaseRow Row index from which the cell reference is seen.
@param ABaseCol Column index from which the cell reference is seen.
@param ACellRow Row index of the top/left cell of the range (output)
@param ACellCol Column index of the top/left cell of the range (output)
-------------------------------------------------------------------------------}
function ParseCellString_R1C1(const AStr: string; ABaseRow, ABaseCol: Cardinal;
out ACellRow, ACellCol: Cardinal): Boolean;
var
flags: TsRelFlags;
begin
Result := ParseCellString_R1C1(AStr, ABaseRow, ABaseCol,
ACellRow, ACellCol, flags);
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Parses a cell string, like 'A1' into zero-based column and row numbers Parses a cell string, like 'A1' into zero-based column and row numbers
Note that there can be several letters to address for more than 26 columns. Note that there can be several letters to address for more than 26 columns.

45
components/fpspreadsheet/tests/internaltests.pas
View File

@@ -41,6 +41,7 @@ type
procedure TestCellString; procedure TestCellString;
// Tests cell references given in the "R1C1" syntax. // Tests cell references given in the "R1C1" syntax.
procedure TestCellString_R1C1; procedure TestCellString_R1C1;
procedure TestCellRangeString_R1C1;
//todo: add more calls, rename sheets, try to get sheets with invalid indexes etc //todo: add more calls, rename sheets, try to get sheets with invalid indexes etc
//(see strings tests for how to deal with expected exceptions) //(see strings tests for how to deal with expected exceptions)
@@ -599,7 +600,51 @@ begin
// (E15) RC interchanged // (E15) RC interchanged
res := ParseCellString_R1C1('C1R1', 10, 10, r, c, flags); res := ParseCellString_R1C1('C1R1', 10, 10, r, c, flags);
CheckEquals(res, false, 'Result mismatch in test E15'); CheckEquals(res, false, 'Result mismatch in test E15');
end;
{ Tests cell range references given in the "R1C1" syntax. }
procedure TSpreadInternalTests.TestCellRangeString_R1C1;
var
r1,c1,r2,c2: Cardinal;
s: String;
flags: TsRelFlags;
res: Boolean;
begin
// (1) Absolute reference of the range between cells row0/cell0 and row2/col1
res := ParseCellRangeString_R1C1('R1C1:R3C2', 10, 10, r1, c1, r2, c2, flags);
CheckEquals(res, true, 'Result mismatch in test 1');
CheckEquals(r1, 0, 'Row1 mismatch in test 1'); // base cell coordinates are ignored with absolute refs!
CheckEquals(c1, 0, 'Col1 mismatch in test 1');
CheckEquals(r2, 2, 'Row2 mismatch in test 1'); // base cell coordinates are ignored with absolute refs!
CheckEquals(c2, 1, 'Col2 mismatch in test 1');
CheckEquals(true, flags = [], 'Flags mismatch in test 1');
// (2) Relative reference of the cell left of col 10 and above row 10
res := ParseCellRangeString_R1C1('R[-1]C[-1]:R[1]C[1]', 10, 10, r1, c1, r2, c2, flags);
CheckEquals(res, true, 'Result mismatch in test 2');
CheckEquals(r1, 9, 'Row mismatch in test 2');
CheckEquals(c1, 9, 'Col mismatch in test 2');
CheckEquals(r2, 11, 'Row mismatch in test 2');
CheckEquals(c2, 11, 'Col mismatch in test 2');
CheckEquals(true, flags = [rfRelRow, rfRelCol, rfRelRow2, rfRelCol2], 'Flags mismatch in test 2');
// (3) Absolute reference of first cell (row0/col0), Relative reference of second cell
res := ParseCellRangeString_R1C1('R1C1:R[1]C[1]', 10, 10, r1, c1, r2, c2, flags);
CheckEquals(res, true, 'Result mismatch in test 2');
CheckEquals(r1, 0, 'Row mismatch in test 3');
CheckEquals(c1, 0, 'Col mismatch in test 3');
CheckEquals(r2, 11, 'Row mismatch in test 3');
CheckEquals(c2, 11, 'Col mismatch in test 3');
CheckEquals(true, flags = [rfRelRow2, rfRelCol2], 'Flags mismatch in test 3');
// (4) Relative reference of first cell, absolute reference of second cell
res := ParseCellRangeString_R1C1('R[-1]C[-1]:R20C20', 10, 10, r1, c1, r2, c2, flags);
CheckEquals(res, true, 'Result mismatch in test 4');
CheckEquals(r1, 9, 'Row mismatch in test 4');
CheckEquals(c1, 9, 'Col mismatch in test 4');
CheckEquals(r2, 19, 'Row mismatch in test 4');
CheckEquals(c2, 19, 'Col mismatch in test 4');
CheckEquals(true, flags = [rfRelRow, rfRelCol], 'Flags mismatch in test 4');
end; end;
procedure TSpreadInternalTests.FractionTest(AMaxDigits: Integer); procedure TSpreadInternalTests.FractionTest(AMaxDigits: Integer);