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

fpspreadsheet: Add TDataset-descendant, TsWorksheetDataset, and related unit-tests.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8095 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2021-09-24 09:05:05 +00:00
parent 4585269bdb
commit 0fce0c2ddf
14 changed files with 4659 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
components/fpspreadsheet/images/components/make_res.bat
View File

@ -1,3 +1,4 @@
lazres ../../resource/fpsvisualreg.res @list_visual.txt
lazres ../../resource/fpsvisual.lrs cur_dragcopy.cur
lazres ../../resource/fpsvisualexportreg.res @list_export.txt
lazres ../../resource/fpsdatasetreg.res @list_dataset.txt

5
components/fpspreadsheet/install.txt
View File

@ -10,4 +10,7 @@
(4) If you need to unlock xls file protection
Make sure that the package dcpcrypt.lpk can be found by the IDE
Open laz_fpspreadsheet_crypto.lpk -- > Compile
Open laz_fpspreadsheet_crypto.lpk -- > Compile
(5) If need database access to spreadsheets:
Open laz_fpsdataset.lpk --> Use --> Install

43
components/fpspreadsheet/laz_fpspreadsheet_dataset.lpk Normal file
View File

@ -0,0 +1,43 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="5">
<PathDelim Value="\"/>
<Name Value="laz_fpspreadsheet_dataset"/>
<Type Value="RunAndDesignTime"/>
<Author Value="Werner Pamler"/>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<OtherUnitFiles Value="source/dataset"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\"/>
</SearchPaths>
</CompilerOptions>
<Description Value="Accesses a spreadsheet file like a database."/>
<License Value="LGPL with static linking exception. This is the same license as is used in the LCL (Lazarus Component Library)."/>
<Version Major="1" Minor="13"/>
<Files Count="1">
<Item1>
<Filename Value="source/dataset/fpsdataset.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="fpsDataset"/>
</Item1>
</Files>
<CompatibilityMode Value="True"/>
<RequiredPkgs Count="2">
<Item1>
<PackageName Value="laz_fpspreadsheet"/>
</Item1>
<Item2>
<PackageName Value="FCL"/>
</Item2>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
</Package>
</CONFIG>

BIN
components/fpspreadsheet/resource/fpsdatasetreg.res Normal file
View File

Binary file not shown.

2231
components/fpspreadsheet/source/dataset/fpsdataset.pas Normal file
View File

File diff suppressed because it is too large Load Diff

132
components/fpspreadsheet/unit-tests/dataset/GuiTestProject.lpi Normal file
View File

@ -0,0 +1,132 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<Flags>
<CompatibilityMode Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="GuiTestProject"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default"/>
</Modes>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="laz_fpspreadsheet_dataset"/>
</Item1>
<Item2>
<PackageName Value="fpcunittestrunner"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</RequiredPackages>
<Units Count="8">
<Unit0>
<Filename Value="GuiTestProject.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="readfieldstestunit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ReadFieldsTestUnit"/>
</Unit1>
<Unit2>
<Filename Value="sorttestunit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="SortTestUnit"/>
</Unit2>
<Unit3>
<Filename Value="filtertestunit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="FilterTestUnit"/>
</Unit3>
<Unit4>
<Filename Value="posttestunit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="PostTestUnit"/>
</Unit4>
<Unit5>
<Filename Value="emptycolumnstestunit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="EmptyColumnsTestUnit"/>
</Unit5>
<Unit6>
<Filename Value="searchtestunit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="SearchTestUnit"/>
</Unit6>
<Unit7>
<Filename Value="copyfromdatasetunit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="CopyFromDatasetUnit"/>
</Unit7>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="GuiTestProject"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
<VerifyObjMethodCallValidity Value="True"/>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf2Set"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="4">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
<Item4>
<Name Value="EAssertionFailedError"/>
</Item4>
</Exceptions>
</Debugging>
</CONFIG>

17
components/fpspreadsheet/unit-tests/dataset/GuiTestProject.lpr Normal file
View File

@ -0,0 +1,17 @@
program GuiTestProject;
{$mode objfpc}{$H+}
uses
Interfaces, Forms, GuiTestRunner,
ReadFieldsTestUnit, SortTestUnit, SearchTestUnit, FilterTestUnit, PostTestUnit,
EmptyColumnsTestUnit, CopyFromDatasetUnit;
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TGuiTestRunner, TestRunner);
Application.Run;
end.

219
components/fpspreadsheet/unit-tests/dataset/copyfromdatasetunit.pas Normal file
View File

@ -0,0 +1,219 @@
unit CopyFromDatasetUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testutils, testregistry,
DB, dbf,
fpspreadsheet, fpsDataset;
type
{ TCopyFromDatasetTest }
TCopyFromDatasetTest= class(TTestCase)
private
function CreateDbf: TDbf;
procedure CopyDatasetTest(ATestIndex: Integer);
protected
procedure SetUp; override;
procedure TearDown; override;
published
procedure CopyDatasetTest_FieldDefs;
procedure CopyDatasetTest_Fields;
procedure CopyDatasetTest_Records;
end;
implementation
uses
TypInfo;
const
DBF_FILE_NAME = 'testdata.dbf';
FILE_NAME = 'testfile.xlsx';
SHEET_NAME = 'Sheet';
STRING_FIELD = 'StringCol';
INT_FIELD = 'IntegerCol';
FLOAT_FIELD = 'FloatCol';
NUM_RECORDS = 10;
var
DataFileName: String;
DbfPath: String;
function TCopyFromDatasetTest.CreateDbf: TDbf;
var
i: Integer;
begin
Result := TDbf.Create(nil);
Result.FilePathFull := DbfPath;
Result.TableName := DBF_FILE_NAME;
Result.FieldDefs.Add(STRING_FIELD, ftString, 20);
Result.FieldDefs.Add(INT_FIELD, ftInteger);
Result.FieldDefs.Add(FLOAT_FIELD, ftFloat);
Result.CreateTable;
Result.Open;
for i := 1 to NUM_RECORDS do
begin
Result.Append;
Result.FieldByName(STRING_FIELD).AsString := 'abc' + IntToStr(i);
Result.FieldByName(INT_FIELD).AsInteger := -5 + i;
Result.FieldByName(FLOAT_FIELD).AsFloat := -5.1 * (i + 5.1);
Result.Post;
end;
end;
procedure TCopyFromDatasetTest.CopyDatasetTest(ATestIndex: Integer);
const
DEBUG = false;
var
dbf: TDbf;
dataset: TsWorksheetDataset;
i: Integer;
begin
dbf := CreateDbf;
if DEBUG then
begin
dbf.Close;
dbf.Open;
end;
dataset := TsWorksheetDataset.Create(nil);
try
dataset.CopyFromDataset(dbf, DataFileName, dbf.TableName);
// Save for debugging
if DEBUG then
begin
dataset.Close;
dataset.Open;
end;
case ATestIndex of
// FIELD DEFS
0: begin
CheckEquals( // Compare FieldDef count
dbf.FieldDefs.Count,
dataset.FieldDefs.Count,
'Mismatch in number of FieldDefs'
);
// Compare FieldDefs
for i := 0 to dbf.FieldDefs.Count-1 do
begin
CheckEquals(
dbf.FieldDefs[i].Name,
dataset.FieldDefs[i].Name,
'Mismatch in FieldDefs[' + IntToStr(i) + '].Name'
);
CheckEquals(
GetEnumName(TypeInfo(TFieldType), integer(dbf.FieldDefs[i].DataType)),
GetEnumName(TypeInfo(TFieldType), integer(dataset.FieldDefs[i].DataType)),
'Mismatch in FieldDefs[' + IntToStr(i) + '].DataType'
);
CheckEquals(
dbf.FieldDefs[i].Size,
dataset.FieldDefs[i].Size,
'Mismatch in FieldDefs[' + IntToStr(i) + '].Size'
);
end;
end;
// FIELDS
1: begin
// Compare field count
CheckEquals(
dbf.FieldCount,
dataset.FieldCount,
'Mismatch in FieldCount'
);
// Compare fields
for i := 0 to dbf.FieldCount-1 do
begin
CheckEquals(
dbf.Fields[i].FieldName,
dataset.Fields[i].FieldName,
'Mismatch in Fields[' + IntToStr(i) + '].FieldName'
);
CheckEquals(
GetEnumName(TypeInfo(TFieldType), integer(dbf.Fields[i].DataType)),
GetEnumName(TypeInfo(TFieldType), integer(dataset.Fields[i].DataType)),
'Mismatch in Fields[' + IntToStr(i) + '].DataType'
);
end;
end;
// RECORDS
2: begin
// Compare record count
CheckEquals(
dbf.RecordCount,
dataset.RecordCount,
'Mismatch in RecordCount'
);
dbf.First;
dataset.First;
while not dbf.EoF do
begin
for i := 0 to dbf.FieldCount-1 do
begin
CheckEquals(
dbf.Fields[i].AsString,
dataset.Fields[i].AsString,
'Record value mismatch, Field #[' + IntToStr(i) + '], RecNo ' + IntToStr(dbf.RecNo)
);
end;
dbf.Next;
dataset.Next;
end;
end;
end;
finally
dataset.Free;
dbf.Free;
end;
end;
procedure TCopyFromDatasetTest.CopyDatasetTest_FieldDefs;
begin
CopyDatasetTest(0);
end;
procedure TCopyFromDatasetTest.CopyDatasetTest_Fields;
begin
CopyDatasetTest(1);
end;
procedure TCopyFromDatasetTest.CopyDatasetTest_Records;
begin
CopyDatasetTest(2);
end;
procedure TCopyFromDatasetTest.SetUp;
begin
DataFileName := GetTempDir + FILE_NAME;
DbfPath := GetTempDir;
end;
procedure TCopyFromDatasetTest.TearDown;
begin
if FileExists(DataFileName) then DeleteFile(DataFileName);
if FileExists(DbfPath + DBF_FILE_NAME) then DeleteFile(DbfPath + DBF_FILE_NAME);
end;
initialization
RegisterTest(TCopyFromDatasetTest);
end.

