source: GraphicTest/Forms/FormMain.pas

Last change on this file was 573, checked in by chronos, 16 months ago
  • Modified: Build with Lazarus 3.4.
  • Modified: Removed U prefix from unit names.
File size: 13.1 KB
Line 
1unit FormMain;
2
3interface
4
5uses
6 Classes, SysUtils, LazFileUtils, SynHighlighterPas, SynMemo, Forms, Controls,
7 Graphics, Dialogs, ComCtrls, ExtCtrls, StdCtrls, DateUtils, Platform,
8 LCLType, IntfGraphics, fpImage, Math, GraphType, Contnrs, LclIntf, Spin,
9 ActnList, Menus, StdActns, FastBitmap, DrawMethod, TypInfo, FormDraw;
10
11const
12 SceneFrameCount = 100;
13
14type
15
16 { TFormMain }
17
18 TFormMain = class(TForm)
19 AFormDrawShow: TAction;
20 AShowFormDraw: TAction;
21 ATestAllMethods: TAction;
22 ATestOneMethod: TAction;
23 ATestStop: TAction;
24 AExportAsWikiText: TAction;
25 ActionList1: TActionList;
26 ButtonBenchmark: TButton;
27 ButtonSingleTest: TButton;
28 ButtonStop: TButton;
29 CheckBoxOpaque: TCheckBox;
30 CheckBoxDoubleBuffered: TCheckBox;
31 CheckBoxEraseBackground: TCheckBox;
32 ComboBoxPixelFormat: TComboBox;
33 FileExit1: TFileExit;
34 FloatSpinEdit1: TFloatSpinEdit;
35 Label1: TLabel;
36 Label2: TLabel;
37 Label3: TLabel;
38 Label4: TLabel;
39 Label5: TLabel;
40 ListViewMethods: TListView;
41 MainMenu1: TMainMenu;
42 Memo1: TMemo;
43 MenuItem1: TMenuItem;
44 MenuItem10: TMenuItem;
45 MenuItem11: TMenuItem;
46 MenuItem2: TMenuItem;
47 MenuItem3: TMenuItem;
48 MenuItem4: TMenuItem;
49 MenuItem8: TMenuItem;
50 MenuItem9: TMenuItem;
51 MenuItemTest: TMenuItem;
52 MenuItem5: TMenuItem;
53 MenuItem6: TMenuItem;
54 MenuItem7: TMenuItem;
55 PageControl1: TPageControl;
56 Panel1: TPanel;
57 PopupMenuMethod: TPopupMenu;
58 SaveDialog1: TSaveDialog;
59 SpinEditHeight: TSpinEdit;
60 SpinEditWidth: TSpinEdit;
61 Splitter1: TSplitter;
62 SynMemo1: TSynMemo;
63 SynPasSyn1: TSynPasSyn;
64 TabSheet1: TTabSheet;
65 TabSheet2: TTabSheet;
66 TimerUpdateSettings: TTimer;
67 TimerUpdateList: TTimer;
68 procedure AExportAsWikiTextExecute(Sender: TObject);
69 procedure AFormDrawShowExecute(Sender: TObject);
70 procedure ATestAllMethodsExecute(Sender: TObject);
71 procedure ATestOneMethodExecute(Sender: TObject);
72 procedure ATestStopExecute(Sender: TObject);
73 procedure CheckBoxOpaqueChange(Sender: TObject);
74 procedure CheckBoxDoubleBufferedChange(Sender: TObject);
75 procedure CheckBoxEraseBackgroundChange(Sender: TObject);
76 procedure ComboBoxPixelFormatChange(Sender: TObject);
77 procedure FormCreate(Sender: TObject);
78 procedure FormDestroy(Sender: TObject);
79 procedure FormShow(Sender: TObject);
80 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
81 procedure ListViewMethodsData(Sender: TObject; Item: TListItem);
82 procedure ListViewMethodsSelectItem(Sender: TObject; Item: TListItem;
83 Selected: Boolean);
84 procedure SpinEditHeightChange(Sender: TObject);
85 procedure SpinEditWidthChange(Sender: TObject);
86 procedure TimerUpdateListTimer(Sender: TObject);
87 procedure TimerUpdateSettingsTimer(Sender: TObject);
88 private
89 FCurrentMethod: TDrawMethod;
90 SingleTestActive: Boolean;
91 AllTestActive: Boolean;
92 TestTerminated: Boolean;
93 TestTimeout: Real;
94 DrawMethodClasses: array of TDrawMethodClass;
95 procedure GenerateSceneFrames;
96 procedure TestMethod(Method: TDrawMethod);
97 procedure UpdateMethodList;
98 procedure UpdateInterface;
99 procedure RegisterDrawMethods;
100 procedure RegisterDrawMethod(MethodClass: TDrawMethodClass);
101 public
102 FrameSize: TPoint;
103 PixelFormat: TPixelFormat;
104 DrawMethods: TObjectList; // TObjectList<TDrawMethod>
105 Scenes: TObjectList; // TObjectList<TFastBitmap>
106 SceneIndex: Integer;
107 FormDraw: TFormDraw;
108 property CurrentMethod: TDrawMethod read FCurrentMethod;
109 end;
110
111var
112 FormMain: TFormMain;
113
114
115implementation
116
117{$R *.lfm}
118
119uses
120 MethodLazIntfImageColorsCopy, MethodLazIntfImageColorsNoCopy,
121 MethodCanvasPixels, MethodCanvasPixelsUpdateLock, MethodBGRABitmap,
122 MethodBitmapRawImageDataPaintBox, MethodBitmapRawImageData,
123 MethodBitmapRawImageDataMove, MethodDummy, MethodOpenGL,
124 MethodOpenGLPBO{$IFDEF GRAPHICS32}, UGraphics32Method{$ENDIF},
125 MethodBitmapScanline, MethodMove;
126
127{ TFormMain }
128
129procedure TFormMain.FormCreate(Sender: TObject);
130var
131 NewDrawMethod: TDrawMethod;
132 I: Integer;
133 PF: TPixelFormat;
134begin
135 FormDraw := TFormDraw.Create(nil);
136
137 Scenes := TObjectList.Create;
138
139 FrameSize := Point(320, 240);
140 Randomize;
141
142 RegisterDrawMethods;
143 DrawMethods := TObjectList.Create;
144 for I := 0 to High(DrawMethodClasses) do begin
145 NewDrawMethod := DrawMethodClasses[I].Create;
146 DrawMethods.Add(NewDrawMethod);
147 end;
148
149 for PF := Low(TPixelFormat) to High(TPixelFormat) do
150 ComboBoxPixelFormat.Items.Add(GetEnumName(TypeInfo(TPixelFormat), Integer(PF)));
151
152 PageControl1.TabIndex := 0;
153end;
154
155procedure TFormMain.TestMethod(Method: TDrawMethod);
156var
157 StepStartTime: TDateTime;
158 StartTime: TDateTime;
159begin
160 FCurrentMethod := Method;
161 with Method do begin
162 Init(FormDraw, FrameSize, PixelFormat);
163 //Application.ProcessMessages;
164 StartTime := NowPrecise;
165 FrameCounterStart := NowPrecise;
166 FrameCounterStop := 0;
167 FrameCounter := 0;
168 repeat
169 StepStartTime := NowPrecise;
170 DrawFrameTiming(TFastBitmap(Scenes[SceneIndex]));
171 Application.ProcessMessages;
172 StepDuration := NowPrecise - StepStartTime;
173 SceneIndex := (SceneIndex + 1) mod Scenes.Count;
174 Inc(FrameCounter);
175 until TestTerminated or
176 ((TestTimeout > 0) and ((NowPrecise - StartTime) > OneSecond * TestTimeout));
177 FrameCounterStop := NowPrecise;
178 //FPS := GetFPS;
179 Done;
180 end;
181 FCurrentMethod := nil;
182end;
183
184procedure TFormMain.AExportAsWikiTextExecute(Sender: TObject);
185var
186 Output: TStringList;
187 I: Integer;
188 Duration: Real;
189begin
190 SaveDialog1.FileName := 'GraphicsTest results.txt';
191 if SaveDialog1.Execute then
192 try
193 Output := TStringList.Create;
194 Output.Add('{| class="wikitable sortable"');
195 Output.Add('|-');
196 Output.Add('! Method !! FPS !! Frame duration [ms]');
197 for I := 0 to DrawMethods.Count - 1 do
198 with TDrawMethod(DrawMethods[I]) do begin
199 Output.Add('|-');
200 if FPS <> 0 then Duration := 1 / FPS * 1000
201 else Duration := 0;
202 Output.Add('|' + Caption + ' || ' + FloatToStr(RoundTo(FPS, -1)) +
203 ' || ' + FloatToStr(RoundTo(Duration, -1)));
204 end;
205 Output.Add('|}');
206 Output.SaveToFile(SaveDialog1.FileName);
207 finally
208 Output.Free;
209 end;
210end;
211
212procedure TFormMain.AFormDrawShowExecute(Sender: TObject);
213begin
214 FormDraw.Show;
215end;
216
217procedure TFormMain.ATestAllMethodsExecute(Sender: TObject);
218var
219 I: Integer;
220begin
221 try
222 AllTestActive := True;
223 UpdateInterface;
224 TimerUpdateList.Enabled := True;
225 TestTerminated := False;
226 TestTimeout := FloatSpinEdit1.Value;
227 with ListViewMethods, Items do
228 for I := 0 to DrawMethods.Count - 1 do
229 with TDrawMethod(DrawMethods[I]) do begin
230 TestMethod(TDrawMethod(DrawMethods[I]));
231 if TestTerminated then Break;
232 end;
233 finally
234 TimerUpdateList.Enabled := False;
235 AllTestActive := False;
236 UpdateInterface;
237 end;
238end;
239
240procedure TFormMain.ATestOneMethodExecute(Sender: TObject);
241begin
242 if Assigned(ListViewMethods.Selected) then
243 try
244 SingleTestActive := True;
245 UpdateInterface;
246 TimerUpdateList.Enabled := True;
247 TestTerminated := False;
248 TestTimeout := -1;
249 TestMethod(TDrawMethod(ListViewMethods.Selected.Data));
250 finally
251 //TimerUpdateList.Enabled := False;
252 SingleTestActive := False;
253 UpdateInterface;
254 end;
255end;
256
257procedure TFormMain.ATestStopExecute(Sender: TObject);
258begin
259 TestTerminated := True;
260 SingleTestActive := False;
261 AllTestActive := False;
262end;
263
264procedure TFormMain.CheckBoxOpaqueChange(Sender: TObject);
265begin
266 if CheckBoxOpaque.Checked then
267 FormDraw.ControlStyle := FormDraw.ControlStyle + [csOpaque]
268 else FormDraw.ControlStyle := FormDraw.ControlStyle - [csOpaque];
269 if Assigned(FCurrentMethod) then
270 FCurrentMethod.UpdateSettings;
271end;
272
273procedure TFormMain.CheckBoxDoubleBufferedChange(Sender: TObject);
274begin
275 FormDraw.DoubleBuffered := CheckBoxDoubleBuffered.Checked;
276end;
277
278procedure TFormMain.CheckBoxEraseBackgroundChange(Sender: TObject);
279begin
280 FormDraw.EraseBackgroundEnabled := CheckBoxEraseBackground.Checked;
281end;
282
283procedure TFormMain.ComboBoxPixelFormatChange(Sender: TObject);
284begin
285 PixelFormat := TPixelFormat(ComboBoxPixelFormat.ItemIndex);
286 UpdateInterface;
287end;
288
289procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
290begin
291 ATestStop.Execute;
292end;
293
294procedure TFormMain.FormDestroy(Sender: TObject);
295begin
296 ListViewMethods.Clear;
297 FreeAndNil(DrawMethods);
298 FreeAndNil(Scenes);
299 FreeAndNil(FormDraw);
300end;
301
302procedure TFormMain.FormShow(Sender: TObject);
303begin
304 UpdateMethodList;
305 UpdateInterface;
306 FormDraw.Show;
307 FormDraw.Left := Left + Width;
308 FormDraw.Top := Top;
309end;
310
311procedure TFormMain.ListViewMethodsData(Sender: TObject; Item: TListItem);
312begin
313 if (Item.Index >= 0) and (Item.Index < DrawMethods.Count) then
314 with TDrawMethod(DrawMethods[Item.Index]) do begin
315 Item.Caption := Caption;
316 Item.Data := TDrawMethod(DrawMethods[Item.Index]);
317 FPS := GetFPS;
318 Item.SubItems.Add(FloatToStr(RoundTo(FPS, -3)));
319 if FPS > 0 then
320 Item.SubItems.Add(FloatToStr(RoundTo(1 / FPS * 1000, -3)))
321 else Item.SubItems.Add('0');
322 if FrameDuration > 0 then
323 Item.SubItems.Add(FloatToStr(RoundTo(1 / (FrameDuration / OneSecond), -3)))
324 else Item.SubItems.Add('0');
325 Item.SubItems.Add(FloatToStr(RoundTo(FrameDuration / OneMillisecond, -3)));
326 if FrameDuration > 0 then
327 Item.SubItems.Add(FloatToStr(RoundTo(1 / (StepDuration / OneSecond), -3)))
328 else Item.SubItems.Add('0');
329 Item.SubItems.Add(FloatToStr(RoundTo(StepDuration / OneMillisecond, -3)));
330 end;
331end;
332
333procedure TFormMain.ListViewMethodsSelectItem(Sender: TObject; Item: TListItem;
334 Selected: Boolean);
335var
336 FileName: string;
337begin
338 UpdateInterface;
339 if Assigned(ListViewMethods.Selected) then begin
340 FileName := 'Methods' + DirectorySeparator + 'U' +
341 Copy(TDrawMethod(DrawMethods[ListViewMethods.Selected.Index]).ClassName, 2, High(Integer)) + '.pas';
342
343 if FileExists(FileName) then
344 SynMemo1.Lines.LoadFromFile(FileName)
345 else SynMemo1.Lines.Clear;
346 Memo1.Lines.Assign(TDrawMethod(DrawMethods[ListViewMethods.Selected.Index]).Description);
347 end;
348end;
349
350procedure TFormMain.SpinEditHeightChange(Sender: TObject);
351begin
352 FrameSize.Y := SpinEditHeight.Value;
353end;
354
355procedure TFormMain.SpinEditWidthChange(Sender: TObject);
356begin
357 FrameSize.X := SpinEditWidth.Value;
358end;
359
360procedure TFormMain.TimerUpdateListTimer(Sender: TObject);
361begin
362 UpdateMethodList;
363end;
364
365procedure TFormMain.TimerUpdateSettingsTimer(Sender: TObject);
366begin
367 if (FrameSize.X <> FormDraw.FrameSize.X) or
368 (FrameSize.Y <> FormDraw.FrameSize.Y) then begin
369 FormDraw.FrameSize := FrameSize;
370 FormDraw.ClientWidth := FrameSize.X;
371 FormDraw.ClientHeight := FrameSize.Y;
372 GenerateSceneFrames;
373 end;
374end;
375
376procedure TFormMain.GenerateSceneFrames;
377var
378 I: Integer;
379 NewScene: TFastBitmap;
380begin
381 Scenes.Clear;
382 for I := 0 to SceneFrameCount - 1 do begin
383 NewScene := TFastBitmap.Create;
384 NewScene.Size := FrameSize;
385 NewScene.RandomImage(I, SceneFrameCount);
386 Scenes.Add(NewScene);
387 end;
388end;
389
390procedure TFormMain.UpdateMethodList;
391begin
392 ListViewMethods.Items.Count := DrawMethods.Count;
393 ListViewMethods.Refresh;
394end;
395
396procedure TFormMain.UpdateInterface;
397begin
398 ATestOneMethod.Enabled := not SingleTestActive and not AllTestActive and Assigned(ListViewMethods.Selected);
399 ATestAllMethods.Enabled := not AllTestActive and not SingleTestActive;
400 ATestStop.Enabled := SingleTestActive or AllTestActive;
401 SpinEditWidth.MaxValue := Screen.DesktopWidth;
402 SpinEditHeight.MaxValue := Screen.DesktopHeight;
403 CheckBoxDoubleBuffered.Checked := FormDraw.DoubleBuffered;
404 CheckBoxEraseBackground.Checked := FormDraw.EraseBackgroundEnabled;
405 CheckBoxOpaque.Checked := csOpaque in FormDraw.ControlStyle;
406 ComboBoxPixelFormat.ItemIndex := Integer(PixelFormat);
407end;
408
409procedure TFormMain.RegisterDrawMethods;
410begin
411 RegisterDrawMethod(TMethodCanvasPixels);
412 RegisterDrawMethod(TMethodCanvasPixelsUpdateLock);
413 RegisterDrawMethod(TMethodLazIntfImageColorsCopy);
414 RegisterDrawMethod(TMethodLazIntfImageColorsNoCopy);
415 RegisterDrawMethod(TMethodBitmapRawImageData);
416 RegisterDrawMethod(TMethodBitmapRawImageDataPaintBox);
417 RegisterDrawMethod(TMethodBitmapRawImageDataMove);
418 RegisterDrawMethod(TMethodBitmapScanline);
419 RegisterDrawMethod(TMethodBGRABitmap);
420 {$IFDEF GRAPHICS32}
421 RegisterDrawMethod(TMethodGraphics32);
422 {$ENDIF}
423 {$IFDEF OPENGL}
424 RegisterDrawMethod(TMethodOpenGL);
425 RegisterDrawMethod(TMethodOpenGLPBO);
426 {$ENDIF}
427 RegisterDrawMethod(TMethodMove);
428 RegisterDrawMethod(TMethodDummy);
429end;
430
431procedure TFormMain.RegisterDrawMethod(MethodClass: TDrawMethodClass);
432begin
433 SetLength(DrawMethodClasses, Length(DrawMethodClasses) + 1);
434 DrawMethodClasses[High(DrawMethodClasses)] := MethodClass;
435end;
436
437end.
438
Note: See TracBrowser for help on using the repository browser.