source: trunk/Forms/UFormMain.pas

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