297
components/fpspreadsheet/unit-tests/dataset/emptycolumnstestunit.pas Normal file
View File

@ -0,0 +1,297 @@
{ These tests check whether empty columns in the worksheet are ignored when
FieldDefs are determined. }
unit EmptyColumnsTestUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testregistry,
DB,
fpSpreadsheet, fpsTypes, fpsDataset;
type
TEmptyColumnsTest = class(TTestCase)
private
function CreateAndOpenDataset(
ATestIndex: Integer; AutoFieldDefs: Boolean): TsWorksheetDataset;
procedure CreateWorksheet(ATestIndex: Integer);
protected
procedure TestFieldDefs(ATestIndex: Integer; AutoFieldDefs: Boolean);
procedure SetUp; override;
procedure TearDown; override;
published
procedure Test_0;
procedure Test_1;
procedure Test_2;
procedure Test_3;
procedure Test_4;
procedure Test_5;
procedure Test_6;
procedure Test_0_AutoFieldDefs;
procedure Test_1_AutoFieldDefs;
procedure Test_2_AutoFieldDefs;
procedure Test_3_AutoFieldDefs;
procedure Test_4_AutoFieldDefs;
procedure Test_5_AutoFieldDefs;
procedure Test_6_AutoFieldDefs;
end;
implementation
const
FILE_NAME = 'testfile.xlsx';
SHEET_NAME = 'Sheet';
var
DataFileName: String;
type
TDataRec = record
ColumnType: TFieldType;
FieldDefIndex: Integer;
end;
TTestData = array [0..3] of TDataRec; // colums 0..3 in worksheet
const
TestCases: array[0..6] of TTestData = (
( //0
(ColumnType:ftInteger; FieldDefIndex: 0),
(ColumnType:ftFloat; FieldDefIndex: 1),
(ColumnType:ftString; FieldDefIndex: 2),
(ColumnType:ftDate; FieldDefIndex: 3)
),
( // 1
(ColumnType:ftInteger; FieldDefIndex: 0),
(ColumnType:ftUnknown; FieldDefIndex:-1),
(ColumnType:ftFloat; FieldDefIndex: 1),
(ColumnType:ftDate; FieldDefIndex: 2)
),
( // 2
(ColumnType:ftInteger; FieldDefIndex: 0),
(ColumnType:ftFloat; FieldDefIndex: 1),
(ColumnType:ftUnknown; FieldDefIndex:-1),
(ColumnType:ftString; FieldDefIndex: 2)
),
( // 3
(ColumnType:ftUnknown; FieldDefIndex:-1),
(ColumnType:ftInteger; FieldDefIndex: 0),
(ColumnType:ftFloat; FieldDefIndex: 1),
(ColumnType:ftString; FieldDefIndex: 2)
),
( // 4
(ColumnType:ftInteger; FieldDefIndex: 0),
(ColumnType:ftString; FieldDefIndex: 1),
(ColumnType:ftDate; FieldDefIndex: 2),
(ColumnType:ftUnknown; FieldDefIndex:-1)
),
( // 5
(ColumnType:ftInteger; FieldDefIndex: 0),
(ColumnType:ftUnknown; FieldDefIndex:-1),
(ColumnType:ftUnknown; FieldDefIndex:-1),
(ColumnType:ftFloat; FieldDefIndex: 1)
),
( // 6
(ColumnType:ftUnknown; FieldDefIndex:-1),
(ColumnType:ftUnknown; FieldDefIndex:-1),
(ColumnType:ftUnknown; FieldDefIndex:-1),
(ColumnType:ftInteger; FieldDefIndex: 0)
)
);
function TEmptyColumnsTest.CreateAndOpenDataset(
ATestIndex: Integer; AutoFieldDefs: Boolean): TsWorksheetDataset;
var
i: Integer;
begin
Result := TsWorksheetDataset.Create(nil);
Result.FileName := DataFileName;
Result.SheetName := SHEET_NAME;
Result.AutoFieldDefs := AutoFieldDefs;
if not AutoFieldDefs then
begin
for i := 0 to Length(TTestData)-1 do
begin
case TestCases[ATestIndex][i].ColumnType of
ftUnknown: ;
ftInteger: Result.AddFieldDef('IntCol', ftInteger, 0, i);
ftFloat: Result.AddFieldDef('FloatCol', ftFloat, 0, i);
ftString: Result.AddFieldDef('StringCol', ftString, 20, i);
ftDate: Result.AddFieldDef('DateCol', ftDate, 0, i);
else raise Exception.Create('Field type not expected in this test.');
end;
end;
Result.CreateTable;
end;
Result.Open;
end;
{ Creates a worksheet with columns as defined by the TestColumns.
ftUnknown will become an empty column. }
procedure TEmptyColumnsTest.CreateWorksheet(ATestIndex: Integer);
const
NumRows = 10;
var
r, c: Integer;
s: String;
workbook: TsWorkbook;
worksheet: TsWorksheet;
begin
// Create test spreadsheet file
workbook := TsWorkbook.Create;
try
// Create worksheet
worksheet := workbook.AddWorkSheet(SHEET_NAME);
// Write headers (= field names) and record values
for c := 0 to Length(TTestData)-1 do
begin
case TestCases[ATestIndex][c].ColumnType of
ftUnknown: ;
ftInteger:
begin
worksheet.WriteText(0, c, 'IntCol');
for r := 1 to NumRows do
worksheet.WriteNumber(r, c, Random(100));
end;
ftFloat:
begin
worksheet.WriteText(0, c, 'FloatCol');
for r := 1 to NumRows do
worksheet.WriteNumber(r, c, Random*100);
end;
ftString:
begin
worksheet.WriteText(0, c, 'StringCol');
for r := 1 to NumRows do
worksheet.WriteText(r, c, char(ord('a') + random(26)));
end;
ftDate:
begin
worksheet.WriteText(0, c, 'DateCol');
for r := 1 to NumRows do
worksheet.WriteDateTime(r, c, EncodeDate(2000,1,1) + Random(1000), nfShortDate);
end;
end;
end;
// Save
workbook.WriteToFile(DataFileName, true);
finally
workbook.Free;
end;
end;
procedure TEmptyColumnsTest.TestFieldDefs(ATestIndex: Integer; AutoFieldDefs: Boolean);
var
dataset: TsWorksheetDataset;
c, i: Integer;
expectedFieldDefIndex, actualFieldDefIndex: Integer;
begin
CreateWorksheet(ATestIndex);
dataset := CreateAndOpenDataset(ATestIndex, AutoFieldDefs);
try
for i := 0 to dataset.FieldDefs.Count-1 do
begin
c := TsFieldDef(dataset.FieldDefs[i]).ColIndex;
expectedFieldDefIndex := TestCases[ATestIndex][c].FieldDefIndex;
actualFieldDefIndex := i;
CheckEquals(
expectedFieldDefIndex,
actualFieldDefIndex,
'FieldDef index mismatch, fieldDef #' + IntToStr(i)
);
end;
finally
dataset.Free;
end;
end;
procedure TEmptyColumnsTest.Test_0;
begin
TestFieldDefs(0, false);
end;
procedure TEmptyColumnsTest.Test_1;
begin
TestFieldDefs(1, false);
end;
procedure TEmptyColumnsTest.Test_2;
begin
TestFieldDefs(2, false);
end;
procedure TEmptyColumnsTest.Test_3;
begin
TestFieldDefs(3, false);
end;
procedure TEmptyColumnsTest.Test_4;
begin
TestFieldDefs(4, false);
end;
procedure TEmptyColumnsTest.Test_5;
begin
TestFieldDefs(5, false);
end;
procedure TEmptyColumnsTest.Test_6;
begin
TestFieldDefs(6, false);
end;
procedure TEmptyColumnsTest.Test_0_AutoFieldDefs;
begin
TestFieldDefs(0, true);
end;
procedure TEmptyColumnsTest.Test_1_AutoFieldDefs;
begin
TestFieldDefs(1, true);
end;
procedure TEmptyColumnsTest.Test_2_AutoFieldDefs;
begin
TestFieldDefs(2, true);
end;
procedure TEmptyColumnsTest.Test_3_AutoFieldDefs;
begin
TestFieldDefs(3, true);
end;
procedure TEmptyColumnsTest.Test_4_AutoFieldDefs;
begin
TestFieldDefs(4, true);
end;
procedure TEmptyColumnsTest.Test_5_AutoFieldDefs;
begin
TestFieldDefs(5, true);
end;
procedure TEmptyColumnsTest.Test_6_AutoFieldDefs;
begin
TestFieldDefs(6, true);
end;
procedure TEmptyColumnsTest.SetUp;
begin
DataFileName := GetTempDir + FILE_NAME;
end;
procedure TEmptyColumnsTest.TearDown;
begin
if FileExists(DataFileName) then DeleteFile(DataFileName);
end;
initialization
RegisterTest(TEmptyColumnsTest);
end.

