paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpspreadsheet: Ignore case of sheetname in validation. Better calling convention for un-merging cell ranges.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3554 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2014-09-12 14:14:05 +00:00
parent 336905292e
commit b70cc35da3
2 changed files with 31 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -577,7 +577,7 @@ type
{ Merged cells } { Merged cells }
procedure MergeCells(ARow1, ACol1, ARow2, ACol2: Cardinal); overload; procedure MergeCells(ARow1, ACol1, ARow2, ACol2: Cardinal); overload;
procedure MergeCells(ARange: String); overload; procedure MergeCells(ARange: String); overload;
procedure UnmergeCells(ARow1, ACol1, ARow2, ACol2: Cardinal); overload; procedure UnmergeCells(ARow, ACol: Cardinal); overload;
procedure UnmergeCells(ARange: String); overload; procedure UnmergeCells(ARange: String); overload;
function FindMergeBase(ACell: PCell): PCell; function FindMergeBase(ACell: PCell): PCell;
function FindMergedRange(ACell: PCell; out ARow1, ACol1, ARow2, ACol2: Cardinal): Boolean; function FindMergedRange(ACell: PCell; out ARow1, ACol1, ARow2, ACol2: Cardinal): Boolean;
@ -2987,9 +2987,9 @@ end;
{@@ {@@
Merges adjacent individual cells to a larger single cell Merges adjacent individual cells to a larger single cell
@param ARange Cell range string given in Excel notation (e.g: A1:D5) @param ARange Cell range string given in Excel notation (e.g: A1:D5).
A non-range string (e.g. A1) is not allowed.
} }
procedure TsWorksheet.MergeCells(ARange: String); procedure TsWorksheet.MergeCells(ARange: String);
var var
r1, r2, c1, c2: Cardinal; r1, r2, c1, c2: Cardinal;
@ -3001,38 +3001,47 @@ end;
{@@ {@@
Disconnects merged cells to make them individual cells again. Disconnects merged cells to make them individual cells again.
@param ARow1 Row index of the upper left corner of the merged cell range Input parameter is a cell which belongs to the range to be unmerged.
@param ACol1 Column index of the upper left corner of the mergec cell range
@param ARow2 Row index of the lower right corner of the merged cell range @param ARow Row index of a cell considered to belong to the cell block
@param ACol2 Column index of the lower right corner of the merged cell range @param ACol Column index of a cell considered to belong to the cell block
} }
procedure TsWorksheet.UnmergeCells(ARow1, ACol1, ARow2, ACol2: Cardinal); procedure TsWorksheet.UnmergeCells(ARow, ACol: Cardinal);
var var
cell: PCell; cell: PCell;
r, c: Cardinal; r, c: Cardinal;
r1, c1, r2, c2: Cardinal;
begin begin
for r := ARow1 to ARow2 do cell := FindCell(ARow, ACol);
for c := ACol1 to ACol2 do if not FindMergedRange(cell, r1, c1, r2, c2) then
exit;
for r := r1 to r2 do
for c := c1 to c2 do
begin begin
cell := FindCell(r, c); cell := FindCell(r, c);
if cell <> nil then if cell <> nil then
cell^.MergedNeighbors := []; cell^.MergedNeighbors := [];
end; end;
ChangedCell(ARow1, ACol1); ChangedCell(ARow, ACol);
end; end;
{@@ {@@
Disconnects merged cells to make them individual cells again. Disconnects merged cells to make them individual cells again.
@param ARange Cell range string given in Excel notation (e.g: A1:D5) @param ARange Cell (range) string given in Excel notation (e.g: A1, or A1:D5)
In case of a range string, only the upper left corner cell is
considered. It must belong to the merged range of cells to be
unmerged.
} }
procedure TsWorksheet.UnmergeCells(ARange: String); procedure TsWorksheet.UnmergeCells(ARange: String);
var var
r1, r2, c1, c2: Cardinal; r1, r2, c1, c2: Cardinal;
begin begin
if (pos(':', ARange) = 0) and ParseCellString(ARange, r1, c1) then
UnmergeCells(r1, c1)
else
if ParseCellRangeString(ARange, r1, c1, r2, c2) then if ParseCellRangeString(ARange, r1, c1, r2, c2) then
UnmergeCells(r1, c1, r2, c2); UnmergeCells(r1, c1);
end; end;
{@@ {@@
@ -5755,7 +5764,7 @@ end;
@param AName The name of the worksheet @param AName The name of the worksheet
@return A TsWorksheet instance if one is found with that name, @return A TsWorksheet instance if one is found with that name,
nil otherwise. nil otherwise. Case is ignored.
@see TsWorkbook.GetFirstWorksheet @see TsWorkbook.GetFirstWorksheet
@see TsWorkbook.GetWorksheetByIndex @see TsWorkbook.GetWorksheetByIndex
@ -5768,7 +5777,7 @@ begin
Result := nil; Result := nil;
for i:=0 to FWorksheets.Count-1 do for i:=0 to FWorksheets.Count-1 do
begin begin
if TsWorkSheet(FWorkSheets.Items[i]).Name=AName then if UTF8CompareText(TsWorkSheet(FWorkSheets.Items[i]).Name, AName) = 0 then
begin begin
Result := TsWorksheet(FWorksheets.Items[i]); Result := TsWorksheet(FWorksheets.Items[i]);
exit; exit;

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

@ -101,15 +101,17 @@ type
SheetName: String; SheetName: String;
end; end;
const const
TestCases: array[0..7] of TSheetNameCheck = ( TestCases: array[0..9] of TSheetNameCheck = (
(Valid: true; SheetName:'Sheet'), (Valid: true; SheetName:'Sheet'),
(Valid: true; SheetName:'äöü'), (Valid: true; SheetName:'äöü'), // UFt8-characters are ok
(Valid: false; SheetName:'Test'), // duplicate (Valid: false; SheetName:'Test'), // duplicate
(Valid: false; SheetName:'TEST'), // duplicate since case is ignored
(Valid: false; SheetName:''), // empty string (Valid: false; SheetName:''), // empty string
(Valid: false; SheetName:'Very very very very very very very very long'), // too long (Valid: false; SheetName:'Very very very very very very very very long'), // too long
(Valid: false; SheetName:'[sheet]'), // fobidden chars in following cases (Valid: false; SheetName:'[sheet]'), // forbidden characters in following cases
(Valid: false; SheetName:'/sheet/'), (Valid: false; SheetName:'/sheet/'),
(Valid: false; SheetName:'\sheet\') (Valid: false; SheetName:'\sheet\'),
(Valid: false; SheetName:'***sheet***')
); );
var var
i: Integer; i: Integer;