You've already forked lazarus-ccr
fpspreadsheet: Add tool for measuring writing and reading speeds for various file sizes and options. Based on a tool by rvk (http://forum.lazarus.freepascal.org/index.php/topic,25142.msg152919.html#msg152919).
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3354 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@@ -0,0 +1,86 @@
|
|||||||
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<Version Value="9"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<General>
|
||||||
|
<SessionStorage Value="InProjectDir"/>
|
||||||
|
<MainUnit Value="0"/>
|
||||||
|
<Title Value="fpsspeedtest"/>
|
||||||
|
<ResourceType Value="res"/>
|
||||||
|
<UseXPManifest Value="True"/>
|
||||||
|
</General>
|
||||||
|
<i18n>
|
||||||
|
<EnableI18N LFM="False"/>
|
||||||
|
</i18n>
|
||||||
|
<VersionInfo>
|
||||||
|
<StringTable ProductVersion=""/>
|
||||||
|
</VersionInfo>
|
||||||
|
<BuildModes Count="1">
|
||||||
|
<Item1 Name="Default" Default="True"/>
|
||||||
|
</BuildModes>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
<DestinationDirectory Value="c:\temp\fpsspeedtest"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<RunParams>
|
||||||
|
<local>
|
||||||
|
<FormatVersion Value="1"/>
|
||||||
|
</local>
|
||||||
|
</RunParams>
|
||||||
|
<RequiredPackages Count="3">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="SQLDBLaz"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<PackageName Value="laz_fpspreadsheet"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item3>
|
||||||
|
</RequiredPackages>
|
||||||
|
<Units Count="2">
|
||||||
|
<Unit0>
|
||||||
|
<Filename Value="fpsspeedtest.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit0>
|
||||||
|
<Unit1>
|
||||||
|
<Filename Value="mainform.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ComponentName Value="Form1"/>
|
||||||
|
<HasResources Value="True"/>
|
||||||
|
<ResourceBaseClass Value="Form"/>
|
||||||
|
<UnitName Value="mainform"/>
|
||||||
|
</Unit1>
|
||||||
|
</Units>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="11"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<Target>
|
||||||
|
<Filename Value="fpsspeedtest"/>
|
||||||
|
</Target>
|
||||||
|
<SearchPaths>
|
||||||
|
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||||
|
<OtherUnitFiles Value="C:\Users\Rik\Downloads\udata\"/>
|
||||||
|
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
|
</SearchPaths>
|
||||||
|
<Linking>
|
||||||
|
<Options>
|
||||||
|
<Win32>
|
||||||
|
<GraphicApplication Value="True"/>
|
||||||
|
</Win32>
|
||||||
|
</Options>
|
||||||
|
</Linking>
|
||||||
|
</CompilerOptions>
|
||||||
|
<Debugging>
|
||||||
|
<Exceptions Count="2">
|
||||||
|
<Item1>
|
||||||
|
<Name Value="EOutOfMemory"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<Name Value="RunError(203)"/>
|
||||||
|
</Item2>
|
||||||
|
</Exceptions>
|
||||||
|
</Debugging>
|
||||||
|
</CONFIG>
|
||||||
@@ -0,0 +1,22 @@
|
|||||||
|
program fpsspeedtest;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
uses
|
||||||
|
// heaptrc,
|
||||||
|
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||||
|
cthreads,
|
||||||
|
{$ENDIF}{$ENDIF}
|
||||||
|
Interfaces, // this includes the LCL widgetset
|
||||||
|
Forms, laz_fpspreadsheet,
|
||||||
|
mainform;
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
begin
|
||||||
|
RequireDerivedFormResource := True;
|
||||||
|
Application.Initialize;
|
||||||
|
Application.CreateForm(TForm1, Form1);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
|
|
||||||
183
components/fpspreadsheet/examples/fpsSpeedTest/mainform.lfm
Normal file
183
components/fpspreadsheet/examples/fpsSpeedTest/mainform.lfm
Normal file
@@ -0,0 +1,183 @@
|
|||||||
|
object Form1: TForm1
|
||||||
|
Left = 445
|
||||||
|
Height = 546
|
||||||
|
Top = 178
|
||||||
|
Width = 739
|
||||||
|
Caption = 'fpsSpeedTest'
|
||||||
|
ClientHeight = 546
|
||||||
|
ClientWidth = 739
|
||||||
|
KeyPreview = True
|
||||||
|
OnCloseQuery = FormCloseQuery
|
||||||
|
OnCreate = FormCreate
|
||||||
|
OnKeyPress = FormKeyPress
|
||||||
|
LCLVersion = '1.3'
|
||||||
|
object StatusBar: TStatusBar
|
||||||
|
Left = 0
|
||||||
|
Height = 23
|
||||||
|
Top = 523
|
||||||
|
Width = 739
|
||||||
|
Panels = <>
|
||||||
|
end
|
||||||
|
object Panel1: TPanel
|
||||||
|
Left = 0
|
||||||
|
Height = 42
|
||||||
|
Top = 0
|
||||||
|
Width = 739
|
||||||
|
Align = alTop
|
||||||
|
BevelOuter = bvNone
|
||||||
|
ClientHeight = 42
|
||||||
|
ClientWidth = 739
|
||||||
|
TabOrder = 1
|
||||||
|
object BtnWrite: TButton
|
||||||
|
Left = 8
|
||||||
|
Height = 29
|
||||||
|
Top = 8
|
||||||
|
Width = 75
|
||||||
|
Caption = 'Write'
|
||||||
|
OnClick = BtnWriteClick
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object LblCancel: TLabel
|
||||||
|
Left = 208
|
||||||
|
Height = 30
|
||||||
|
Top = 6
|
||||||
|
Width = 309
|
||||||
|
Caption = 'Press ESC to cancel when current file is completely written.'#13#10'This may take some time...'
|
||||||
|
ParentColor = False
|
||||||
|
Visible = False
|
||||||
|
end
|
||||||
|
object BtnRead: TButton
|
||||||
|
Left = 96
|
||||||
|
Height = 29
|
||||||
|
Top = 8
|
||||||
|
Width = 75
|
||||||
|
Caption = 'Read'
|
||||||
|
OnClick = BtnReadClick
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object ParameterPanel: TPanel
|
||||||
|
Left = 0
|
||||||
|
Height = 477
|
||||||
|
Top = 46
|
||||||
|
Width = 150
|
||||||
|
Align = alLeft
|
||||||
|
BevelOuter = bvNone
|
||||||
|
ClientHeight = 477
|
||||||
|
ClientWidth = 150
|
||||||
|
TabOrder = 2
|
||||||
|
object CbVirtualModeOnly: TCheckBox
|
||||||
|
Left = 8
|
||||||
|
Height = 19
|
||||||
|
Top = 8
|
||||||
|
Width = 114
|
||||||
|
Caption = 'Virtual mode only'
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object RgContent: TRadioGroup
|
||||||
|
Left = 8
|
||||||
|
Height = 84
|
||||||
|
Top = 40
|
||||||
|
Width = 136
|
||||||
|
AutoFill = True
|
||||||
|
Caption = 'Content'
|
||||||
|
ChildSizing.LeftRightSpacing = 6
|
||||||
|
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
|
||||||
|
ChildSizing.EnlargeVertical = crsHomogenousChildResize
|
||||||
|
ChildSizing.ShrinkHorizontal = crsScaleChilds
|
||||||
|
ChildSizing.ShrinkVertical = crsScaleChilds
|
||||||
|
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
||||||
|
ChildSizing.ControlsPerLine = 1
|
||||||
|
ClientHeight = 66
|
||||||
|
ClientWidth = 132
|
||||||
|
ItemIndex = 0
|
||||||
|
Items.Strings = (
|
||||||
|
'Strings'
|
||||||
|
'Numbers'
|
||||||
|
'Mixed 50:50'
|
||||||
|
)
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object CgFormats: TCheckGroup
|
||||||
|
Left = 8
|
||||||
|
Height = 137
|
||||||
|
Top = 140
|
||||||
|
Width = 136
|
||||||
|
AutoFill = True
|
||||||
|
Caption = 'File formats: '
|
||||||
|
ChildSizing.LeftRightSpacing = 6
|
||||||
|
ChildSizing.TopBottomSpacing = 6
|
||||||
|
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
|
||||||
|
ChildSizing.EnlargeVertical = crsHomogenousChildResize
|
||||||
|
ChildSizing.ShrinkHorizontal = crsScaleChilds
|
||||||
|
ChildSizing.ShrinkVertical = crsScaleChilds
|
||||||
|
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
||||||
|
ChildSizing.ControlsPerLine = 1
|
||||||
|
ClientHeight = 119
|
||||||
|
ClientWidth = 132
|
||||||
|
Items.Strings = (
|
||||||
|
'ods'
|
||||||
|
'xlsx'
|
||||||
|
'xls (BIFF 8)'
|
||||||
|
'xls (BIFF 5)'
|
||||||
|
'xls (BIFF 2)'
|
||||||
|
)
|
||||||
|
TabOrder = 2
|
||||||
|
Data = {
|
||||||
|
050000000202020202
|
||||||
|
}
|
||||||
|
end
|
||||||
|
object CgRowCount: TCheckGroup
|
||||||
|
Left = 8
|
||||||
|
Height = 177
|
||||||
|
Top = 295
|
||||||
|
Width = 136
|
||||||
|
AutoFill = True
|
||||||
|
Caption = 'Row count'
|
||||||
|
ChildSizing.LeftRightSpacing = 6
|
||||||
|
ChildSizing.TopBottomSpacing = 6
|
||||||
|
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
|
||||||
|
ChildSizing.EnlargeVertical = crsHomogenousChildResize
|
||||||
|
ChildSizing.ShrinkHorizontal = crsScaleChilds
|
||||||
|
ChildSizing.ShrinkVertical = crsScaleChilds
|
||||||
|
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
||||||
|
ChildSizing.ControlsPerLine = 1
|
||||||
|
ClientHeight = 159
|
||||||
|
ClientWidth = 132
|
||||||
|
Items.Strings = (
|
||||||
|
'10k'
|
||||||
|
'20k'
|
||||||
|
'30k'
|
||||||
|
'40k'
|
||||||
|
'50k'
|
||||||
|
'60k'
|
||||||
|
'100k (not for BIFF)'
|
||||||
|
)
|
||||||
|
TabOrder = 3
|
||||||
|
Data = {
|
||||||
|
0700000002020202020202
|
||||||
|
}
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object Bevel1: TBevel
|
||||||
|
Left = 0
|
||||||
|
Height = 4
|
||||||
|
Top = 42
|
||||||
|
Width = 739
|
||||||
|
Align = alTop
|
||||||
|
Shape = bsTopLine
|
||||||
|
end
|
||||||
|
object Memo: TMemo
|
||||||
|
Left = 150
|
||||||
|
Height = 477
|
||||||
|
Top = 46
|
||||||
|
Width = 589
|
||||||
|
Align = alClient
|
||||||
|
Font.Height = -12
|
||||||
|
Font.Name = 'Courier New'
|
||||||
|
Font.Pitch = fpFixed
|
||||||
|
ParentFont = False
|
||||||
|
ScrollBars = ssAutoVertical
|
||||||
|
TabOrder = 3
|
||||||
|
end
|
||||||
|
end
|
||||||
549
components/fpspreadsheet/examples/fpsSpeedTest/mainform.pas
Normal file
549
components/fpspreadsheet/examples/fpsSpeedTest/mainform.pas
Normal file
@@ -0,0 +1,549 @@
|
|||||||
|
unit mainform;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, Forms, Controls, Graphics,
|
||||||
|
Dialogs, StdCtrls, ComCtrls, ExtCtrls, iniFiles, fpSpreadsheet;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TForm1 }
|
||||||
|
|
||||||
|
TForm1 = class(TForm)
|
||||||
|
Bevel1: TBevel;
|
||||||
|
BtnWrite: TButton;
|
||||||
|
BtnRead: TButton;
|
||||||
|
CgFormats: TCheckGroup;
|
||||||
|
CgRowCount: TCheckGroup;
|
||||||
|
CbVirtualModeOnly: TCheckBox;
|
||||||
|
LblCancel: TLabel;
|
||||||
|
Panel1: TPanel;
|
||||||
|
Memo: TMemo;
|
||||||
|
ParameterPanel: TPanel;
|
||||||
|
RgContent: TRadioGroup;
|
||||||
|
StatusBar: TStatusBar;
|
||||||
|
procedure BtnReadClick(Sender: TObject);
|
||||||
|
procedure BtnWriteClick(Sender: TObject);
|
||||||
|
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure FormKeyPress(Sender: TObject; var Key: char);
|
||||||
|
private
|
||||||
|
{ private declarations }
|
||||||
|
FDir: String;
|
||||||
|
FEscape: Boolean;
|
||||||
|
FCurFormat: TsSpreadsheetFormat;
|
||||||
|
procedure EnableControls(AEnable: Boolean);
|
||||||
|
function GetRowCount(AIndex: Integer): Integer;
|
||||||
|
procedure NeedCellString(Sender: TObject; ARow, ACol: Cardinal;
|
||||||
|
var AValue: Variant; var AStyleCell: PCell);
|
||||||
|
procedure NeedCellNumber(Sender: TObject; ARow, ACol: Cardinal;
|
||||||
|
var AValue: Variant; var AStyleCell: PCell);
|
||||||
|
procedure NeedCellStringAndNumber(Sender: TObject; ARow, ACol: Cardinal;
|
||||||
|
var AValue: Variant; var AStyleCell: PCell);
|
||||||
|
procedure ReadFromIni;
|
||||||
|
procedure WriteToIni;
|
||||||
|
procedure RunReadTest(Idx: Integer; Log: String;
|
||||||
|
Options: TsWorkbookWritingOptions);
|
||||||
|
procedure RunWriteTest(Idx: integer; Rows: integer; Log: string;
|
||||||
|
Options: TsWorkbookWritingOptions);
|
||||||
|
procedure StatusMsg(const AMsg: String);
|
||||||
|
public
|
||||||
|
{ public declarations }
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Form1: TForm1;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
LclIntf, StrUtils;
|
||||||
|
|
||||||
|
{$R *.lfm}
|
||||||
|
|
||||||
|
const
|
||||||
|
fmtODS = 0;
|
||||||
|
fmtXLSX = 1;
|
||||||
|
fmtXLS8 = 2;
|
||||||
|
fmtXLS5 = 3;
|
||||||
|
fmtXLS2 = 4;
|
||||||
|
|
||||||
|
rc10k = 0;
|
||||||
|
rc20k = 1;
|
||||||
|
rc30k = 2;
|
||||||
|
rc40k = 3;
|
||||||
|
rc50k = 4;
|
||||||
|
rc60k = 5;
|
||||||
|
rc100k = 6;
|
||||||
|
|
||||||
|
CONTENT_PREFIX: array[0..2] of Char = ('S', 'N', 'M');
|
||||||
|
FORMAT_EXT: array[0..4] of String = ('.ods', '.xlsx', '.xls', '_b5.xls', '_b2.xls');
|
||||||
|
SPREAD_FORMAT: array[0..4] of TsSpreadsheetFormat = (sfOpenDocument, sfOOXML, sfExcel8, sfExcel5, sfExcel2);
|
||||||
|
|
||||||
|
COLCOUNT = 100;
|
||||||
|
|
||||||
|
{ TForm1 }
|
||||||
|
|
||||||
|
procedure TForm1.NeedCellString(Sender: TObject; ARow, ACol: cardinal;
|
||||||
|
var AValue: variant; var AStyleCell: PCell);
|
||||||
|
var
|
||||||
|
S: string;
|
||||||
|
begin
|
||||||
|
S := 'Xy' + IntToStr(ARow) + 'x' + IntToStr(ACol);
|
||||||
|
AValue := S;
|
||||||
|
if ARow mod 1000 = 0 then
|
||||||
|
StatusMsg(Format('Writing %s row %d...', [GetFileFormatName(FCurFormat), ARow]));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.NeedCellNumber(Sender: TObject; ARow, ACol: cardinal;
|
||||||
|
var AValue: variant; var AStyleCell: PCell);
|
||||||
|
begin
|
||||||
|
AValue := ARow * 1E5 + ACol;
|
||||||
|
if ARow mod 1000 = 0 then
|
||||||
|
StatusMsg(Format('Writing %s row %d...', [GetFileFormatName(FCurFormat), ARow]));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.NeedCellStringAndNumber(Sender: TObject; ARow, ACol: cardinal;
|
||||||
|
var AValue: variant; var AStyleCell: PCell);
|
||||||
|
begin
|
||||||
|
if odd(ARow + ACol) then
|
||||||
|
NeedCellString(Sender, ARow, ACol, AValue, AStyleCell)
|
||||||
|
else
|
||||||
|
NeedCellNumber(Sender, ARow, ACol, AValue, AStyleCell);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.RunReadTest(Idx: Integer; Log: String;
|
||||||
|
Options: TsWorkbookWritingOptions);
|
||||||
|
var
|
||||||
|
MyWorkbook: TsWorkbook;
|
||||||
|
MyWorksheet: TsWorksheet;
|
||||||
|
Tm: DWord;
|
||||||
|
fName, s: String;
|
||||||
|
i, j: Integer;
|
||||||
|
F: File;
|
||||||
|
ok: Boolean;
|
||||||
|
begin
|
||||||
|
s := Trim(Log);
|
||||||
|
|
||||||
|
Log := Log + ' ';
|
||||||
|
|
||||||
|
try
|
||||||
|
for i := 0 to CgFormats.Items.Count-1 do begin
|
||||||
|
if FEscape then begin
|
||||||
|
Log := 'Test aborted';
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if not CgFormats.Checked[i] then
|
||||||
|
continue;
|
||||||
|
|
||||||
|
// Currently no reader support for xlsx, skip test to avoid the exception.
|
||||||
|
if SPREAD_FORMAT[i] = sfOOXML then begin
|
||||||
|
Log := Log + ' n/a ';
|
||||||
|
continue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
FCurFormat := SPREAD_FORMAT[i];
|
||||||
|
|
||||||
|
ok := false;
|
||||||
|
for j:=1 to 4 do begin
|
||||||
|
fName := FDir + CONTENT_PREFIX[RgContent.ItemIndex] + Copy(s, 1, Pos(' ', s)-1) + '_' + IntToStr(j) + FORMAT_EXT[i];
|
||||||
|
if not FileExists(fname) then
|
||||||
|
continue;
|
||||||
|
AssignFile(F, fname);
|
||||||
|
Reset(F);
|
||||||
|
if FileSize(F) = 0 then
|
||||||
|
continue;
|
||||||
|
CloseFile(F);
|
||||||
|
|
||||||
|
MyWorkbook := TsWorkbook.Create;
|
||||||
|
try
|
||||||
|
Application.ProcessMessages;
|
||||||
|
Tm := GetTickCount;
|
||||||
|
try
|
||||||
|
MyWorkbook.ReadFromFile(fname, SPREAD_FORMAT[i]);
|
||||||
|
Log := Log + format('%5.1f ', [(GetTickCount - Tm) / 1000]);
|
||||||
|
ok := true;
|
||||||
|
break;
|
||||||
|
except
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
MyWorkbook.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if not ok then Log := Log + ' xxxx ';
|
||||||
|
end;
|
||||||
|
|
||||||
|
finally
|
||||||
|
Memo.Append(TrimRight(Log));
|
||||||
|
StatusMsg('');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.RunWriteTest(Idx: integer; Rows: integer; Log: string;
|
||||||
|
Options: TsWorkbookWritingOptions);
|
||||||
|
var
|
||||||
|
MyWorkbook: TsWorkbook;
|
||||||
|
MyWorksheet: TsWorksheet;
|
||||||
|
ARow, ACol: cardinal;
|
||||||
|
Tm: DWORD;
|
||||||
|
fName, S: string;
|
||||||
|
k: Integer;
|
||||||
|
begin
|
||||||
|
MyWorkbook := TsWorkbook.Create;
|
||||||
|
try
|
||||||
|
if FEscape then begin
|
||||||
|
Log := 'Test aborted';
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
MyWorksheet := MyWorkbook.AddWorksheet('Sheet1');
|
||||||
|
MyWorkbook.WritingOptions := Options;
|
||||||
|
|
||||||
|
Application.ProcessMessages;
|
||||||
|
Tm := GetTickCount;
|
||||||
|
|
||||||
|
try
|
||||||
|
if woVirtualMode in Options then
|
||||||
|
begin
|
||||||
|
MyWorkbook.VirtualRowCount := Rows;
|
||||||
|
MyWorkbook.VirtualColCount := COLCOUNT;
|
||||||
|
case RgContent.ItemIndex of
|
||||||
|
0: MyWorkbook.OnNeedCellData := @NeedCellString;
|
||||||
|
1: MyWorkbook.OnNeedCellData := @NeedCellNumber;
|
||||||
|
2: MyWorkbook.OnNeedCellData := @NeedCellStringAndNumber;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
for ARow := 0 to Rows - 1 do
|
||||||
|
begin
|
||||||
|
if ARow mod 1000 = 0 then begin
|
||||||
|
StatusMsg(Format('Populating row %d', [ARow]));
|
||||||
|
if FEscape then begin
|
||||||
|
Log := 'Test aborted';
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
case RgContent.ItemIndex of
|
||||||
|
0: for ACol := 0 to COLCOUNT-1 do begin
|
||||||
|
S := 'Xy' + IntToStr(ARow) + 'x' + IntToStr(ACol);
|
||||||
|
MyWorksheet.WriteUTF8Text(ARow, ACol, S);
|
||||||
|
end;
|
||||||
|
1: for ACol := 0 to COLCOUNT-1 do
|
||||||
|
MyWorksheet.WriteNumber(ARow, ACol, 1E5*ARow + ACol);
|
||||||
|
2: for ACol := 0 to COLCOUNT-1 do
|
||||||
|
if (odd(ARow) and odd(ACol)) or odd(ARow+ACol) then begin
|
||||||
|
S := 'Xy' + IntToStr(ARow) + 'x' + IntToStr(ACol);
|
||||||
|
MyWorksheet.WriteUTF8Text(ARow, ACol, S);
|
||||||
|
end else
|
||||||
|
MyWorksheet.WriteNumber(ARow, ACol, 1E5*ARow + ACol);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
Log := Log + format('xxxx ', [(GetTickCount - Tm) / 1000]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
fname := Trim(Log);
|
||||||
|
fname := CONTENT_PREFIX[RgContent.ItemIndex] + copy(fname, 1, pos(' ', fname)-1);
|
||||||
|
fname := FDir + fname + '_' + IntToStr(idx);
|
||||||
|
|
||||||
|
Log := Log + ' ' + format('%5.1f ', [(GetTickCount - Tm) / 1000]);
|
||||||
|
|
||||||
|
for k := 0 to CgFormats.Items.Count-1 do begin
|
||||||
|
if FEscape then begin
|
||||||
|
Log := 'Test aborted';
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if not CgFormats.Checked[k] then
|
||||||
|
continue;
|
||||||
|
|
||||||
|
FCurFormat := SPREAD_FORMAT[k];
|
||||||
|
|
||||||
|
StatusMsg('Writing ' + GetFileFormatName(SPREAD_FORMAT[k]));
|
||||||
|
try
|
||||||
|
Application.ProcessMessages;
|
||||||
|
Tm := GetTickCount;
|
||||||
|
MyWorkbook.WriteToFile(fname + FORMAT_EXT[k], SPREAD_FORMAT[k], true);
|
||||||
|
Log := Log + Format('%5.1f ', [(GetTickCount - Tm) / 1000]);
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
Log := Log + ' xxxx ';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
finally
|
||||||
|
MyWorkbook.Free;
|
||||||
|
Memo.Append(TrimRight(Log));
|
||||||
|
StatusMsg('');
|
||||||
|
end;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.StatusMsg(const AMsg: String);
|
||||||
|
begin
|
||||||
|
Statusbar.SimpleText := AMsg;
|
||||||
|
Statusbar.Refresh;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TForm1.GetRowCount(AIndex: Integer): Integer;
|
||||||
|
var
|
||||||
|
s: String;
|
||||||
|
begin
|
||||||
|
s := CgRowCount.Items[AIndex];
|
||||||
|
Delete(s, pos('k', s), 99);
|
||||||
|
Result := StrToInt(s) * 1000;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.BtnReadClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
i, j, k, len: Integer;
|
||||||
|
s, fname: String;
|
||||||
|
rows: Integer;
|
||||||
|
ext: String;
|
||||||
|
begin
|
||||||
|
WriteToIni;
|
||||||
|
|
||||||
|
FEscape := false;
|
||||||
|
EnableControls(false);
|
||||||
|
|
||||||
|
try
|
||||||
|
Memo.Append ('Running: Reading TsWorkbook from various file formats');
|
||||||
|
case RgContent.ItemIndex of
|
||||||
|
0: Memo.Append(' Worksheet contains strings only');
|
||||||
|
1: Memo.Append(' Worksheet contains numbers only');
|
||||||
|
2: Memo.Append(' Worksheet contains 50% strings and 50% numbers');
|
||||||
|
end;
|
||||||
|
Memo.Append (' (Times in seconds)');
|
||||||
|
//'----------- .ods .xlsx biff8 biff5 biff2');
|
||||||
|
//'Rows x Cols W.Options Build Write Write Write Write Write'
|
||||||
|
s := '-------------------------------- ';
|
||||||
|
if CgFormats.Checked[fmtODS] then s := s + ' .ods ';
|
||||||
|
if CgFormats.Checked[fmtXLSX] then s := s + '.xlsx ';
|
||||||
|
if CgFormats.Checked[fmtXLS8] then s := s + 'biff8 ';
|
||||||
|
if CgFormats.Checked[fmtXLS5] then s := s + 'biff5 ';
|
||||||
|
if CgFormats.Checked[fmtXLS2] then s := s + 'biff2';
|
||||||
|
Memo.Append(TrimRight(s));
|
||||||
|
s := 'Rows x Cols W.Options ';
|
||||||
|
if CgFormats.Checked[fmtODS] then s := s + ' Read ';
|
||||||
|
if CgFormats.Checked[fmtXLSX] then s := s + ' Read ';
|
||||||
|
if CgFormats.Checked[fmtXLS8] then s := s + ' Read ';
|
||||||
|
if CgFormats.Checked[fmtXLS5] then s := s + ' Read ';
|
||||||
|
if CgFormats.Checked[fmtXLS2] then s := s + ' Read';
|
||||||
|
s := TrimRight(s);
|
||||||
|
Memo.Append(s);
|
||||||
|
len := Length(s);
|
||||||
|
Memo.Append(DupeString('-', len));
|
||||||
|
|
||||||
|
for i:=0 to CgRowCount.Items.Count-1 do begin
|
||||||
|
if FEscape then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
if not CgRowCount.Checked[i] then
|
||||||
|
continue;
|
||||||
|
|
||||||
|
rows := GetRowCount(i);
|
||||||
|
s := Format('%7.0nx%d', [1.0*rows, COLCOUNT]);
|
||||||
|
|
||||||
|
RunReadTest(1, s + ' [ ]', []);
|
||||||
|
(*
|
||||||
|
RunReadTest(2, s + ' [woVM ]', [woVirtualMode]);
|
||||||
|
RunReadTest(3, s + ' [ woBS]', [woBufStream]);
|
||||||
|
RunReadTest(4, s + ' [woVM, woBS]', [woVirtualMode, woBufStream]);
|
||||||
|
*)
|
||||||
|
Memo.Append(DupeString('-', len));
|
||||||
|
end;
|
||||||
|
Memo.Append('Ready');
|
||||||
|
finally
|
||||||
|
Memo.Append('');
|
||||||
|
EnableControls(true);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.BtnWriteClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
Rows: integer;
|
||||||
|
s: String;
|
||||||
|
i, len: Integer;
|
||||||
|
begin
|
||||||
|
WriteToIni;
|
||||||
|
|
||||||
|
FEscape := false;
|
||||||
|
EnableControls(false);
|
||||||
|
|
||||||
|
Memo.Append ('Running: Building TsWorkbook and writing to different file formats');
|
||||||
|
case RgContent.ItemIndex of
|
||||||
|
0: Memo.Append(' Worksheet contains strings only');
|
||||||
|
1: Memo.Append(' Worksheet contains numbers only');
|
||||||
|
2: Memo.Append(' Worksheet contains 50% strings and 50% numbers');
|
||||||
|
end;
|
||||||
|
Memo.Append (' (Times in seconds)');
|
||||||
|
//'----------- .ods .xlsx biff8 biff5 biff2');
|
||||||
|
//'Rows x Cols W.Options Build Write Write Write Write Write'
|
||||||
|
s := '-------------------------------- ';
|
||||||
|
if CgFormats.Checked[fmtODS] then s := s + ' .ods ';
|
||||||
|
if CgFormats.Checked[fmtXLSX] then s := s + '.xlsx ';
|
||||||
|
if CgFormats.Checked[fmtXLS8] then s := s + 'biff8 ';
|
||||||
|
if CgFormats.Checked[fmtXLS5] then s := s + 'biff5 ';
|
||||||
|
if CgFormats.Checked[fmtXLS2] then s := s + 'biff2';
|
||||||
|
Memo.Append(TrimRight(s));
|
||||||
|
s := 'Rows x Cols W.Options Build ';
|
||||||
|
if CgFormats.Checked[fmtODS] then s := s + 'Write ';
|
||||||
|
if CgFormats.Checked[fmtXLSX] then s := s + 'Write ';
|
||||||
|
if CgFormats.Checked[fmtXLS8] then s := s + 'Write ';
|
||||||
|
if CgFormats.Checked[fmtXLS5] then s := s + 'Write ';
|
||||||
|
if CgFormats.Checked[fmtXLS2] then s := s + 'Write';
|
||||||
|
s := TrimRight(s);
|
||||||
|
len := Length(s);
|
||||||
|
Memo.Append(s);
|
||||||
|
Memo.Append(DupeString('-', len));
|
||||||
|
|
||||||
|
try
|
||||||
|
for i:=0 to CgRowCount.Items.Count-1 do begin
|
||||||
|
if FEscape then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
if not CgRowCount.Checked[i] then
|
||||||
|
continue;
|
||||||
|
Rows := GetRowCount(i);
|
||||||
|
s := Format('%7.0nx%d', [1.0*Rows, COLCOUNT]);
|
||||||
|
if CbVirtualModeOnly.Checked then begin
|
||||||
|
RunWriteTest(2, Rows, s + ' [woVM ]', [woVirtualMode]);
|
||||||
|
RunWriteTest(4, Rows, s + ' [woVM, woBS]', [woVirtualMode, woBufStream]);
|
||||||
|
end else begin
|
||||||
|
RunWriteTest(1, Rows, s + ' [ ]', []);
|
||||||
|
RunWriteTest(2, Rows, s + ' [woVM ]', [woVirtualMode]);
|
||||||
|
RunWriteTest(3, Rows, s + ' [ woBS]', [woBufStream]);
|
||||||
|
RunWriteTest(4, Rows, s + ' [woVM, woBS]', [woVirtualMode, woBufStream]);
|
||||||
|
end;
|
||||||
|
Memo.Append(DupeString('-', len));
|
||||||
|
end;
|
||||||
|
Memo.Append('Ready');
|
||||||
|
finally
|
||||||
|
Memo.Append('');
|
||||||
|
EnableControls(true);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: boolean);
|
||||||
|
begin
|
||||||
|
if CanClose then
|
||||||
|
try
|
||||||
|
WriteToIni;
|
||||||
|
except
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.EnableControls(AEnable: Boolean);
|
||||||
|
begin
|
||||||
|
BtnWrite.Enabled := AEnable;
|
||||||
|
BtnRead.Enabled := AEnable;
|
||||||
|
RgContent.Enabled := AEnable;
|
||||||
|
CgFormats.Enabled := AEnable;
|
||||||
|
CgRowCount.Enabled := AEnable;
|
||||||
|
LblCancel.Visible := not AEnable;
|
||||||
|
StatusMsg('');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
//FDir := GetTempDir;
|
||||||
|
FDir := ExtractFilePath(Application.ExeName) + 'data' + DirectorySeparator;
|
||||||
|
// better than tempdir if you want to look at the files written...
|
||||||
|
if not DirectoryExists(FDir) then CreateDir(FDir);
|
||||||
|
|
||||||
|
CgFormats.Checked[fmtODS] := true;
|
||||||
|
CgFormats.Checked[fmtXLSX] := true;
|
||||||
|
CgFormats.Checked[fmtXLS8] := true;
|
||||||
|
CgFormats.Checked[fmtXLS5] := true;
|
||||||
|
CgFormats.Checked[fmtXLS2] := true;
|
||||||
|
|
||||||
|
CgRowCount.Checked[rc10k] := true;
|
||||||
|
CgRowCount.Checked[rc20k] := true;
|
||||||
|
CgRowCount.Checked[rc30k] := true;
|
||||||
|
CgRowCount.Checked[rc40k] := true;
|
||||||
|
|
||||||
|
ReadFromIni;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.FormKeyPress(Sender: TObject; var Key: char);
|
||||||
|
begin
|
||||||
|
if Key = #27 then begin
|
||||||
|
StatusMsg('ESC pressed...');
|
||||||
|
FEscape := true;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.ReadFromIni;
|
||||||
|
var
|
||||||
|
ini: TCustomIniFile;
|
||||||
|
n: Byte;
|
||||||
|
begin
|
||||||
|
ini := TMemIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
|
||||||
|
try
|
||||||
|
CbVirtualModeOnly.Checked := ini.ReadBool('Parameters', 'VirtualModeOnly', CbVirtualModeOnly.Checked);
|
||||||
|
RgContent.ItemIndex := ini.ReadInteger('Parameters', 'Content', RgContent.ItemIndex);
|
||||||
|
|
||||||
|
n := Ini.ReadInteger('Parameters', 'Formats', $1F);
|
||||||
|
CgFormats.Checked[fmtODS] := n and $01 <> 0;
|
||||||
|
CgFormats.Checked[fmtXLSX] := n and $02 <> 0;
|
||||||
|
CgFormats.Checked[fmtXLS8] := n and $04 <> 0;
|
||||||
|
CgFormats.Checked[fmtXLS5] := n and $08 <> 0;
|
||||||
|
CgFormats.Checked[fmtXLS2] := n and $10 <> 0;
|
||||||
|
|
||||||
|
n := Ini.ReadInteger('Parameters', 'RowCount', $0F);
|
||||||
|
CgRowCount.Checked[rc10k] := n and $01 <> 0;
|
||||||
|
CgRowCount.Checked[rc20k] := n and $02 <> 0;
|
||||||
|
CgRowCount.Checked[rc30k] := n and $04 <> 0;
|
||||||
|
CgRowCount.Checked[rc40k] := n and $08 <> 0;
|
||||||
|
CgRowCount.Checked[rc50k] := n and $10 <> 0;
|
||||||
|
CgRowCount.Checked[rc60k] := n and $20 <> 0;
|
||||||
|
CgRowCount.Checked[rc100k]:= n and $40 <> 0;
|
||||||
|
|
||||||
|
finally
|
||||||
|
ini.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.WriteToIni;
|
||||||
|
var
|
||||||
|
ini: TMemIniFile;
|
||||||
|
n: Byte;
|
||||||
|
begin
|
||||||
|
ini := TMemIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
|
||||||
|
try
|
||||||
|
ini.WriteBool('Parameters', 'VirtualModeOnly', CbVirtualModeOnly.Checked);
|
||||||
|
ini.WriteInteger('Parameters', 'Content', RgContent.ItemIndex);
|
||||||
|
|
||||||
|
n := 0;
|
||||||
|
if CgFormats.Checked[fmtODS] then n := n or $1;
|
||||||
|
if CgFormats.Checked[fmtXLSX] then n := n or $2;
|
||||||
|
if CgFormats.Checked[fmtXLS8] then n := n or $4;
|
||||||
|
if CgFormats.Checked[fmtXLS5] then n := n or $8;
|
||||||
|
if CgFormats.Checked[fmtXLS2] then n := n or $10;
|
||||||
|
ini.WriteInteger('Parameters', 'Formats', n);
|
||||||
|
|
||||||
|
n := 0;
|
||||||
|
if CgRowCount.Checked[rc10k] then n := n or $01;
|
||||||
|
if CgRowCount.Checked[rc20k] then n := n or $02;
|
||||||
|
if CgRowCount.Checked[rc30k] then n := n or $04;
|
||||||
|
if CgRowCount.Checked[rc40k] then n := n or $08;
|
||||||
|
if CgRowCount.Checked[rc50k] then n := n or $10;
|
||||||
|
if CgRowCount.Checked[rc60k] then n := n or $20;
|
||||||
|
if CgRowCount.Checked[rc100k] then n := n or $40;
|
||||||
|
ini.WriteInteger('Parameters', 'RowCount', n);
|
||||||
|
|
||||||
|
finally
|
||||||
|
ini.UpdateFile;
|
||||||
|
ini.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,7 @@
|
|||||||
|
This demo represents a useful tool for measuring the speed of writing to and
|
||||||
|
reading from various spreadsheet file formats. It contains a gui to setup test
|
||||||
|
conditions and displays test results in a memo.
|
||||||
|
|
||||||
|
Please note that the reading test requires the files created during the writing
|
||||||
|
test. The test files are created in a subfolder "data" of the directory
|
||||||
|
containing the exe file.
|
||||||
Reference in New Issue
Block a user