fpspreadsheet: Final changes before release 1.6

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4196 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-06-28 12:09:12 +00:00
parent daeb6ebf88
commit 539da5c2db
6 changed files with 73 additions and 17 deletions

View File

@ -450,12 +450,13 @@ procedure TForm1.ExportUsingVirtualMode(var DataFileName: string);
var
worksheet: TsWorksheet;
begin
{
if FILE_FORMATS[RgFileFormat.ItemIndex] = sfOpenDocument then
begin
MessageDlg('Virtual mode is not yet implemented for .ods files.', mtError, [mbOK], 0);
exit;
end;
}
FExportDataset.Open;
FWorkbook := TsWorkbook.Create;

View File

@ -40,7 +40,6 @@
<Unit0>
<Filename Value="fpsspeedtest.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpsspeedtest"/>
</Unit0>
<Unit1>
<Filename Value="mainform.pas"/>
@ -48,7 +47,6 @@
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="mainform"/>
</Unit1>
</Units>
</ProjectOptions>

View File

@ -2,31 +2,32 @@ object Form1: TForm1
Left = 445
Height = 593
Top = 178
Width = 764
Width = 780
Caption = 'fpsSpeedTest'
ClientHeight = 593
ClientWidth = 764
ClientWidth = 780
KeyPreview = True
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnDestroy = FormDestroy
OnKeyPress = FormKeyPress
LCLVersion = '1.5'
object StatusBar: TStatusBar
Left = 0
Height = 23
Top = 570
Width = 764
Width = 780
Panels = <>
end
object Panel1: TPanel
Left = 0
Height = 52
Top = 0
Width = 764
Width = 780
Align = alTop
BevelOuter = bvNone
ClientHeight = 52
ClientWidth = 764
ClientWidth = 780
TabOrder = 1
object BtnWrite: TButton
Left = 8
@ -41,7 +42,7 @@ object Form1: TForm1
Left = 184
Height = 39
Top = 6
Width = 576
Width = 488
Anchors = [akTop, akLeft, akRight]
AutoSize = False
Caption = 'Press ESC to cancel when current file is completely written.'#13#10'This may take some time...'
@ -58,6 +59,16 @@ object Form1: TForm1
OnClick = BtnReadClick
TabOrder = 1
end
object BtnSaveResults: TButton
Left = 680
Height = 29
Top = 12
Width = 91
Anchors = [akTop, akRight]
Caption = 'Save results'
OnClick = BtnSaveResultsClick
TabOrder = 2
end
end
object ParameterPanel: TPanel
Left = 0
@ -174,7 +185,7 @@ object Form1: TForm1
Left = 0
Height = 4
Top = 52
Width = 764
Width = 780
Align = alTop
Shape = bsTopLine
end
@ -182,7 +193,7 @@ object Form1: TForm1
Left = 182
Height = 514
Top = 56
Width = 582
Width = 598
Align = alClient
Font.Height = -12
Font.Name = 'Courier New'
@ -191,4 +202,11 @@ object Form1: TForm1
ScrollBars = ssAutoVertical
TabOrder = 3
end
object SaveDialog: TSaveDialog
DefaultExt = '.txt'
Filter = 'Text files (*.txt)|*.txt|All files (*.*)|*.*'
Options = [ofOverwritePrompt, ofPathMustExist, ofEnableSizing, ofViewDetail]
left = 708
top = 65
end
end

View File

