Changeset 446 for GraphicTest/UMainForm.pas
- Timestamp:
- Nov 22, 2012, 1:48:16 PM (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
GraphicTest/UMainForm.pas
r445 r446 32 32 SpinEditWidth: TSpinEdit; 33 33 SpinEditHeight: TSpinEdit; 34 Timer 1: TTimer;34 TimerUpdateList: TTimer; 35 35 procedure ButtonBenchmarkClick(Sender: TObject); 36 36 procedure ButtonSingleTestClick(Sender: TObject); … … 47 47 procedure SpinEditHeightChange(Sender: TObject); 48 48 procedure SpinEditWidthChange(Sender: TObject); 49 procedure Timer 1Timer(Sender: TObject);49 procedure TimerUpdateListTimer(Sender: TObject); 50 50 private 51 51 MethodIndex: Integer; 52 52 SingleTestActive: Boolean; 53 53 AllTestActive: Boolean; 54 TestTerminated: Boolean; 55 TestTimeout: Real; 54 56 procedure GenerateSceneFrames; 57 procedure TestMethod(Method: TDrawMethod); 55 58 procedure UpdateMethodList; 56 59 procedure UpdateInterface; … … 93 96 end; 94 97 98 procedure TMainForm.TestMethod(Method: TDrawMethod); 99 var 100 StepStartTime: TDateTime; 101 StartTime: TDateTime; 102 begin 103 with Method do begin 104 Init(DrawForm, FrameSize); 105 TestTerminated := False; 106 //Application.ProcessMessages; 107 StartTime := NowPrecise; 108 repeat 109 StepStartTime := NowPrecise; 110 DrawFrameTiming(TFastBitmap(Scenes[SceneIndex])); 111 SceneIndex := (SceneIndex + 1) mod Scenes.Count; 112 Application.ProcessMessages; 113 StepDuration := NowPrecise - StepStartTime; 114 until TestTerminated or 115 ((TestTimeout > 0) and ((NowPrecise - StartTime) > OneSecond * TestTimeout)); 116 Done; 117 end; 118 end; 119 95 120 procedure TMainForm.ButtonSingleTestClick(Sender: TObject); 96 var 97 StepStartTime: TDateTime; 98 begin 121 begin 122 if Assigned(ListViewMethods.Selected) then 99 123 try 100 124 SingleTestActive := True; 101 125 UpdateInterface; 102 Timer 1.Enabled := True;126 TimerUpdateList.Enabled := True; 103 127 MethodIndex := ListViewMethods.Selected.Index; 104 T imer1.Enabled := True;128 TestTimeout := -1; 105 129 if MethodIndex >= 0 then 106 with TDrawMethod(DrawMethods[MethodIndex]) do begin 107 Init(DrawForm, FrameSize); 108 Application.ProcessMessages; 109 repeat 110 StepStartTime := NowPrecise; 111 DrawFrameTiming(TFastBitmap(Scenes[SceneIndex])); 112 SceneIndex := (SceneIndex + 1) mod Scenes.Count; 113 Application.ProcessMessages; 114 StepDuration := NowPrecise - StepStartTime; 115 until not SingleTestActive; 116 Done; 117 end; 130 TestMethod(TDrawMethod(DrawMethods[MethodIndex])); 118 131 finally 119 Timer 1.Enabled := False;132 TimerUpdateList.Enabled := False; 120 133 SingleTestActive := False; 121 134 UpdateInterface; … … 126 139 var 127 140 I: Integer; 128 StartTime: TDateTime;129 StepStartTime: TDateTime;130 141 begin 131 142 try 132 143 AllTestActive := True; 133 144 UpdateInterface; 134 Timer1.Enabled := True; 145 TimerUpdateList.Enabled := True; 146 TestTerminated := False; 147 TestTimeout := FloatSpinEdit1.Value; 135 148 with ListViewMethods, Items do 136 149 for I := 0 to DrawMethods.Count - 1 do 137 150 with TDrawMethod(DrawMethods[I]) do begin 138 Init(DrawForm, FrameSize); 139 MethodIndex := I; 140 StartTime := NowPrecise; 141 repeat 142 StepStartTime := NowPrecise; 143 DrawFrameTiming(TFastBitmap(Scenes[SceneIndex])); 144 SceneIndex := (SceneIndex + 1) mod Scenes.Count; 145 Application.ProcessMessages; 146 StepDuration := NowPrecise - StepStartTime; 147 until ((NowPrecise - StartTime) > OneSecond * FloatSpinEdit1.Value) or not AllTestActive; 148 Done; 151 TestMethod(TDrawMethod(DrawMethods[I])); 149 152 end; 150 153 finally 151 Timer 1.Enabled := False;154 TimerUpdateList.Enabled := False; 152 155 AllTestActive := False; 153 156 UpdateInterface; … … 157 160 procedure TMainForm.ButtonStopClick(Sender: TObject); 158 161 begin 162 TestTerminated := True; 159 163 SingleTestActive := False; 160 164 AllTestActive := False; … … 225 229 end; 226 230 227 procedure TMainForm.Timer 1Timer(Sender: TObject);231 procedure TMainForm.TimerUpdateListTimer(Sender: TObject); 228 232 begin 229 233 UpdateMethodList;
Note:
See TracChangeset
for help on using the changeset viewer.