370
components/fpspreadsheet/unit-tests/dataset/filtertestunit.pas Normal file
View File

@ -0,0 +1,370 @@
unit FilterTestUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testregistry,
DB,
fpspreadsheet, fpstypes, fpsutils, fpsdataset;
type
TFilterTest= class(TTestCase)
private
function CreateAndOpenDataset: TsWorksheetDataset;
procedure Filter_01(Dataset: TDataset; var Accept: Boolean); // 'IntCol < 2'
procedure Filter_10(Dataset: TDataset; var Accept: Boolean); // 'StringCol = 'abc
procedure Filter_11(Dataset: TDataset; var Accept: Boolean); // 'UPPER(StringCol) = 'ABC'
procedure Filter_12(Dataset: TDataset; var Accept: Boolean); // 'StringCol = 'ä'
procedure Filter_13(Dataset: TDataset; var Accept: Boolean); // 'StringCol > 'α'
procedure Filter_20(Dataset: TDataset; var Accept: Boolean); // 'WideStringCol = 'wABC'
procedure Filter_21(Dataset: TDataset; var Accept: Boolean); // 'UPPER(WideStringCol) = 'WABC'
procedure Filter_22(Dataset: TDataset; var Accept: Boolean); // 'WideStringCol = 'wä'
protected
procedure FilterTest(TestIndex: Integer);
procedure SetUp; override;
procedure TearDown; override;
published
procedure FilterTest_01_Int;
procedure FilterTest_10_String;
procedure FilterTest_11_UpperString;
procedure FilterTest_12_StringUTF8;
procedure FilterTest_13_StringUTF8;
procedure FilterTest_ByEvent_101_Int;
procedure FilterTest_ByEvent_110_String;
procedure FilterTest_ByEvent_111_UpperString;
procedure FilterTest_ByEvent_112_String_UTF8;
procedure FilterTest_ByEvent_113_String_UTF8;
procedure FilterTest_ByEvent_120_WideString;
procedure FilterTest_ByEvent_121_UpperWideString;
procedure FilterTest_ByEvent_122_WideString_UTF8;
end;
implementation
const
FILE_NAME = 'testfile.xlsx';
SHEET_NAME = 'Sheet';
INT_COL = 0;
STRING_COL = 1;
WIDESTRING_COL = 2;
INT_FIELD = 'IntCol';
STRING_FIELD = 'StringCol';
WIDESTRING_FIELD = 'WideStringCol';
var
DataFileName: String;
type
TTestRow = record
IntValue: Integer;
StringValue: String;
WideStringValue: Widestring;
end;
const
// Unfiltered test values
UNFILTERED: array[0..7] of TTestRow = ( // Index
(IntValue: 10; StringValue: 'abc'; WideStringValue: 'wabc'), // 0
(IntValue: 1; StringValue: 'ABC'; WideStringvalue: 'wABC'), // 1
(IntValue: 1; StringValue: 'a'; WideStringValue: 'wa'), // 2
(IntValue: 2; StringValue: 'A'; WideStringValue: 'wA'), // 3
(IntValue: -1; StringValue: 'xyz'; WideStringValue: 'wxyz'), // 4
(IntValue: 25; StringValue: 'ä'; WideStringValue: 'wä'), // 5
(IntValue: 30; StringValue: 'Äöü'; WideStringValue: 'wÄöü'), // 6
(IntValue: 5; StringValue: 'αβγä';WideStringValue: 'wαβγä') // 7
);
// These are the indexes into the UNFILTERED array after filtering
FILTERED_01: array[0..2] of Integer = (1, 2, 4); // 'IntCol < 2'
FILTERED_10: array[0..0] of Integer = (0); // 'StringCol = 'abc'
FILTERED_11: array[0..1] of Integer = (0, 1); // 'UPPER(StringCol) = 'ABC'
FILTERED_12: array[0..0] of Integer = (5); // StringCol = 'ä'
FILTERED_13: array[0..0] of Integer = (7); // StringCol >= 'α'
FILTERED_20: array[0..0] of Integer = (1); // 'WideStringCol = 'wABC'
FILTERED_21: array[0..1] of Integer = (0, 1); // 'UPPER(WideStringCol) = 'WABC'
FILTERED_22: array[0..0] of Integer = (5); // WideStringCol = 'wä'
EXPRESSION_01 = 'IntCol < 2';
EXPRESSION_10 = 'StringCol = "abc"';
EXPRESSION_11 = 'UPPER(StringCol) = "ABC"';
EXPRESSION_12 = 'StringCol = "ä"';
EXPRESSION_13 = 'StringCol >= "α"';
EXPRESSION_20 = 'WideStringCol = "wABC"';
EXPRESSION_21 = 'UPPER(WideStringCol) = "WABC"';
EXPRESSION_22 = 'WideStringCol = "wä"';
procedure TFilterTest.Filter_01(Dataset: TDataset; var Accept: Boolean);
begin
Accept := Dataset.FieldByName(INT_FIELD).AsInteger < 2;
end;
procedure TFilterTest.Filter_10(Dataset: TDataset; var Accept: Boolean);
begin
Accept := Dataset.FieldByName(STRING_FIELD).AsString = 'abc';
end;
procedure TFilterTest.Filter_11(Dataset: TDataset; var Accept: Boolean);
begin
Accept := UpperCase(Dataset.FieldByName(STRING_FIELD).AsString) = 'ABC';
end;
procedure TFilterTest.Filter_12(Dataset: TDataset; var Accept: Boolean);
begin
Accept := Dataset.FieldByName(STRING_FIELD).AsString = 'ä';
end;
procedure TFilterTest.Filter_13(Dataset: TDataset; var Accept: Boolean);
begin
Accept := Dataset.FieldByName(STRING_FIELD).AsString >= 'α';
end;
procedure TFilterTest.Filter_20(Dataset: TDataset; var Accept: Boolean);
begin
Accept := Dataset.FieldByName(WIDESTRING_FIELD).AsWideString = WideString('wABC');
end;
procedure TFilterTest.Filter_21(Dataset: TDataset; var Accept: Boolean);
begin
Accept := Uppercase(Dataset.FieldByName(WIDESTRING_FIELD).AsWideString) = WideString('WABC');
end;
procedure TFilterTest.Filter_22(Dataset: TDataset; var Accept: Boolean);
begin
Accept := Dataset.FieldByName(WIDESTRING_FIELD).AsWideString = WideString('wä');
end;
function TFilterTest.CreateAndOpenDataset: TsWorksheetDataset;
begin
Result := TsWorksheetDataset.Create(nil);
Result.FileName := DataFileName;
Result.SheetName := SHEET_NAME;
Result.AutoFieldDefs := false;
Result.AddFieldDef(INT_FIELD, ftInteger);
Result.AddFieldDef(STRING_FIELD, ftString, 20);
Result.AddFieldDef(WIDESTRING_FIELD, ftWideString, 20);
Result.CreateTable;
Result.Open;
end;
procedure TFilterTest.FilterTest(TestIndex: Integer);
var
dataset: TsWorksheetDataset;
intField: TField;
stringField: TField;
widestringField: TField;
actualInt: Integer;
actualString: String;
actualWideString: WideString;
expectedInt: Integer;
expectedString: String;
expectedWideString: WideString;
expectedRecordCount: Integer;
i, idx: Integer;
begin
dataset := CreateAndOpenDataset;
try
dataset.Filter := '';
dataset.OnFilterRecord := nil;
case TestIndex of
// Tests using the Filter property
1: dataset.Filter := EXPRESSION_01; // Integer test
10: dataset.Filter := EXPRESSION_10; // String tests
11: dataset.Filter := EXPRESSION_11;
12: dataset.Filter := EXPRESSION_12;
13: dataset.Filter := EXPRESSION_13;
20: dataset.Filter := EXPRESSION_20; // widestring tests
21: dataset.Filter := EXPRESSION_21;
22: dataset.Filter := EXPRESSION_22;
// Tests using the OnFilterRecord event
101: dataset.OnFilterRecord := @Filter_01;
110: dataset.OnFilterRecord := @Filter_10;
111: dataset.OnFilterRecord := @Filter_11;
112: dataset.OnFilterRecord := @Filter_12;
113: dataset.OnFilterRecord := @Filter_13;
120: dataset.OnFilterRecord := @Filter_20;
121: dataset.OnFilterRecord := @Filter_21;
122: dataset.OnFilterRecord := @Filter_22;
end;
dataset.Filtered := true;
case (TestIndex mod 100) of
1: expectedRecordCount := Length(FILTERED_01);
10: expectedRecordCount := Length(FILTERED_10);
11: expectedRecordCount := Length(FILTERED_11);
12: expectedRecordCount := Length(FILTERED_12);
13: expectedRecordCount := Length(FILTERED_13);
20: expectedRecordCount := Length(FILTERED_20);
21: expectedRecordCount := Length(FILTERED_21);
22: expectedRecordCount := Length(FILTERED_22);
end;
intField := dataset.FieldByName(INT_FIELD);
stringField := dataset.FieldByName(STRING_FIELD);
wideStringField := dataset.FieldByName(WIDESTRING_FIELD);
dataset.First;
i := 0;
while not dataset.EOF do
begin
CheckEquals(true, i < expectedRecordCount, 'Record count mismatch.');
case TestIndex mod 100 of
1: idx := FILTERED_01[i];
10: idx := FILTERED_10[i];
11: idx := FILTERED_11[i];
12: idx := FILTERED_12[i];
13: idx := FILTERED_13[i];
20: idx := FILTERED_20[i];
21: idx := FILTERED_21[i];
22: idx := FILTERED_22[i];
end;
actualInt := intField.AsInteger;
actualString := stringField.AsString;
actualWideString := wideStringField.AsWideString;
expectedInt := UNFILTERED[idx].IntValue;
expectedString := UNFILTERED[idx].StringValue;
expectedWideString := UNFILTERED[idx].WideStringValue;
CheckEquals(
expectedInt,
actualInt,
'Integer field value mismatch in row ' + IntToStr(i)
);
CheckEquals(
expectedString,
actualString,
'String field value mismatch in row ' + IntToStr(i)
);
CheckEquals(
expectedWideString,
actualWideString,
'Widestring field value mismatch in row ' + IntToStr(i)
);
inc(i);
dataset.Next;
end;
CheckEquals(true, i = expectedRecordCount, 'Record count mismatch.');
finally
dataset.Free;
end;
end;
procedure TFilterTest.FilterTest_01_Int;
begin
FilterTest(1);
end;
procedure TFilterTest.FilterTest_10_String;
begin
FilterTest(10);
end;
procedure TFilterTest.FilterTest_11_UpperString;
begin
FilterTest(11);
end;
procedure TFilterTest.FilterTest_12_StringUTF8;
begin
FilterTest(12);
end;
procedure TFilterTest.FilterTest_13_StringUTF8;
begin
FilterTest(13);
end;
procedure TFilterTest.FilterTest_ByEvent_101_Int;
begin
FilterTest(101);
end;
procedure TFilterTest.FilterTest_ByEvent_110_String;
begin
FilterTest(110);
end;
procedure TFilterTest.FilterTest_ByEvent_111_UpperString;
begin
FilterTest(111);
end;
procedure TFilterTest.FilterTest_ByEvent_112_String_UTF8;
begin
FilterTest(112);
end;
procedure TFilterTest.FilterTest_ByEvent_113_String_UTF8;
begin
FilterTest(113);
end;
procedure TFilterTest.FilterTest_ByEvent_120_WideString;
begin
FilterTest(120);
end;
procedure TFilterTest.FilterTest_ByEvent_121_UpperWideString;
begin
FilterTest(121);
end;
procedure TFilterTest.FilterTest_ByEvent_122_WideString_UTF8;
begin
FilterTest(122);
end;
procedure TFilterTest.SetUp;
var
i, r: Integer;
workbook: TsWorkbook;
worksheet: TsWorksheet;
begin
// Create test spreadsheet file
workbook := TsWorkbook.Create;
try
// Create worksheet
worksheet := workbook.AddWorkSheet(SHEET_NAME);
// Write headers (= field names)
worksheet.WriteText(0, INT_COL, INT_FIELD);
worksheet.WriteText(0, STRING_COL, STRING_FIELD);
worksheet.WriteText(0, WIDESTRING_COL, WIDESTRING_FIELD);
// Write values
for i := Low(UNFILTERED) to High(UNFILTERED) do
begin
r := 1 + (i - Low(UNFILTERED));
worksheet.WriteNumber(r, INT_COL, UNFILTERED[i].IntValue, nfFixed, 0);
worksheet.WriteText(r, STRING_COL, UNFILTERED[i].StringValue);
worksheet.WriteText(r, WIDESTRING_COL, UNFILTERED[i].WideStringValue);
end;
// Save
DataFileName := GetTempDir + FILE_NAME;
workbook.WriteToFile(DataFileName, true);
finally
workbook.Free;
end;
end;
procedure TFilterTest.TearDown;
begin
if FileExists(DataFileName) then DeleteFile(DataFileName);
end;
initialization
RegisterTest(TFilterTest);
end.

