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