Menu
▾
▴
[Instantobjects-cvscommit] Demos/PrimerCross PerformanceView.dfm,1.2,1.3 PerformanceView.pas,1.2,1.3
|
From: Carlo B. <car...@us...> - 2004-08-23 09:55:34
|
Update of /cvsroot/instantobjects/Demos/PrimerCross In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22153/Demos/PrimerCross Modified Files: PerformanceView.dfm PerformanceView.pas Log Message: InstantRTTI bug fixing, InstantADO bug-fixing, PerformanceView changed Index: PerformanceView.pas =================================================================== RCS file: /cvsroot/instantobjects/Demos/PrimerCross/PerformanceView.pas,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** PerformanceView.pas 29 Jul 2004 20:43:09 -0000 1.2 --- PerformanceView.pas 23 Aug 2004 09:55:19 -0000 1.3 *************** *** 72,81 **** procedure BeginMeasure; procedure EndMeasure(MeasureType: TMeasureType; Count: Integer); ! procedure Run(Store, Retrieve, Dispose : boolean); virtual; abstract; property Stopwatch: TStopwatch read GetStopwatch; property TestResult: TTestResult read GetTestResult; public destructor Destroy; override; ! procedure Execute(Store, Retrieve, Dispose : boolean); function ExtractResult: TTestResult; property OnShowStatus: TShowStatusEvent read FOnShowStatus write FOnShowStatus; --- 72,81 ---- procedure BeginMeasure; procedure EndMeasure(MeasureType: TMeasureType; Count: Integer); ! procedure Run(Retrieve, Dispose : boolean); virtual; abstract; property Stopwatch: TStopwatch read GetStopwatch; property TestResult: TTestResult read GetTestResult; public destructor Destroy; override; ! procedure Execute(Retrieve, Dispose : boolean); function ExtractResult: TTestResult; property OnShowStatus: TShowStatusEvent read FOnShowStatus write FOnShowStatus; *************** *** 94,98 **** procedure Operation(Method: TMethod); protected ! procedure Run(Store, Retrieve, Dispose : boolean); override; property ObjectList: TStringList read GetObjectList; public --- 94,98 ---- procedure Operation(Method: TMethod); protected ! procedure Run(Retrieve, Dispose : boolean); override; property ObjectList: TStringList read GetObjectList; public *************** *** 125,129 **** NumberLabel: TLabel; ObjectsEdit: TMaskEdit; - TestStoreCheckBox: TCheckBox; TestRetrieveCheckBox: TCheckBox; TestDisposeCheckBox: TCheckBox; --- 125,128 ---- *************** *** 143,146 **** --- 142,147 ---- procedure TransactionsCheckBoxClick(Sender: TObject); procedure PreparedQueryCheckBoxClick(Sender: TObject); + procedure TestDisposeCheckBoxClick(Sender: TObject); + procedure TestRetrieveCheckBoxClick(Sender: TObject); private FTestResults: TTestResults; *************** *** 263,269 **** end; ! procedure TTest.Execute(Store, Retrieve, Dispose : boolean); begin ! Run(Store,Retrieve,Dispose); end; --- 264,270 ---- end; ! procedure TTest.Execute(Retrieve, Dispose : boolean); begin ! Run(Retrieve,Dispose); end; *************** *** 336,345 **** end; ! procedure TPersistenceTest.Run(Store, Retrieve, Dispose : boolean); begin ! Stopwatch.Start((Ord(Store)+Ord(Retrieve)+Ord(Dispose)) * Count); try ! if Store then ! Operation(TestStore); if Retrieve then Operation(TestRetrieve); --- 337,346 ---- end; ! procedure TPersistenceTest.Run(Retrieve, Dispose : boolean); begin ! Stopwatch.Start((1+Ord(Retrieve)+Ord(Dispose)) * Count); try ! //Test always store operations (necessary to test retrieve and dispose) ! Operation(TestStore); if Retrieve then Operation(TestRetrieve); *************** *** 484,488 **** OnShowStatus := TestShowStatus; Count := StrToInt(Trim(ObjectsEdit.text)); ! Execute(TestStoreCheckBox.Checked, TestRetrieveCheckBox.Checked, TestDisposeCheckBox.Checked); AResult := ExtractResult; AResult.Name := ConnectionName; --- 485,489 ---- OnShowStatus := TestShowStatus; Count := StrToInt(Trim(ObjectsEdit.text)); ! Execute(TestRetrieveCheckBox.Checked, TestDisposeCheckBox.Checked); AResult := ExtractResult; AResult.Name := ConnectionName; *************** *** 637,641 **** TransactionsCheckBox.Checked := IsConnected and Connector.UseTransactions; ObjectsEdit.Enabled := IsConnected; - TestStoreCheckBox.Enabled := IsConnected; TestRetrieveCheckBox.Enabled := IsConnected; TestDisposeCheckBox.Enabled := IsConnected; --- 638,641 ---- *************** *** 676,679 **** --- 676,693 ---- end; + procedure TPerformanceViewForm.TestDisposeCheckBoxClick(Sender: TObject); + begin + inherited; + if TestDisposeCheckBox.Checked then + TestRetrieveCheckBox.Checked := True; + end; + + procedure TPerformanceViewForm.TestRetrieveCheckBoxClick(Sender: TObject); + begin + inherited; + if not TestRetrieveCheckBox.Checked then + TestDisposeCheckBox.Checked := False; + end; + initialization RegisterClasses([TTestResults, TTestResult]); Index: PerformanceView.dfm =================================================================== RCS file: /cvsroot/instantobjects/Demos/PrimerCross/PerformanceView.dfm,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** PerformanceView.dfm 29 Jul 2004 20:43:09 -0000 1.2 --- PerformanceView.dfm 23 Aug 2004 09:55:19 -0000 1.3 *************** *** 1,10 **** inherited PerformanceViewForm: TPerformanceViewForm ! Width = 655 ! Height = 455 object ClientPanel: TPanel Left = 0 Top = 0 ! Width = 655 ! Height = 455 Align = alClient BevelOuter = bvNone --- 1,10 ---- inherited PerformanceViewForm: TPerformanceViewForm ! Width = 749 ! Height = 564 object ClientPanel: TPanel Left = 0 Top = 0 ! Width = 749 ! Height = 564 Align = alClient BevelOuter = bvNone *************** *** 15,20 **** Left = 0 Top = 0 ! Width = 651 ! Height = 121 Align = alTop BevelOuter = bvNone --- 15,20 ---- Left = 0 Top = 0 ! Width = 745 ! Height = 113 Align = alTop BevelOuter = bvNone *************** *** 30,35 **** object InfoBevel: TBevel Left = 0 ! Top = 112 ! Width = 651 Height = 9 Align = alBottom --- 30,35 ---- object InfoBevel: TBevel Left = 0 ! Top = 104 ! Width = 745 Height = 9 Align = alBottom *************** *** 37,41 **** end object ConnectionLabel: TLabel ! Left = 292 Top = 4 Width = 132 --- 37,41 ---- end object ConnectionLabel: TLabel ! Left = 188 Top = 4 Width = 132 *************** *** 86,104 **** end object NumberLabel: TLabel ! Left = 55 ! Top = 96 ! Width = 74 Height = 13 ! Alignment = taRightJustify ! Caption = '&Objects for test:' FocusControl = ObjectsEdit end object RunButton: TButton ! Left = 192 ! Top = 92 Width = 73 Height = 25 Caption = '&Run Now' ! TabOrder = 7 OnClick = RunButtonClick end --- 86,103 ---- end object NumberLabel: TLabel ! Left = 4 ! Top = 68 ! Width = 77 Height = 13 ! Caption = '&Objects to store:' FocusControl = ObjectsEdit end object RunButton: TButton ! Left = 404 ! Top = 68 Width = 73 Height = 25 Caption = '&Run Now' ! TabOrder = 6 OnClick = RunButtonClick end *************** *** 106,111 **** Left = 40 Top = 20 ! Width = 401 ! Height = 69 TabStop = False Enabled = False --- 105,110 ---- Left = 40 Top = 20 ! Width = 697 ! Height = 45 TabStop = False Enabled = False *************** *** 113,131 **** 'This page allows you to run a performance test on the current co' + ! 'nnection.' ! ! 'The performance test will measure the speed of store, retrieve a' + ! 'nd dispose ' ! 'operations.' ! 'Test results can be compared to other connections in the chart b' + ! 'elow.') ReadOnly = True TabOrder = 0 end object TransactionsCheckBox: TCheckBox ! Left = 445 ! Top = 24 ! Width = 129 Height = 17 Caption = 'Use &Transactions' --- 112,127 ---- 'This page allows you to run a performance test on the current co' + ! 'nnection. The performance test will measure the speed of store, ' + ! 'retrieve and ' ! 'dispose operations. Test results can be compared to other connec' + ! 'tions in the chart below.') ReadOnly = True TabOrder = 0 end object TransactionsCheckBox: TCheckBox ! Left = 233 ! Top = 68 ! Width = 140 Height = 17 Caption = 'Use &Transactions' *************** *** 134,140 **** end object PreparedQueryCheckBox: TCheckBox ! Left = 445 ! Top = 40 ! Width = 152 Height = 17 Caption = 'Use &Prepared Queries' --- 130,136 ---- end object PreparedQueryCheckBox: TCheckBox ! Left = 233 ! Top = 84 ! Width = 140 Height = 17 Caption = 'Use &Prepared Queries' *************** *** 143,149 **** end object ObjectsEdit: TMaskEdit ! Left = 132 ! Top = 94 ! Width = 53 Height = 21 EditMask = '#########;1; ' --- 139,145 ---- end object ObjectsEdit: TMaskEdit ! Left = 4 ! Top = 82 ! Width = 73 Height = 21 EditMask = '#########;1; ' *************** *** 152,168 **** Text = '500 ' end - object TestStoreCheckBox: TCheckBox - Left = 445 - Top = 64 - Width = 100 - Height = 17 - Caption = 'Test Store' - Checked = True - State = cbChecked - TabOrder = 4 - end object TestRetrieveCheckBox: TCheckBox ! Left = 445 ! Top = 80 Width = 100 Height = 17 --- 148,154 ---- Text = '500 ' end object TestRetrieveCheckBox: TCheckBox ! Left = 101 ! Top = 68 Width = 100 Height = 17 *************** *** 170,178 **** Checked = True State = cbChecked ! TabOrder = 5 end object TestDisposeCheckBox: TCheckBox ! Left = 445 ! Top = 96 Width = 100 Height = 17 --- 156,165 ---- Checked = True State = cbChecked ! TabOrder = 4 ! OnClick = TestRetrieveCheckBoxClick end object TestDisposeCheckBox: TCheckBox ! Left = 101 ! Top = 84 Width = 100 Height = 17 *************** *** 180,191 **** Checked = True State = cbChecked ! TabOrder = 6 end end object ResultPanel: TPanel Left = 0 ! Top = 121 ! Width = 651 ! Height = 330 Align = alClient BevelOuter = bvNone --- 167,179 ---- Checked = True State = cbChecked ! TabOrder = 5 ! OnClick = TestDisposeCheckBoxClick end end object ResultPanel: TPanel Left = 0 ! Top = 113 ! Width = 745 ! Height = 447 Align = alClient BevelOuter = bvNone *************** *** 195,199 **** Top = 0 Width = 209 ! Height = 330 Align = alLeft BevelOuter = bvNone --- 183,187 ---- Top = 0 Width = 209 ! Height = 447 Align = alLeft BevelOuter = bvNone *************** *** 204,208 **** Top = 4 Width = 201 ! Height = 322 Align = alClient Checkboxes = True --- 192,196 ---- Top = 4 Width = 201 ! Height = 439 Align = alClient Checkboxes = True *************** *** 222,227 **** Left = 209 Top = 0 ! Width = 442 ! Height = 330 Align = alClient BevelOuter = bvNone --- 210,215 ---- Left = 209 Top = 0 ! Width = 536 ! Height = 447 Align = alClient BevelOuter = bvNone *************** *** 230,235 **** Left = 0 Top = 0 ! Width = 442 ! Height = 330 BackWall.Brush.Color = clWhite LeftWall.Color = clWhite --- 218,223 ---- Left = 0 Top = 0 ! Width = 536 ! Height = 447 BackWall.Brush.Color = clWhite LeftWall.Color = clWhite |
