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

fpspreadsheet: Add support for copying cell values and formulas. First unit test of copying values.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3814 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2014-11-30 23:45:08 +00:00
parent fa0c58f9da
commit 6194b41ef0
8 changed files with 416 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpspreadsheet/examples/fpsctrls/main.lfm
View File

@ -1294,7 +1294,7 @@ object Form1: TForm1
ImageIndex = 45
OnAccept = AcFileSaveAsAccept
end
object AcCopyFormat: TsCopyFormatAction
object AcCopyFormat: TsCopyAction
Category = 'FPSpreadsheet'
WorkbookSource = WorkbookSource
Caption = 'Copy format'

2
components/fpspreadsheet/examples/fpsctrls/main.pas
View File

@ -185,7 +185,7 @@ type
AcCellBorderTopBottomDbl: TsCellBorderAction;
AcCellBorderAll: TsCellBorderAction;
AcCellBorderAllVert: TsCellBorderAction;
AcCopyFormat: TsCopyFormatAction;
AcCopyFormat: TsCopyAction;
FontColorCombobox: TsCellCombobox;
BackgroundColorCombobox: TsCellCombobox;
FontnameCombo: TsCellCombobox;

59
components/fpspreadsheet/fpsactions.pas
View File

@ -107,20 +107,17 @@ type
{ --- Actions related to cell and cell selection formatting--- }
TsCellAction = class(TsSpreadsheetAction)
public
function HandlesTarget(Target: TObject): Boolean; override;
property ActiveCell;
property Selection;
property Worksheet;
end;
TsCopyItem = (ciFormat, ciValue, ciFormula, ciAll);
TsCopyFormatAction = class(TsSpreadsheetAction)
TsCopyAction = class(TsSpreadsheetAction)
private
FCopyItem: TsCopyItem;
public
procedure ExecuteTarget(Target: TObject); override;
procedure UpdateTarget(Target: TObject); override;
published
property Caption;
property CopyItem: TsCopyItem read FCopyItem write FCopyItem default ciFormat;
property Enabled;
property HelpContext;
property HelpKeyword;
@ -135,6 +132,14 @@ type
property Visible;
end;
TsCellAction = class(TsSpreadsheetAction)
public
function HandlesTarget(Target: TObject): Boolean; override;
property ActiveCell;
property Selection;
property Worksheet;
end;
TsAutoFormatAction = class(TsCellAction)
public
procedure ExecuteTarget(Target: TObject); override;
@ -451,7 +456,7 @@ begin
// Worksheet-releated actions
TsWorksheetAddAction, TsWorksheetDeleteAction, TsWorksheetRenameAction,
// Cell or cell range formatting actions
TsCopyFormatAction,
TsCopyAction,
TsFontStyleAction, TsFontDialogAction, TsBackgroundColorDialogAction,
TsHorAlignmentAction, TsVertAlignmentAction,
TsTextRotationAction, TsWordWrapAction,
@ -676,6 +681,26 @@ begin
end;
{ TsCopyAction }
procedure TsCopyAction.ExecuteTarget(Target: TObject);
const
OPERATIONS: array[TsCopyItem] of TsPendingOperation = (
poCopyFormat, poCopyValue, poCopyFormula, poCopyCell
);
begin
Unused(Target);
Checked := true;
WorkbookSource.SetPendingOperation(OPERATIONS[FCopyItem], Worksheet.GetSelection);
end;
procedure TsCopyAction.UpdateTarget(Target: TObject);
begin
Unused(Target);
if WorkbookSource.PendingOperation = poNone then Checked := false;
end;
{ TsCellAction }
function TsCellAction.HandlesTarget(Target: TObject): Boolean;
@ -684,22 +709,6 @@ begin
end;
{ TsCopyFormatAction }
procedure TsCopyFormatAction.ExecuteTarget(Target: TObject);
begin
Unused(Target);
Checked := true;
WorkbookSource.SetPendingOperation(poCopyFormat, Worksheet.GetSelection);
end;
procedure TsCopyFormatAction.UpdateTarget(Target: TObject);
begin
Unused(Target);
if WorkbookSource.PendingOperation = poNone then Checked := false;
end;
{ TsAutoFormatAction - action for cell formatting which is automatically
updated according to the current selection }

193
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -773,16 +773,23 @@ type
function UseSharedFormula(ARow, ACol: Cardinal; ASharedFormulaBase: PCell): PCell;
{ Data manipulation methods - For Cells }
procedure CopyCell(AFromRow, AFromCol, AToRow, AToCol: Cardinal;
AFromWorksheet: TsWorksheet); overload;
procedure CopyCell(AFromCell, AToCell: PCell); overload;
procedure CopyFormat(AFormat: PCell; AToRow, AToCol: Cardinal); overload;
procedure CopyCell(AFromRow, AFromCol, AToRow, AToCol: Cardinal;
AFromWorksheet: TsWorksheet = nil); overload;
procedure CopyFormat(AFromCell, AToCell: PCell); overload;
procedure CopyFormat(AFormatCell: PCell; AToRow, AToCol: Cardinal); overload;
procedure CopyFormula(AFromCell, AToCell: PCell); overload;
procedure CopyFormula(AFormulaCell: PCell; AToRow, AToCol: Cardinal); overload;
procedure CopyValue(AFromCell, AToCell: PCell); overload;
procedure CopyValue(AValueCell: PCell; AToRow, AToCol: Cardinal); overload;
procedure ExchangeCells(ARow1, ACol1, ARow2, ACol2: Cardinal);
function FindCell(ARow, ACol: Cardinal): PCell; overload;
function FindCell(AddressStr: String): PCell; overload;
function GetCell(ARow, ACol: Cardinal): PCell; overload;
function GetCell(AddressStr: String): PCell; overload;
function GetCellCount: Cardinal;
function GetFirstCell(): PCell;
function GetNextCell(): PCell;
@ -1308,6 +1315,8 @@ procedure RegisterSpreadFormat(AReaderClass: TsSpreadReaderClass;
AWriterClass: TsSpreadWriterClass; AFormat: TsSpreadsheetFormat);
procedure CopyCellFormat(AFromCell, AToCell: PCell);
procedure CopyCellValue(AFromCell, AToCell: PCell);
function GetFileFormatName(AFormat: TsSpreadsheetFormat): String;
procedure MakeLEPalette(APalette: PsPalette; APaletteSize: Integer);
function SameCellBorders(ACell1, ACell2: PCell): Boolean;
@ -1499,6 +1508,27 @@ begin
AToCell^.NumberFormatStr := AFromCell^.NumberFormatStr;
end;
{@@ ----------------------------------------------------------------------------
Copies the value of a cell to another one. Does not copy the formula, erases
the formula of the destination cell if there is one!
@param AFromCell Cell from which the value is to be copied
@param AToCell Cell to which the value is to be copied
-------------------------------------------------------------------------------}
procedure CopyCellValue(AFromCell, AToCell: PCell);
begin
Assert(AFromCell <> nil);
Assert(AToCell <> nil);
AToCell^.ContentType := AFromCell^.ContentType;
AToCell^.NumberValue := AFromCell^.NumberValue;
AToCell^.DateTimeValue := AFromCell^.DateTimeValue;
AToCell^.BoolValue := AFromCell^.BoolValue;
AToCell^.ErrorValue := AFromCell^.ErrorValue;
AToCell^.UTF8StringValue := AFromCell^.UTF8StringValue;
AToCell^.FormulaValue := ''; // This is confirmed with Excel
end;
{@@ ----------------------------------------------------------------------------
Checks whether two cells have same border attributes
@ -1890,6 +1920,40 @@ begin
if Assigned(FOnChangeFont) then FOnChangeFont(Self, ARow, ACol);
end;
{@@ ----------------------------------------------------------------------------
Copies a cell to a cell at another location. The new cell has the same values
and the same formatting. It differs in formula (adapted relative references)
and col/row indexes.
@param FromCell Pointer to the source cell which will be copied
@param ToCell Pointer to the destination cell
-------------------------------------------------------------------------------}
procedure TsWorksheet.CopyCell(AFromCell, AToCell: PCell);
var
toRow, toCol: Cardinal;
begin
if (AFromCell = nil) or (AToCell = nil) then
exit;
// Remember the row and column indexes of the destination cell.
toRow := AToCell^.Row;
toCol := AToCell^.Col;
// Copy cell values and formats
AToCell^ := AFromCell^;
// Fix row and column indexes overwritten
AToCell^.Row := toRow;
AToCell^.Col := toCol;
// Fix relative references in formulas
// This also fires the OnChange event.
CopyFormula(AFromCell, AToCell);
// Notify visual controls of possibly changed row heights.
ChangedFont(AToCell^.Row, AToCell^.Col);
end;
{@@ ----------------------------------------------------------------------------
Copies a cell. The source cell can be located in a different worksheet, while
the destination cell must be in the same worksheet which calls the methode.
@ -1898,42 +1962,20 @@ end;
@param AFromCol Column index of the source cell
@param AToRow Row index of the destination cell
@param AToCol Column index of the destination cell
@param AFromWorksheet Worksheet containing the source cell.
@param AFromWorksheet Worksheet containing the source cell. Self, if omitted.
-------------------------------------------------------------------------------}
procedure TsWorksheet.CopyCell(AFromRow, AFromCol, AToRow, AToCol: Cardinal;
AFromWorksheet: TsWorksheet);
var
lSrcCell, lDestCell: PCell;
AFromWorksheet: TsWorksheet = nil);
begin
lSrcCell := AFromWorksheet.FindCell(AFromRow, AFromCol);
if lSrcCell = nil then
exit;
if AFromWorksheet = nil then
AFromWorksheet := self;
CopyCell(AFromWorksheet.FindCell(AFromRow, AFromCol), GetCell(AToRow, AToCol));
lDestCell := GetCell(AToRow, AToCol);
lDestCell^ := lSrcCell^;
lDestCell^.Row := AToRow;
lDestCell^.Col := AToCol;
ChangedCell(AToRow, AToCol);
ChangedFont(AToRow, AToCol);
end;
{@@ ----------------------------------------------------------------------------
Copies a cell
@param FromCell Pointer to the source cell which will be copied
@param ToCell Pointer to the destination cell
-------------------------------------------------------------------------------}
procedure TsWorksheet.CopyCell(AFromCell, AToCell: PCell);
begin
if (AFromCell = nil) or (AToCell = nil) then
exit;
AToCell^ := AFromCell^;
AToCell^.Row := AFromCell^.Row;
AToCell^.Col := AFromCell^.Col;
ChangedCell(AToCell^.Row, AToCell^.Col);
ChangedFont(AToCell^.Row, AToCell^.Col);
end;
{@@ ----------------------------------------------------------------------------
Copies all format parameters from the format cell to another cell.
@ -1946,6 +1988,7 @@ begin
exit;
CopyCellFormat(AFromCell, AToCell);
ChangedCell(AToCell^.Row, AToCell^.Col);
ChangedFont(AToCell^.Row, AToCell^.Col);
end;
@ -1954,13 +1997,91 @@ end;
Copies all format parameters from a given cell to another cell identified
by its row/column indexes.
@param AFormat Pointer to the source cell from which the format is copied.
@param AToRow Row index of the destination cell
@param AToCol Column index of the destination cell
@param AFormatCell Pointer to the source cell from which the format is copied.
@param AToRow Row index of the destination cell
@param AToCol Column index of the destination cell
-------------------------------------------------------------------------------}
procedure TsWorksheet.CopyFormat(AFormat: PCell; AToRow, AToCol: Cardinal);
procedure TsWorksheet.CopyFormat(AFormatCell: PCell; AToRow, AToCol: Cardinal);
begin
CopyFormat(AFormat, GetCell(AToRow, AToCol));
CopyFormat(AFormatCell, GetCell(AToRow, AToCol));
end;
{@@ ----------------------------------------------------------------------------
Copies the formula of a specified cell to another cell. Adapts relative
cell references to the new cell.
@param AFromCell Pointer to the source cell from which the formula is to be
copied
@param AToCell Pointer to the destination cell
-------------------------------------------------------------------------------}
procedure TsWorksheet.CopyFormula(AFromCell, AToCell: PCell);
var
rpnFormula: TsRPNFormula;
isSharedFormula: Boolean;
lCell: TCell;
begin
if (AFromCell = nil) or (AToCell = nil) then
exit;
if AFromCell^.FormulaValue = '' then
AToCell^.FormulaValue := ''
else
begin
// Here we convert the formula to an rpn formula as seen from source...
// (The mechanism needs the ActiveCell of the parser which is only
// valid if the cell contains a shared formula)
lCell := AToCell^;
lCell.SharedFormulaBase := AFromCell;
rpnFormula := BuildRPNFormula(@lCell);
// ... and here we reconstruct the string formula as seen from destination cell.
AToCell^.FormulaValue := ConvertRPNFormulaToStringFormula(rpnFormula);
end;
ChangedCell(AToCell^.Row, AToCell^.Col);
end;
{@@ ----------------------------------------------------------------------------
Copies the formula of a specified cell to another cell given by its row and
column index. Relative cell references are adapted to the new cell.
@param AFormatCell Pointer to the source cell containing the formula to be
copied
@param AToRow Row index of the destination cell
@param AToCol Column index of the destination cell
-------------------------------------------------------------------------------}
procedure TsWorksheet.CopyFormula(AFormulaCell: PCell; AToRow, AToCol: Cardinal);
begin
CopyFormula(AFormulaCell, GetCell(AToRow, AToCol));
end;
{@@ ----------------------------------------------------------------------------
Copies the value of a specified cell to another cell (without copying
formulas or formats)
@param AFromCell Pointer to the source cell providing the value to be copied
@param AToCell Pointer to the destination cell
-------------------------------------------------------------------------------}
procedure TsWorksheet.CopyValue(AFromCell, AToCell: PCell);
begin
if (AFromCell = nil) or (AToCell = nil) then
exit;
CopyCellValue(AFromCell, AToCell);
ChangedCell(AToCell^.Row, AToCell^.Col);
end;
{@@ ----------------------------------------------------------------------------
Copies the value of a specified cell to another cell given by its row and
column index
@param AValueCell Pointer to the cell containing the value to be copied
@param AToRow Row index of the destination cell
@param AToCol Column index of the destination cell
-------------------------------------------------------------------------------}
procedure TsWorksheet.CopyValue(AValueCell: PCell; AToRow, AToCol: Cardinal);
begin
CopyValue(AValueCell, GetCell(AToRow, AToCol));
end;
{@@ ----------------------------------------------------------------------------

7
components/fpspreadsheet/fpspreadsheetctrls.pas
View File

@ -46,7 +46,7 @@ type
TsNotificationItems = set of TsNotificationItem;
{@@ Identifier for an operation that will be executed at next cell select }
TsPendingOperation = (poNone, poCopyFormat);
TsPendingOperation = (poNone, poCopyFormat, poCopyValue, poCopyFormula, poCopyCell);
{ TsWorkbookSource }
@ -743,7 +743,10 @@ begin
srcCell := Worksheet.FindCell(FPendingSelection[i].Row1+j, FPendingSelection[i].Col1+k);
destCell := Worksheet.GetCell(destSelection[i].Row1+j, destSelection[i].Col1+k);
case FPendingOperation of
poCopyFormat: Worksheet.CopyFormat(srcCell, destCell);
poCopyCell : Worksheet.CopyCell(srcCell, destCell);
poCopyFormat : Worksheet.CopyFormat(srcCell, destCell);
poCopyFormula: Worksheet.CopyFormula(srcCell, destCell);
poCopyValue : Worksheet.CopyValue(srcCell, destCell);
end;
end;
end;

209
components/fpspreadsheet/tests/copytests.pas Normal file
View File

@ -0,0 +1,209 @@
unit copytests;
{$mode objfpc}{$H+}
interface
{ Tests for copying cells
}
uses
// Not using Lazarus package as the user may be working with multiple versions
// Instead, add .. to unit search path
Classes, SysUtils, fpcunit, testregistry,
fpspreadsheet, xlsbiff2, xlsbiff5, xlsbiff8, fpsopendocument, {and a project requirement for lclbase for utf8 handling}
testsutility;
var
SourceCells: Array[0..6] of TCell;
procedure InitCopyData;
type
{ TSpreadCopyTests }
TSpreadCopyTests = class(TTestCase)
private
protected
// Set up expected values:
procedure SetUp; override;
procedure TearDown; override;
procedure Test_Copy(ATestKind: Integer);
published
procedure Test_CopyValuesToEmptyCells;
// procedure Test_Copy_Format;
// procedure Test_Copy_Formula;
end;
implementation
uses
TypInfo, Math, fpsutils;
const
CopyTestSheet = 'Copy';
function InitNumber(ANumber: Double): TCell;
begin
InitCell(Result);
Result.ContentType := cctNumber;
Result.Numbervalue := ANumber;
end;
function InitString(AString: String): TCell;
begin
InitCell(Result);
Result.ContentType := cctUTF8String;
Result.UTF8StringValue := AString;
end;
function InitFormula(AFormula: String; ANumberResult: Double): TCell;
begin
InitCell(Result);
Result.FormulaValue := AFormula;
Result.NumberValue := ANumberResult;
Result.ContentType := cctNumber;
end;
procedure InitCopyData;
begin
SourceCells[0] := InitNumber(1.0); // will be in A1
SourceCells[1] := InitNumber(2.0);
SourceCells[2] := InitNumber(3.0);
SourceCells[3] := InitString('Lazarus');
SourceCells[4] := InitFormula('A1+1', 2.0);
InitCell(SourceCells[5]); // empty but existing
end;
{ TSpreadCopyTests }
procedure TSpreadCopyTests.SetUp;
begin
inherited SetUp;
InitCopyData;
end;
procedure TSpreadCopyTests.TearDown;
begin
inherited TearDown;
end;
{ This test prepares a worksheet and copies Values (ATestKind = 1), Formats
(AWhat = 2), or Formulas (AWhat = 3). The worksheet is saved, reloaded
and compared to expectated data }
procedure TSpreadCopyTests.Test_Copy(ATestKind: Integer);
const
AFormat = sfExcel8;
var
TempFile: string;
MyWorksheet: TsWorksheet;
MyWorkbook: TsWorkbook;
row, col: Integer;
cell: PCell;
begin
TempFile := GetTempFileName;
MyWorkbook := TsWorkbook.Create;
try
MyWorkbook.Options := MyWorkbook.Options + [boAutoCalc];
MyWorkSheet:= MyWorkBook.AddWorksheet(CopyTestSheet);
// Create two identical columns A and B
for row := 0 to High(SourceCells) do
for col := 0 to 1 do
begin
case SourceCells[row].ContentType of
cctNumber:
cell := MyWorksheet.WriteNumber(row, col, SourceCells[row].NumberValue);
cctUTF8String:
cell := Myworksheet.WriteUTF8Text(row, col, SourceCells[row].UTF8StringValue);
cctEmpty:
cell := MyWorksheet.WriteBlank(row, col);
end;
if SourceCells[row].FormulaValue <> '' then
Myworksheet.WriteFormula(row, col, SourceCells[row].FormulaValue);
end;
MyWorksheet.CalcFormulas;
case ATestKind of
1: // copy the source cell values to the empty column C
for row := 0 to High(SourceCells) do
Myworksheet.CopyValue(MyWorksheet.FindCell(row, 0), row, 2);
end;
// Write to file
MyWorkBook.WriteToFile(TempFile, AFormat, true);
finally
MyWorkbook.Free;
end;
MyWorkbook := TsWorkbook.Create;
try
MyWorkbook.Options := MyWorkbook.Options + [boAutoCalc, boReadFormulas];
// Read spreadsheet file...
MyWorkbook.ReadFromFile(TempFile, AFormat);
MyWorksheet := MyWorkbook.GetFirstWorksheet;
case ATestKind of
1: // Copied values in first colum to empty third column
// The formula cell should contain the result of A1+1 (only value copied)
begin
col := 2;
// Number cells
for row := 0 to High(SourceCells) do
begin
cell := MyWorksheet.FindCell(row, col);
if (SourceCells[row].ContentType in [cctNumber, cctUTF8String, cctEmpty]) then
CheckEquals(
GetEnumName(TypeInfo(TCellContentType), Integer(SourceCells[row].ContentType)),
GetEnumName(TypeInfo(TCellContentType), Integer(cell^.ContentType)),
'Content type mismatch, cell '+CellNotation(MyWorksheet, row, col));
case SourceCells[row].ContentType of
cctNumber:
CheckEquals(
SourceCells[row].NumberValue,
cell^.NumberValue,
'Number value mismatch, cell ' + CellNotation(MyWorksheet, row, col));
cctUTF8String:
CheckEquals(
SourceCells[row].UTF8StringValue,
cell^.UTF8StringValue,
'String value mismatch, cell ' + CellNotation(MyWorksheet, row, col));
end;
if HasFormula(@SourceCells[row]) then
CheckEquals(
SourceCells[0].NumberValue + 1,
cell^.NumberValue,
'Result of copied formula mismatch, cell ' + CellNotation(MyWorksheet, row, col));
end;
end;
end;
finally
MyWorkbook.Free;
end;
DeleteFile(TempFile);
end;
{ Copy given cell values to empty cells }
procedure TSpreadCopyTests.Test_CopyValuesToEmptyCells;
begin
Test_Copy(1);
end;
initialization
RegisterTest(TSpreadCopyTests);
InitCopyData;
end.

9
components/fpspreadsheet/tests/spreadtestgui.lpi
View File

@ -40,7 +40,7 @@
<PackageName Value="FCL"/>
</Item4>
</RequiredPackages>
<Units Count="20">
<Units Count="21">
<Unit0>
<Filename Value="spreadtestgui.lpr"/>
<IsPartOfProject Value="True"/>
@ -118,11 +118,18 @@
<Unit18>
<Filename Value="celltypetests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="celltypetests"/>
</Unit18>
<Unit19>
<Filename Value="sortingtests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="sortingtests"/>
</Unit19>
<Unit20>
<Filename Value="copytests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="copytests"/>
</Unit20>
</Units>
</ProjectOptions>
<CompilerOptions>

2
components/fpspreadsheet/tests/spreadtestgui.lpr
View File

@ -12,7 +12,7 @@ uses
manualtests, testsutility, internaltests, formattests, colortests, fonttests,
optiontests, numformatparsertests, formulatests, rpnFormulaUnit,
emptycelltests, errortests, virtualmodetests, insertdeletetests,
celltypetests, sortingtests;
celltypetests, sortingtests, copytests;
begin
{$IFDEF HEAPTRC}