paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
9de53b2440
lazarus-ccr/components/fpspreadsheet/examples/fpsspeedtest/mainform.pas

572 lines
16 KiB
ObjectPascal
Raw Blame History

unit mainform;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics,
Dialogs, StdCtrls, ComCtrls, ExtCtrls, iniFiles,
fpstypes, 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 ReadCellDataHandler(Sender: TObject; ARow, ACol: Cardinal;
const ADataCell: PCell);
procedure WriteCellStringHandler(Sender: TObject; ARow, ACol: Cardinal;
var AValue: Variant; var AStyleCell: PCell);
procedure WriteCellNumberHandler(Sender: TObject; ARow, ACol: Cardinal;
var AValue: Variant; var AStyleCell: PCell);
procedure WriteCellStringAndNumberHandler(Sender: TObject; ARow, ACol: Cardinal;
var AValue: Variant; var AStyleCell: PCell);
procedure ReadFromIni;
procedure WriteToIni;
procedure RunReadTest(Idx: Integer; Log: String; Options: TsWorkbookOptions);
procedure RunWriteTest(Idx: integer; Rows: integer; Log: string; Options: TsWorkbookOptions);
procedure StatusMsg(const AMsg: String);
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
uses
LclIntf, StrUtils, fpsUtils;
{$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');
CONTENT_TEXT: array[0..2] of string = ('strings only', 'numbers only', '50% strings and 50% numbers');
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.ReadCellDataHandler(Sender: TObject; ARow, ACol: Cardinal;
const ADataCell: PCell);
begin
Unused(ACol, ADataCell);
// nothing to do here. Just do a progress display
if ARow mod 1000 = 0 then
StatusMsg(Format('Virtual mode reading %s: Row %d...', [GetFileFormatName(FCurFormat), ARow]));
end;
procedure TForm1.WriteCellStringHandler(Sender: TObject; ARow, ACol: cardinal;
var AValue: variant; var AStyleCell: PCell);
var
S: string;
begin
Unused(AStyleCell);
S := 'Xy' + IntToStr(ARow) + 'x' + IntToStr(ACol);
AValue := S;
if ARow mod 1000 = 0 then
StatusMsg(Format('Virtual mode writing %s: Row %d...', [GetFileFormatName(FCurFormat), ARow]));
end;
procedure TForm1.WriteCellNumberHandler(Sender: TObject; ARow, ACol: cardinal;
var AValue: variant; var AStyleCell: PCell);
begin
UnUsed(AStyleCell);
AValue := ARow * 1E5 + ACol;
if ARow mod 1000 = 0 then
StatusMsg(Format('Virtual mode writing %s: Row %d...', [GetFileFormatName(FCurFormat), ARow]));
end;
procedure TForm1.WriteCellStringAndNumberHandler(Sender: TObject; ARow, ACol: cardinal;
var AValue: variant; var AStyleCell: PCell);
begin
if odd(ARow + ACol) then
WriteCellStringHandler(Sender, ARow, ACol, AValue, AStyleCell)
else
WriteCellNumberHandler(Sender, ARow, ACol, AValue, AStyleCell);
end;
procedure TForm1.RunReadTest(Idx: Integer; Log: String;
Options: TsWorkbookOptions);
var
MyWorkbook: TsWorkbook;
Tm: DWord;
fName, s: String;
i, j: Integer;
F: File;
ok: Boolean;
begin
Unused(idx);
s := Trim(Log);
Log := Log + ' ';
try
if FEscape then begin
Log := 'Test aborted';
exit;
end;
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;
FCurFormat := SPREAD_FORMAT[i];
StatusMsg('Reading ' + GetFileFormatName(FCurFormat));
ok := false;
for j:=1 to 4 do begin
if FEscape then begin
Log := 'Test aborted';
exit;
end;
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;
MyWorkbook.Options := Options;
if boVirtualMode in Options then
MyWorkbook.OnReadCellData := @ReadCellDataHandler;
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: TsWorkbookOptions);
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.Options := Options;
Application.ProcessMessages;
Tm := GetTickCount;
try
if boVirtualMode in Options then
begin
MyWorkbook.VirtualRowCount := Rows;
MyWorkbook.VirtualColCount := COLCOUNT;
case RgContent.ItemIndex of
0: MyWorkbook.OnWriteCellData := @WriteCellStringHandler;
1: MyWorkbook.OnWriteCellData := @WriteCellNumberHandler;
2: MyWorkbook.OnWriteCellData := @WriteCellStringAndNumberHandler;
end;
end
else
begin
for ARow := 0 to Rows - 1 do
begin
if ARow mod 1000 = 0 then begin
StatusMsg(Format('Building 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);
if Idx in [2, 4] then
Log := Log + ' - ' // No build time in virtual mode
else
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, len: Integer;
s: String;
rows: Integer;
begin
WriteToIni;
FEscape := false;
EnableControls(false);
Memo.Append ('Running: Reading TsWorkbook from various file formats');
Memo.Append (' Worksheet contains ' + CONTENT_TEXT[RgContent.ItemIndex]);
Memo.Append (' (Times in seconds)');
//'----------- .ods .xlsx biff8 biff5 biff2');
//'Rows x Cols 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 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));
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
RunReadTest(2, s + ' [boVM ]', [boVirtualMode]);
RunReadTest(4, s + ' [boVM, boBS]', [boVirtualMode, boBufStream]);
end else begin
RunReadTest(1, s + ' [ ]', []);
RunReadTest(2, s + ' [boVM ]', [boVirtualMode]);
RunReadTest(3, s + ' [ boBS]', [boBufStream]);
RunReadTest(4, s + ' [boVM, boBS]', [boVirtualMode, boBufStream]);
end;
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');
Memo.Append (' Worksheet contains ' + CONTENT_TEXT[RgContent.ItemIndex]);
Memo.Append (' (Times in seconds)');
//'----------- .ods .xlsx biff8 biff5 biff2');
//'Rows x Cols 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 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 + ' [boVM ]', [boVirtualMode]);
RunWriteTest(4, Rows, s + ' [boVM, boBS]', [boVirtualMode, boBufStream]);
end else begin
RunWriteTest(1, Rows, s + ' [ ]', []);
RunWriteTest(2, Rows, s + ' [boVM ]', [boVirtualMode]);
RunWriteTest(3, Rows, s + ' [ boBS]', [boBufStream]);
RunWriteTest(4, Rows, s + ' [boVM, boBS]', [boVirtualMode, boBufStream]);
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('');
Application.ProcessMessages;
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.
Reference in New Issue View Git Blame Copy Permalink