216
components/fpspreadsheet/unit-tests/dataset/posttestunit.pas Normal file
View File

@ -0,0 +1,216 @@
{ - Creates a new WorksheetDataset with a variety of fields
- Appends a record and posts the dataset
- Opens the created spreadsheet file and compares its cells with the
posted data.
}
unit PostTestUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testregistry,
DB,
fpsdataset, fpspreadsheet, fpstypes, fpsutils;
type
TPostTest= class(TTestCase)
protected
procedure RunPostTest(ADataType: TFieldType; ASize: Integer = 0);
procedure SetUp; override;
procedure TearDown; override;
published
procedure PostTest_Int;
procedure PostTest_String_20;
procedure PostTest_String_10;
procedure PostTest_Widestring_20;
procedure PostTest_Widestring_10;
end;
implementation
uses
LazUTF8, LazUTF16;
const
FILE_NAME = 'testfile.xls';
SHEET_NAME = 'Sheet';
COL_NAME = 'TestCol';
var
DataFileName: String;
type
TTestRecord = record
IntValue: Integer;
StringValue: String;
WideStringValue: WideString;
end;
const
TestData: Array[0..5] of TTestRecord = (
(IntValue: 10; StringValue: 'abc'; WideStringValue: 'abc'), // 0
(IntValue: -20; StringValue: 'äöüαβγ'; WideStringvalue: 'äöüαβγ'), // 1
(IntValue: 100; StringValue: 'a234567890'; WideStringvalue: 'a234567890'), // 2
(IntValue: 0; StringValue: 'a234567890123'; WideStringvalue: 'a234567890123'), // 3
(IntValue: 501; StringValue: 'äα34567890'; WideStringValue: 'äα34567890'), // 4
(IntValue: 502; StringValue: 'äα34567890123'; WideStringValue: 'äα34567890123') // 5
);
procedure TPostTest.RunPostTest(ADataType: TFieldType; ASize: Integer = 0);
var
dataset: TsWorksheetDataset;
field: TField;
i: Integer;
workbook: TsWorkbook;
worksheet: TsWorksheet;
row, lastRow: Integer;
actualIntValue: Integer;
actualStringValue: String;
actualWideStringValue: WideString;
expectedIntValue: Integer;
expectedStringValue: String;
expectedWideStringValue: WideString;
begin
dataset := TsWorksheetDataset.Create(nil);
try
dataset.FileName := DataFileName;
dataset.SheetName := SHEET_NAME;
dataset.AddFieldDef(COL_NAME, ADataType, ASize);
dataset.CreateTable;
dataset.Open;
field := dataset.FieldByName(COL_NAME);
for i := 0 to High(TestData) do
begin
dataset.Append;
case ADataType of
ftInteger : field.AsInteger := TestData[i].IntValue;
ftString : field.AsString := TestData[i].StringValue;
ftWideString : field.AsString := UTF8Decode(TestData[i].WideStringValue);
end;
dataset.Post;
end;
dataset.Close;
finally
dataset.Free;
end;
CheckEquals(
true,
FileExists(DatafileName),
'Spreadsheet data file not found'
);
workbook := TsWorkbook.Create;
try
workbook.ReadFromFile(DataFileName);
worksheet := workbook.GetWorksheetByName(SHEET_NAME);
CheckEquals(
true,
worksheet <> nil,
'Worksheet not found'
);
lastRow := worksheet.GetLastRowIndex(true);
CheckEquals(
Length(TestData),
lastRow,
'Row count mismatch in worksheet'
);
actualStringValue := worksheet.ReadAsText(0, 0);
CheckEquals(
COL_NAME,
actualStringValue,
'Column name mismatch'
);
i := 0;
for row := 1 to lastRow do
begin
case ADataType of
ftInteger:
begin
expectedIntValue := TestData[i].IntValue;
actualIntValue := Round(worksheet.ReadAsNumber(row, 0));
CheckEquals(
expectedIntValue,
actualIntValue,
'Integer field mismatch, row ' + IntToStr(row)
);
end;
ftString:
begin
expectedStringValue := UTF8Copy(TestData[i].StringValue, 1, ASize);
actualStringValue := worksheet.ReadAsText(row, 0);
CheckEquals(
expectedStringValue,
actualStringValue,
'String field mismatch, Row ' + IntToStr(row)
);
end;
ftWideString:
begin
expectedWideStringValue := UTF16Copy(TestData[i].WideStringValue, 1, ASize);
actualWideStringValue := UTF8Decode(worksheet.ReadAsText(row, 0));
CheckEquals(
expectedWidestringValue,
actualWideStringValue,
'Widestring field mismatch, row ' + IntToStr(row)
);
end;
else
raise Exception.Create('Field type not tested here.');
end;
inc(i);
end;
finally
workbook.Free;
end;
end;
procedure TPostTest.PostTest_Int;
begin
RunPostTest(ftInteger);
end;
procedure TPostTest.PostTest_String_20;
begin
RunPostTest(ftString, 20);
end;
procedure TPostTest.PostTest_String_10;
begin
RunPostTest(ftString, 10);
end;
procedure TPostTest.PostTest_WideString_20;
begin
RunPostTest(ftWideString, 20);
end;
procedure TPostTest.PostTest_WideString_10;
begin
RunPostTest(ftWideString, 10);
end;
procedure TPostTest.SetUp;
begin
DataFileName := GetTempDir + FILE_NAME;
end;
procedure TPostTest.TearDown;
begin
if FileExists(DataFileName) then DeleteFile(DataFileName);
end;
initialization
RegisterTest(TPostTest);
end.