@ -15,6 +15,7 @@ type
TForm1 = class(TForm)
Bevel1: TBevel;
BtnSaveResults: TButton;
BtnWrite: TButton;
BtnRead: TButton;
CgFormats: TCheckGroup;
@ -26,17 +27,22 @@ type
Memo: TMemo;
ParameterPanel: TPanel;
RgContent: TRadioGroup;
SaveDialog: TSaveDialog;
StatusBar: TStatusBar;
procedure BtnReadClick(Sender: TObject);
procedure BtnSaveResultsClick(Sender: TObject);
procedure BtnWriteClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: char);
private
{ private declarations }
FDir: String;
FEscape: Boolean;
FCurFormat: TsSpreadsheetFormat;
FErrCounter: Integer;
FErrLog: TStringList;
procedure EnableControls(AEnable: Boolean);
function GetRowCount(AIndex: Integer): Integer;
procedure ReadCellDataHandler(Sender: TObject; ARow, ACol: Cardinal;
@ -89,6 +95,13 @@ const
COLCOUNT = 100;
function LeftPad(AText: String; ALength: Integer): String;
begin
Result := AText;
while Length(Result) < ALength do Result := ' ' + Result;
end;
{ TForm1 }
procedure TForm1.ReadCellDataHandler(Sender: TObject; ARow, ACol: Cardinal;
@ -191,12 +204,16 @@ begin
ok := true;
break;
except
on E:Exception do begin
inc(FErrCounter);
FErrLog.Add(Format('[%d] = %s', [FErrCounter, E.Message]));
end;
end;
finally
MyWorkbook.Free;
end;
end;
if not ok then Log := Log + ' xxxx ';
if not ok then Log := Log + LeftPad(Format('[%d]',[FErrCounter]),5) + ' ';
end;
finally
@ -274,8 +291,11 @@ begin
end;
end;
except
on E: Exception do
Log := Log + format('xxxx ', [(GetTickCount - Tm) / 1000]);
on E: Exception do begin
inc(FErrCounter);
FErrLog.Add(Format('[%d] = %s', [FErrCounter, E.Message]));
Log := Log + LeftPad(Format('[%d]',[FErrCounter]),5) + ' ';
end;
end;
fname := Trim(Log);
@ -345,6 +365,7 @@ begin
FEscape := false;
EnableControls(false);
FErrLog.Clear;
if CbSingleCol.Checked then numCols := 1 else numCols := COLCOUNT;
@ -394,6 +415,8 @@ begin
Memo.Append(DupeString('-', len));
end;
if FErrLog.Text <> '' then
Memo.Append(FErrLog.Text);
Memo.Append('Ready');
finally
Memo.Append('');
@ -401,6 +424,14 @@ begin
end;
end;
procedure TForm1.BtnSaveResultsClick(Sender: TObject);
begin
if SaveDialog.Filename <> '' then
SaveDialog.InitialDir := ExtractFileDir(SaveDialog.Filename);
if SaveDialog.Execute then
Memo.Lines.SaveToFile(SaveDialog.Filename);
end;
procedure TForm1.BtnWriteClick(Sender: TObject);
var
Rows: integer;
@ -412,6 +443,7 @@ begin
FEscape := false;
EnableControls(false);
FErrLog.Clear;
if CbSingleCol.Checked then numCols := 1 else numCols := COLCOUNT;
Memo.Append ('Running: Building TsWorkbook and writing to different file formats');
@ -478,6 +510,7 @@ procedure TForm1.EnableControls(AEnable: Boolean);
begin
BtnWrite.Enabled := AEnable;
BtnRead.Enabled := AEnable;
BtnSaveResults.Enabled := AEnable;
RgContent.Enabled := AEnable;
CgFormats.Enabled := AEnable;
CgRowCount.Enabled := AEnable;
@ -504,9 +537,16 @@ begin
CgRowCount.Checked[rc30k] := true;
CgRowCount.Checked[rc40k] := true;
FErrLog := TStringList.Create;
ReadFromIni;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FErrLog.Free;
end;
procedure TForm1.FormKeyPress(Sender: TObject; var Key: char);
begin
if Key = #27 then begin

View File

@ -83,9 +83,9 @@ object MainForm: TMainForm
'FileFormat=sfExcel8'
'ActiveWorksheet=Sheet1'
'Options=boAutoCalc, boCalcBeforeSaving, boReadFormulas'
'FormatSettings='
'(-) FormatSettings='
' ThousandSeparator=.'
' DecimalSeparator=.'
' DecimalSeparator=,'
' ListSeparator=;'
' DateSeparator=.'
' TimeSeparator=:'
@ -3796,7 +3796,6 @@ object MainForm: TMainForm
Caption = 'File'
object MenuItem50: TMenuItem
Action = AcFileOpen
Caption = '&Open ...x'
Bitmap.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF