You've already forked lazarus-ccr
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:
Binary file not shown.
@ -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;
|
||||
|
@ -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>
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Reference in New Issue
Block a user