442
components/fpspreadsheet/unit-tests/dataset/readfieldstestunit.pas Normal file
View File

@ -0,0 +1,442 @@
unit ReadFieldsTestUnit;
{$mode objfpc}{$H+}
{$IF FPC_FullVersion >= 30300}
{$DEFINE TEST_BYTE_FIELD}
{$IFEND}
interface
uses
Classes, SysUtils, fpcunit, testutils, testregistry,
DB,
fpspreadsheet, fpstypes, fpsdataset;
type
TReadFieldsTest= class(TTestCase)
private
function CreateAndOpenDataset(AutoFieldDefs: Boolean): TsWorksheetDataset;
procedure ReadFieldTest(Col: Integer; FieldName: String; AutoFieldDefs: Boolean);
protected
procedure SetUp; override;
procedure TearDown; override;
published
procedure ReadIntegerField;
{$IFDEF TEST_BYTE_FIELD}
procedure ReadByteField;
{$IFEND}
procedure ReadWordField;
procedure ReadFloatField;
procedure ReadCurrencyField;
procedure ReadBCDField;
procedure ReadFmtBCDField;
procedure ReadStringField;
procedure ReadMemoField;
procedure ReadBoolField;
procedure ReadDateField;
procedure ReadTimeField;
procedure ReadDateTimeField;
procedure ReadIntegerField_AutoFieldDefs;
procedure ReadByteField_AutoFieldDefs;
procedure ReadWordField_AutoFieldDefs;
procedure ReadFloatField_AutoFieldDefs;
procedure ReadCurrencyField_AutoFieldDefs;
procedure ReadStringField_AutoFieldDefs;
procedure ReadMemoField_AutoFieldDefs;
procedure ReadBoolField_AutoFieldDefs;
procedure ReadDateField_AutoFieldDefs;
procedure ReadTimeField_AutoFieldDefs;
procedure ReadDateTimeField_AutoFieldDefs;
end;
implementation
const
FILE_NAME = 'testfile.xlsx';
SHEET_NAME = 'Sheet';
INT_COL = 0;
BYTE_COL = 1;
WORD_COL = 2;
FLOAT_COL = 3;
CURRENCY_COL = 4;
BCD_COL = 5;
FMTBCD_COL = 6;
STRING_COL = 7;
BOOL_COL = 8;
DATE_COL = 9;
TIME_COL = 10;
DATETIME_COL = 11;
MEMO_COL = 12;
TestText: array[0..3] of string = (
'Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua',
'At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet',
'Статья 1 Все люди рождаются свободными и равными в своем достоинстве и правах.',
'ϰαὶ τότ'' ἐγὼ Κύϰλωπα προσηύδων ἄγχι παραστάς, '
);
var
DataFileName: String;
function TReadFieldsTest.CreateAndOpenDataset(AutoFieldDefs: Boolean): TsWorksheetDataset;
begin
Result := TsWorksheetDataset.Create(nil);
Result.AutoFieldDefs:= true;
Result.FileName := DataFileName;
Result.SheetName := SHEET_NAME;
Result.AutoFieldDefs := AutoFieldDefs;
if not AutoFieldDefs then
begin
Result.AddFieldDef('IntCol', ftInteger);
{$IFDEF TEST_BYTE_FIELD}
Result.AddFieldDef('ByteCol', ftByte);
{$ELSE}
Result.AddFieldDef('ByteCol', ftInteger); // No ftByte in too old FPC
{$ENDIF}
Result.AddFieldDef('WordCol', ftWord);
Result.AddFieldDef('FloatCol', ftFloat);
Result.AddFieldDef('CurrencyCol', ftCurrency);
Result.AddFieldDef('BCDCol', ftBCD);
Result.AddFieldDef('FmtBCDCol', ftFmtBCD);
Result.AddFieldDef('StringCol', ftString, 30);
Result.AddFieldDef('BoolCol', ftBoolean);
Result.AddFieldDef('DateCol', ftDate);
Result.AddFieldDef('TimeCol', ftTime);
Result.AddFieldDef('DateTimeCol', ftDateTime);
Result.AddFieldDef('MemoCol', ftMemo);
Result.CreateTable;
end;
Result.Open;
end;
procedure TReadFieldsTest.SetUp;
const
NumRows = 10;
var
r: Integer;
s: String;
workbook: TsWorkbook;
worksheet: TsWorksheet;
begin
// Create test spreadsheet file
workbook := TsWorkbook.Create;
try
// Create worksheet
worksheet := workbook.AddWorkSheet(SHEET_NAME);
// Write headers (= field names)
worksheet.WriteText(0, INT_COL, 'IntCol');
worksheet.WriteText(0, BYTE_COL, 'ByteCol');
worksheet.WriteText(0, WORD_COL, 'WordCol');
worksheet.WriteText(0, FLOAT_COL, 'FloatCol');
worksheet.WriteText(0, CURRENCY_COL, 'CurrencyCol');
worksheet.WriteText(0, BCD_COL, 'BCDCol');
worksheet.WriteText(0, FMTBCD_Col, 'FmtBCDCol');
worksheet.WriteText(0, STRING_COL, 'StringCol');
worksheet.WriteText(0, BOOL_COL, 'BoolCol');
worksheet.WriteText(0, DATE_COL, 'DateCol');
worksheet.WriteText(0, TIME_COL, 'TimeCol');
worksheet.WriteText(0, DATETIME_COL, 'DateTimeCol');
worksheet.Writetext(0, MEMO_COL, 'MemoCol');
for r := 1 to NumRows do begin
// Write values to IntCol
worksheet.WriteNumber(r, INT_COL, r*120- 50, nfFixed, 0);
// Write values to ByteCol
worksheet.WriteNumber(r, BYTE_COL, r*2, nfFixed, 0);
//Write values to WordCol
worksheet.WriteNumber(r, WORD_COL, r*3, nfFixed, 0);
// Write values to FloatCol
worksheet.WriteNumber(r, FLOAT_COL, r*1.1-5.1, nfFixed, 2);
// Write values to CurrencyCol
worksheet.WriteCurrency(r, CURRENCY_COL, r*1000, nfCurrency);
// Write values to BCDcol
worksheet.WriteNumber(r, BCD_COL, r*1.2-3);
// Write values to FmtBCDCol
worksheet.WriteNumber(r, FMTBCD_COL, r*12.3-60);
// Write values to StringCol
case r of
1: s := 'Статья';
2: s := 'Λορεμ ιπσθμ δολορ σιτ αμετ';
else s := char(ord('A') + r-1) + char(ord('b') + r-1) + char(ord('c') + r-1);
end;
worksheet.WriteText(r, STRING_COL, s);
// Write values to BoolCol
worksheet.WriteBoolValue(r, BOOL_COL, odd(r));
// Write values to DateCol
worksheet.WriteDateTime(r, DATE_COL, EncodeDate(2021, 8, 1) + r-1, nfShortDate);
// Write values to TimeCol
worksheet.WriteDateTime(r, TIME_COL, EncodeTime(8, 0, 0, 0) + (r-1) / (24*60), nfShortTime);
// Write value to DateTimeCol
worksheet.WriteDateTime(r, DATETIME_COL, EncodeDate(2021, 8, 1) + EncodeTime(8, 0, 0, 0) + (r-1) + (r-1)/24, nfShortDateTime);
// Write value to MemoCol
worksheet.WriteText(r, MEMO_COL, TestText[r mod Length(TestText)]);
end;
// Save
DataFileName := GetTempDir + FILE_NAME;
workbook.WriteToFile(DataFileName, true);
finally
workbook.Free;
end;
end;
procedure TReadFieldsTest.TearDown;
begin
if FileExists(DataFileName) then DeleteFile(DataFileName);
end;
procedure TReadFieldsTest.ReadFieldTest(Col: Integer; FieldName: String;
AutoFieldDefs: Boolean);
const
FLOAT_EPS = 1E-9;
var
dataset: TDataset;
row: Integer;
f: TField;
dt: TDateTime;
workbook: TsWorkbook;
worksheet: TsWorksheet;
n: Integer;
begin
dataset := CreateAndOpenDataset(AutoFieldDefs);
try
workbook := TsWorkbook.Create;
try
workbook.ReadFromFile(DataFileName);
worksheet := workbook.GetFirstWorksheet;
f := dataset.FieldByName(FieldName);
CheckEquals(
worksheet.ReadAsText(0, col),
f.FieldName,
'Column header / FieldName mismatch'
);
CheckEquals(
col,
f.FieldNo-1,
'Field number mismatch'
);
CheckEquals(
worksheet.GetLastRowIndex(true),
dataset.RecordCount,
'Row count / record count mismatch'
);
dataset.First;
row := 1;
while not dataset.EoF do
begin
if (f.DataType in [ftString, ftWideString, ftMemo]) then
CheckEquals(
worksheet.ReadAsText(row, col),
f.AsString,
'Text mismatch in row ' + IntToStr(row)
)
else
if (f.DataType in [
ftInteger, {$IFDEF TEST_BYTE_FIELD}ftByte, {$ENDIF}
ftWord, ftSmallInt, ftLargeInt])
then
CheckEquals(
round(worksheet.ReadAsNumber(row, col)),
f.AsInteger,
'Integer value mismatch in row ' + IntToStr(row)
)
else if (f.DataType in [ftFloat, ftCurrency, ftBCD, ftFmtBCD]) then
CheckEquals(
worksheet.ReadAsNumber(row, col),
f.AsFloat,
FLOAT_EPS,
'Float value mismatch in row ' + IntToStr(row)
)
else if (f.DataType = ftDate) then
begin
CheckEquals(
true,
worksheet.ReadAsDateTime(row, col, dt),
'Invalid date in row ' + IntToStr(row)
);
CheckEquals(
dt,
f.AsDateTime,
FLOAT_EPS,
'Date value mismatch in row ' + IntToStr(row)
)
end
else if (f.DataType = ftTime) then
begin
CheckEquals(
true,
worksheet.ReadAsDateTime(row, col, dt),
'Invalid time in row ' + IntToStr(row)
);
CheckEquals(
dt,
f.AsDateTime,
FLOAT_EPS,
'Time value mismatch in row ' + IntToStr(row)
)
end
else if (f.DataType = ftDateTime) then
begin
CheckEquals(
true,
worksheet.ReadAsDateTime(row, col, dt),
'Invalid date/time in row ' + IntToStr(row)
);
CheckEquals(
dt,
f.AsDateTime,
FLOAT_EPS,
'Date/time value mismatch in row ' + IntToStr(row)
);
end;
inc(row);
dataset.Next;
end;
finally
workbook.Free;
end;
finally
dataset.Free;
end;
end;
procedure TReadFieldsTest.ReadIntegerField_AutoFieldDefs;
begin
ReadFieldTest(INT_COL, 'IntCol', true);
end;
procedure TReadFieldsTest.ReadByteField_AutoFieldDefs;
begin
ReadFieldTest(BYTE_COL, 'ByteCol', true);
end;
procedure TReadFieldsTest.ReadWordField_AutoFieldDefs;
begin
ReadFieldTest(WORD_COL, 'WordCol', true);
end;
procedure TReadFieldsTest.ReadFloatField_AutoFieldDefs;
begin
ReadFieldTest(FLOAT_COL, 'FloatCol', true);
end;
procedure TReadFieldsTest.ReadCurrencyField_AutoFieldDefs;
begin
ReadFieldTest(CURRENCY_COL, 'CurrencyCol', true);
end;
procedure TReadFieldsTest.ReadStringField_AutoFieldDefs;
begin
ReadFieldTest(STRING_COL, 'StringCol', true);
end;
procedure TReadFieldsTest.ReadMemoField_AutoFieldDefs;
begin
ReadFieldTest(MEMO_COL, 'MemoCol', true);
end;
procedure TReadFieldsTest.ReadBoolField_AutoFieldDefs;
begin
ReadFieldTest(BOOL_COL, 'BoolCol', true);
end;
procedure TReadFieldsTest.ReadDateField_AutoFieldDefs;
begin
ReadFieldTest(DATE_COL, 'DateCol', true);
end;
procedure TReadFieldsTest.ReadTimeField_AutoFieldDefs;
begin
ReadFieldTest(TIME_COL, 'TimeCol', true);
end;
procedure TReadFieldsTest.ReadDateTimeField_AutoFieldDefs;
begin
ReadFieldTest(DATETIME_COL, 'DateTimeCol', true);
end;
procedure TReadFieldsTest.ReadIntegerField;
begin
ReadFieldTest(INT_COL, 'IntCol', false);
end;
{$IFDEF TEST_BYTE_FIELD}
procedure TReadFieldsTest.ReadByteField;
begin
ReadFieldTest(BYTE_COL, 'ByteCol', false);
end;
{$ENDIF}
procedure TReadFieldsTest.ReadWordField;
begin
ReadFieldTest(WORD_COL, 'WordCol', false);
end;
procedure TReadFieldsTest.ReadFloatField;
begin
ReadFieldTest(FLOAT_COL, 'FloatCol', false);
end;
procedure TReadFieldsTest.ReadCurrencyField;
begin
ReadFieldTest(CURRENCY_COL, 'CurrencyCol', false);
end;
procedure TReadFieldsTest.ReadBCDField;
begin
ReadFieldTest(BCD_COL, 'BCDCol', false);
end;
procedure TReadFieldsTest.ReadFmtBCDField;
begin
ReadFieldTest(FMTBCD_COL, 'FmtBCDCol', false);
end;
procedure TReadFieldsTest.ReadStringField;
begin
ReadFieldTest(STRING_COL, 'StringCol', false);
end;
procedure TReadFieldsTest.ReadMemoField;
begin
ReadFieldTest(MEMO_COL, 'MemoCol', false);
end;
procedure TReadFieldsTest.ReadBoolField;
begin
ReadFieldTest(BOOL_COL, 'BoolCol', false);
end;
procedure TReadFieldsTest.ReadDateField;
begin
ReadFieldTest(DATE_COL, 'DateCol', false);
end;
procedure TReadFieldsTest.ReadTimeField;
begin
ReadFieldTest(TIME_COL, 'TimeCol', false);
end;
procedure TReadFieldsTest.ReadDateTimeField;
begin
ReadFieldTest(DATETIME_COL, 'DateTimeCol', false);
end;
initialization
RegisterTest(TReadFieldsTest);
end.

456
components/fpspreadsheet/unit-tests/dataset/searchtestunit.pas Normal file
View File

@ -0,0 +1,456 @@
unit SearchTestUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testutils, testregistry,
DB,
fpspreadsheet, fpsTypes, fpsDataset;
type
TSearchTest = class(TTestCase)
private
function CreateAndOpenDataset: TsWorksheetDataset;
procedure LocateTest(SearchInField: String; SearchValue: Variant;
ExpectedRecNo: Integer; Options: TLocateOptions = []);
procedure LookupTest(SearchInField: String; SearchValue: Variant;
ResultFields: String; ExpectedValues: Variant);
protected
procedure SetUp; override;
procedure TearDown; override;
published
procedure LocateTest_Int_Found;
procedure LocateTest_Int_NotFound;
procedure LocateTest_String_Found;
procedure LocateTest_String_Found_CaseInsensitive;
procedure LocateTest_String_NotFound;
procedure LocateTest_NonASCIIString_Found;
procedure LocateTest_NonASCIIString_Found_CaseInsensitive;
procedure LocateTest_NonASCIIString_NotFound;
procedure LocateTest_WideString_Found;
procedure LocateTest_WideString_Found_CaseInsensitive;
procedure LocateTest_WideString_NotFound;
procedure LocateTest_NonASCIIWideString_Found;
procedure LocateTest_NonASCIIWideString_Found_CaseInsensitive;
procedure LocateTest_NonASCIIWideString_NotFound;
procedure LookupTest_Int_Found;
procedure LookupTest_Int_NotFound;
procedure LookupTest_String_Found;
procedure LookupTest_String_NotFound;
procedure LookupTest_NonASCIIString_Found;
procedure LookupTest_NonASCIIString_NotFound;
procedure LookupTest_WideString_Found;
procedure LookupTest_WideString_NotFound;
procedure LookupTest_NonASCIIWideString_Found;
procedure LookupTest_NonASCIIWideString_NotFound;
end;
implementation
uses
Variants, LazUTF8;
const
FILE_NAME = 'testfile.xlsx';
SHEET_NAME = 'Sheet';
INT_COL = 0;
STRING_COL = 1;
WIDESTRING_COL = 2;
INT_FIELD = 'IntCol';
STRING_FIELD = 'StringCol';
WIDESTRING_FIELD = 'WideStringCol';
var
DataFileName: String;
const
NUM_ROWS = 5;
var
INT_VALUES: array[1..NUM_ROWS] of Integer = (
12, 20, -10, 83, 3
);
STRING_VALUES: array[1..NUM_ROWS] of String = (
'abc', 'a', 'Hallo', 'ijk', 'äöüαβγ'
);
WIDESTRING_VALUES: array[1..NUM_ROWS] of String = ( // Strings are converted to wide at runtime
'ABC', 'A', 'Test', 'ÄöüΓ', 'xyz'
);
function TSearchTest.CreateAndOpenDataset: TsWorksheetDataset;
begin
Result := TsWorksheetDataset.Create(nil);
Result.FileName := DataFileName;
Result.SheetName := SHEET_NAME;
Result.AutoFieldDefs := false;
Result.AddFieldDef(INT_FIELD, ftInteger);
Result.AddFieldDef(STRING_FIELD, ftString, 20);
Result.AddFieldDef(WIDESTRING_FIELD, ftWideString, 20);
Result.Open;
end;
procedure TSearchTest.LocateTest(SearchInField: String; SearchValue: Variant;
ExpectedRecNo: Integer; Options: TLocateOptions = []);
var
dataset: TsWorksheetDataset;
actualRecNo: Integer;
found: Boolean;
f: TField;
begin
dataset := CreateAndOpenDataset;
try
found := dataset.Locate(SearchInField, SearchValue, options);
if ExpectedRecNo = -1 then
CheckEquals(
false,
found,
'Record found unexpectedly.'
)
else
CheckEquals(
true,
found,
'Existing record not found.'
);
if found then
begin
actualRecNo := dataset.RecNo;
CheckEquals(
ExpectedRecNo,
actualRecNo,
'Mismatch of found RecNo.'
);
for f in dataset.Fields do
case f.FieldName of
INT_FIELD:
CheckEquals(
INT_VALUES[actualRecNo],
f.AsInteger,
'Value mismatch in integer field'
);
STRING_FIELD:
CheckEquals(
STRING_VALUES[actualRecNo],
f.AsString,
'Value mismatch in string field'
);
WIDESTRING_FIELD:
CheckEquals(
UTF8ToUTF16(WIDESTRING_VALUES[actualRecNo]),
f.AsWideString,
'Value mismatch in widestring field'
);
end;
end;
finally
dataset.Free;
end;
end;
procedure TSearchTest.LocateTest_Int_Found;
begin
LocateTest(INT_FIELD, -10, 3);
end;
procedure TSearchTest.LocateTest_Int_NotFound;
begin
LocateTest(INT_FIELD, 1000, -1);
end;
procedure TSearchTest.LocateTest_String_Found;
begin
LocateTest(STRING_FIELD, 'a', 2);
end;
procedure TSearchTest.LocateTest_String_Found_CaseInsensitive;
begin
LocateTest(STRING_FIELD, 'ABC', 1, [loCaseInsensitive]);
end;
procedure TSearchTest.LocateTest_String_NotFound;
begin
LocateTest(STRING_FIELD, 'ttt', -1);
end;
procedure TSearchTest.LocateTest_NonASCIIString_Found;
begin
LocateTest(STRING_FIELD, 'äöüαβγ', 5);
end;
procedure TSearchTest.LocateTest_NonASCIIString_Found_CaseInsensitive;
begin
LocateTest(STRING_FIELD, 'ÄöÜαβΓ', 5, [loCaseInsensitive]);
end;
procedure TSearchTest.LocateTest_NonASCIIString_NotFound;
begin
LocateTest(STRING_FIELD, 'ä', -1);
end;
procedure TSearchTest.LocateTest_WideString_Found;
begin
LocateTest(WIDESTRING_FIELD, WideString('ABC'), 1);
end;
procedure TSearchTest.LocateTest_WideString_Found_CaseInsensitive;
begin
LocateTest(WIDESTRING_FIELD, WideString('Abc'), 1, [loCaseInsensitive]);
end;
procedure TSearchTest.LocateTest_WideString_NotFound;
begin
LocateTest(WIDESTRING_FIELD, WideString('abc'), -1);
end;
procedure TSearchTest.LocateTest_NonASCIIWideString_Found;
var
ws: WideString;
begin
ws := UTF8ToUTF16('ÄöüΓ');
LocateTest(WIDESTRING_FIELD, ws, 4);
end;
procedure TSearchTest.LocateTest_NonASCIIWideString_Found_CaseInsensitive;
var
ws: Widestring;
begin
ws := UTF8ToUTF16('Äöüγ');
LocateTest(WIDESTRING_FIELD, ws, 4, [loCaseInsensitive]);
end;
procedure TSearchTest.LocateTest_NonASCIIWideString_NotFound;
var
ws: WideString;
begin
ws := UTF8ToUTF16('ä-α');
LocateTest(WIDESTRING_FIELD, ws, -1);
end;
// -----------------------------------------------------------------------------
procedure TSearchTest.LookupTest(SearchInField: String; SearchValue: Variant;
ResultFields: String; ExpectedValues: Variant);
var
dataset: TsWorksheetDataset;
savedRecNo: Integer;
i, j: Integer;
actualValues: Variant;
expectedInt, actualInt: Integer;
expectedStr, actualStr: String;
expectedWideStr, actualWideStr: WideString;
L: TStringList;
begin
dataset := CreateAndOpenDataset;
try
savedRecNo := dataset.RecNo;
actualValues := dataset.Lookup(SearchInField, SearchValue, ResultFields);
// The active record position must not be changed
CheckEquals(
savedRecNo,
dataset.RecNo,
'Lookup must not move the active record.'
);
// Compare count of elements in value arrays
CheckEquals(
VarArrayDimCount(ExpectedValues),
VarArrayDimCount(actualValues),
'Mismatch in found field values.'
);
if VarIsNull(ExpectedValues) then
begin
CheckEquals(
true,
varIsNull(actualValues),
'Record found but not expected.'
);
exit;
end;
if not VarIsNull(ExpectedValues) then
CheckEquals(
false,
varIsNull(actualValues),
'Record expected but not found.'
);
L := TStringList.Create;
L.StrictDelimiter := true;
L.Delimiter := ';';
L.DelimitedText := ResultFields;
// Compare lookup values with expected values
for i := 0 to dataset.Fields.Count-1 do
begin
j := L.IndexOf(dataset.Fields[i].FieldName);
if j = -1 then
continue;
case dataset.Fields[i].DataType of
ftInteger:
begin
expectedInt := ExpectedValues[j];
actualInt := actualvalues[j];
CheckEquals(
expectedInt,
actualInt,
'Integer field lookup value mismatch'
);
end;
ftString:
begin
expectedStr := VarToStr(ExpectedValues[j]);
actualStr := VarToStr(actualValues[j]);
CheckEquals(
expectedStr,
actualStr,
'String field lookup value mismatch'
);
end;
ftWideString:
begin
expectedWideStr := VarToWideStr(ExpectedValues[j]);
actualWideStr := VarToWideStr(actualValues[j]);
CheckEquals(
ExpectedWideStr,
actualWideStr,
'Widestring field lookup value mismatch'
);
end;
else
raise Exception.Create('Unsupported field type in LookupTest');
end;
end;
L.Free;
finally
dataset.Free;
end;
end;
procedure TSearchTest.LookupTest_Int_Found;
var
ws: wideString;
begin
ws := UTF8ToUTF16(WIDESTRING_VALUES[2]);
LookupTest(INT_FIELD, 20, STRING_FIELD+';'+WIDESTRING_FIELD, VarArrayOf(['a', ws]));
end;
procedure TSearchTest.LookupTest_Int_NotFound;
begin
LookupTest(INT_FIELD, 200, STRING_FIELD+';'+WIDESTRING_FIELD, Null);
end;
procedure TSearchTest.LookupTest_String_Found;
var
ws: wideString;
begin
ws := UTF8ToUTF16(WIDESTRING_VALUES[3]);
LookupTest(STRING_FIELD, 'Hallo', INT_FIELD+';'+WIDESTRING_FIELD, VarArrayOf([-10, ws]));
end;
procedure TSearchTest.LookupTest_String_NotFound;
begin
LookupTest(STRING_FIELD, 'Halloooo', INT_FIELD+';'+WIDESTRING_FIELD, Null);
end;
procedure TSearchTest.LookupTest_NonASCIIString_Found;
var
ws: wideString;
begin
ws := UTF8ToUTF16('xyz');
LookupTest(STRING_FIELD, 'äöüαβγ', INT_FIELD+';'+WIDESTRING_FIELD, VarArrayOf([3, ws]));
end;
procedure TSearchTest.LookupTest_NonASCIIString_NotFound;
begin
LookupTest(STRING_FIELD, 'ÄÄÄÄα', INT_FIELD+';'+WIDESTRING_FIELD, Null);
end;
procedure TSearchTest.LookupTest_WideString_Found;
var
ws: wideString;
begin
ws := UTF8ToUTF16('ABC');
LookupTest(WIDESTRING_FIELD, ws, INT_FIELD+';'+STRING_FIELD, VarArrayOf([12, 'abc']));
end;
procedure TSearchTest.LookupTest_WideString_NotFound;
var
ws: wideString;
begin
ws := UTF8ToUTF16('ABCD');
LookupTest(WIDESTRING_FIELD, ws, INT_FIELD+';'+STRING_FIELD, null);
end;
procedure TSearchTest.LookupTest_NonASCIIWideString_Found;
var
ws: wideString;
begin
ws := UTF8ToUTF16('ÄöüΓ');
LookupTest(WIDESTRING_FIELD, ws, INT_FIELD+';'+STRING_FIELD, VarArrayOf([83, 'ijk']));
end;
procedure TSearchTest.LookupTest_NonASCIIWideString_NotFound;
var
ws: wideString;
begin
ws := UTF8ToUTF16('Äöαβ');
LookupTest(WIDESTRING_FIELD, ws, INT_FIELD+';'+STRING_FIELD, null);
end;
// -----------------------------------------------------------------------------
procedure TSearchTest.SetUp;
var
r: Integer;
workbook: TsWorkbook;
worksheet: TsWorksheet;
begin
// Create test spreadsheet file
workbook := TsWorkbook.Create;
try
// Create worksheet
worksheet := workbook.AddWorkSheet(SHEET_NAME);
// Write headers (= field names)
worksheet.WriteText(0, INT_COL, INT_FIELD);
worksheet.WriteText(0, STRING_COL, STRING_FIELD);
worksheet.WriteText(0, WIDESTRING_COL, WIDESTRING_FIELD);
// Write values
for r := 1 to NUM_ROWS do
begin
worksheet.WriteNumber(r, INT_COL, INT_VALUES[r], nfFixed, 0);
worksheet.WriteText(r, STRING_COL, STRING_VALUES[r]);
worksheet.WriteText(r, WIDESTRING_COL, WIDESTRING_VALUES[r]);
end;
// Save
DataFileName := GetTempDir + FILE_NAME;
workbook.WriteToFile(DataFileName, true);
finally
workbook.Free;
end;
end;
procedure TSearchTest.TearDown;
begin
if FileExists(DataFileName) then DeleteFile(DataFileName);
end;
initialization
RegisterTest(TSearchTest);
end.

231
components/fpspreadsheet/unit-tests/dataset/sorttestunit.pas Normal file
View File

@ -0,0 +1,231 @@
unit SortTestUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testregistry,
DB,
fpspreadsheet, fpstypes, fpsutils, fpsdataset;
type
TSortTest= class(TTestCase)
private
function CreateAndOpenDataset: TsWorksheetDataset;
protected
procedure SetUp; override;
procedure TearDown; override;
procedure SortTest(SortField: String; Descending, CaseInsensitive: Boolean);
published
procedure SortTest_IntField_Ascending;
procedure SortTest_IntField_Descending;
procedure SortTest_TextField_Ascending_CaseSensitive;
procedure SortTest_TextField_Descending_CaseSensitive;
procedure SortTest_TextField_Ascending_CaseInsensitive;
procedure SortTest_TextField_Descending_CaseInsensitive;
end;
implementation
const
FILE_NAME = 'testfile.xlsx';
SHEET_NAME = 'Sheet';
INT_COL = 0;
TEXT_COL = 1;
INT_FIELD = 'IntCol';
TEXT_FIELD = 'TextCol';
var
DataFileName: String;
type
TTestRow = record
IntValue: Integer;
TextValue: String;
end;
const
// Unsorted test values
UNSORTED: array[0..4] of TTestRow = ( // Index
(IntValue: 10; TextValue: 'abc'), // 0
(IntValue: 1; TextValue: 'ABC'), // 1
(IntValue: 1; TextValue: 'a'), // 2
(IntValue: 2; TextValue: 'A'), // 3
(IntValue: -1; TextValue: 'xyz') // 4
);
// These are the indexes into the UNSORTED array after sorting
SORTED_BY_INT_ASCENDING: array[0..4] of Integer = (4, 1, 2, 3, 0);
SORTED_BY_INT_DESCENDING: array[0..4] of Integer = (0, 3, 2, 1, 4);
SORTED_BY_TEXT_ASCENDING_CASESENS: array[0..4] of Integer = (2, 0, 3, 1, 4);
SORTED_BY_TEXT_DESCENDING_CASESENS: array[0..4] of Integer = (4, 1, 3, 0, 2);
SORTED_BY_TEXT_ASCENDING_CASEINSENS: array[0..4] of Integer = (3, 2, 1, 0, 4);
SORTED_BY_TEXT_DESCENDING_CASEINSENS: array[0..4] of Integer = (4, 1, 0, 3, 2);
// Note on case-insensitive sorting: Depending on implementation of the
// sorting algorithms different results can be obtained for which the
// uppercased texts are the same. Therefore, Excel yields different result
// than FPSpreadsheet. Above indices are for FPSpreadsheet.
function TSortTest.CreateAndOpenDataset: TsWorksheetDataset;
begin
Result := TsWorksheetDataset.Create(nil);
Result.FileName := DataFileName;
Result.SheetName := SHEET_NAME;
Result.Open;
end;
procedure TSortTest.SortTest(SortField: String; Descending, CaseInsensitive: Boolean);
var
dataset: TsWorksheetDataset;
options: TsSortOptions;
intField: TField;
textField: TField;
actualInt: Integer;
actualText: String;
expectedInt: Integer;
expectedText: String;
i, sortedIdx: Integer;
begin
options := [];
if Descending then Include(options, ssoDescending);
if CaseInsensitive then Include(options, ssoCaseInsensitive);
dataset := CreateAndOpenDataset;
try
dataset.SortOnField(SortField, options);
// For debugging
dataset.Close; // to write the worksheet to file
dataset.Open;
intField := dataset.FieldByName(INT_FIELD);
textField := dataset.FieldByName(TEXT_FIELD);
dataset.First;
i := 0;
while not dataset.EOF do
begin
if SortField = INT_FIELD then
begin
if Descending then
sortedIdx := SORTED_BY_INT_DESCENDING[i]
else
sortedIdx := SORTED_BY_INT_ASCENDING[i];
end else
if SortField = TEXT_FIELD then
begin
if Descending then
begin
if CaseInsensitive then
sortedIdx := SORTED_BY_TEXT_DESCENDING_CASEINSENS[i]
else
sortedIdx := SORTED_BY_TEXT_DESCENDING_CASESENS[i];
end else
begin
if CaseInsensitive then
sortedIdx := SORTED_BY_TEXT_ASCENDING_CASEINSENS[i]
else
sortedIdx := SORTED_BY_TEXT_ASCENDING_CASESENS[i];
end;
end;
expectedInt := UNSORTED[sortedIdx].IntValue;
expectedText := UNSORTED[sortedIdx].TextValue;
actualInt := intField.AsInteger;
actualText := textField.AsString;
CheckEquals(
expectedInt,
actualInt,
'Integer field value mismatch in row ' + IntToStr(i)
);
CheckEquals(
expectedText,
actualText,
'Text field value mismatch in row ' + IntToStr(i)
);
inc(i);
dataset.Next;
end;
finally
dataset.Free;
end;
end;
procedure TSortTest.SortTest_IntField_Ascending;
begin
SortTest(INT_FIELD, false, false);
end;
procedure TSortTest.SortTest_IntField_Descending;
begin
SortTest(INT_FIELD, true, false);
end;
procedure TSortTest.SortTest_TextField_Ascending_CaseSensitive;
begin
SortTest(TEXT_FIELD, false, false);
end;
procedure TSortTest.SortTest_TextField_Descending_CaseSensitive;
begin
SortTest(TEXT_FIELD, true, false);
end;
procedure TSortTest.SortTest_TextField_Ascending_CaseInsensitive;
begin
SortTest(TEXT_FIELD, false, true);
end;
procedure TSortTest.SortTest_TextField_Descending_CaseInsensitive;
begin
SortTest(TEXT_FIELD, true, true);
end;
procedure TSortTest.SetUp;
var
i, r: Integer;
workbook: TsWorkbook;
worksheet: TsWorksheet;
begin
// Create test spreadsheet file
workbook := TsWorkbook.Create;
try
// Create worksheet
worksheet := workbook.AddWorkSheet(SHEET_NAME);
// Write headers (= field names)
worksheet.WriteText(0, INT_COL, INT_FIELD);
worksheet.WriteText(0, TEXT_COL, TEXT_FIELD);
// Write values
for i := Low(UNSORTED) to High(UNSORTED) do
begin
r := 1 + (i - Low(UNSORTED));
worksheet.WriteNumber(r, INT_COL, UNSORTED[i].IntValue, nfFixed, 0);
worksheet.WriteText(r, TEXT_COL, UNSORTED[i].TextValue);
end;
// Save
DataFileName := GetTempDir + FILE_NAME;
workbook.WriteToFile(DataFileName, true);
finally
workbook.Free;
end;
end;
procedure TSortTest.TearDown;
begin
if FileExists(DataFileName) then DeleteFile(DataFileName);
end;
initialization
RegisterTest(TSortTest);
end.