Changeset 454 for GraphicTest/UMainForm.pas

Timestamp:

Nov 26, 2012, 7:38:56 AM (12 years ago)

Author:

chronos

Message:

• Added: Now PixelFormat for tests where TBitmap is used can be changed.
• Fixed: Stopping of test of all methods.

File:

• GraphicTest/UMainForm.pas (modified) (14 diffs)

GraphicTest/UMainForm.pas

@@ -9 +9 @@
   Graphics, Dialogs, ComCtrls, ExtCtrls, StdCtrls, DateUtils, UPlatform,
   LCLType, IntfGraphics, fpImage, Math, GraphType, Contnrs, LclIntf, Spin,
-  ActnList, Menus, StdActns, UFastBitmap, UDrawMethod;
+  ActnList, Menus, StdActns, UFastBitmap, UDrawMethod, typinfo;
 
 const
@@ -19 +19 @@
 
   TMainForm = class(TForm)
-    Action1: TAction;
+    AShowDrawForm: TAction;
+    ATestAllMethods: TAction;
+    ATestOneMethod: TAction;
+    ATestStop: TAction;
     AExportAsWikiText: TAction;
     ActionList1: TActionList;
@@ -28 +31 @@
     CheckBoxDoubleBuffered: TCheckBox;
     CheckBoxEraseBackground: TCheckBox;
+    ComboBox1: TComboBox;
     FileExit1: TFileExit;
     FloatSpinEdit1: TFloatSpinEdit;
@@ -34 +38 @@
     Label3: TLabel;
     Label4: TLabel;
+    Label5: TLabel;
     ListViewMethods: TListView;
     MainMenu1: TMainMenu;
@@ -40 +45 @@
     MenuItem2: TMenuItem;
     MenuItem3: TMenuItem;
+    MenuItem4: TMenuItem;
+    MenuItem8: TMenuItem;
+    MenuItemTest: TMenuItem;
+    MenuItem5: TMenuItem;
+    MenuItem6: TMenuItem;
+    MenuItem7: TMenuItem;
     PageControl1: TPageControl;
     Panel1: TPanel;
@@ -52 +63 @@
     TimerUpdateList: TTimer;
     procedure AExportAsWikiTextExecute(Sender: TObject);
-    procedure ButtonBenchmarkClick(Sender: TObject);
-    procedure ButtonSingleTestClick(Sender: TObject);
-    procedure ButtonStopClick(Sender: TObject);
+    procedure AShowDrawFormExecute(Sender: TObject);
+    procedure ATestAllMethodsExecute(Sender: TObject);
+    procedure ATestOneMethodExecute(Sender: TObject);
+    procedure ATestStopExecute(Sender: TObject);
     procedure CheckBox1Change(Sender: TObject);
     procedure CheckBoxDoubleBufferedChange(Sender: TObject);
     procedure CheckBoxEraseBackgroundChange(Sender: TObject);
+    procedure ComboBox1Change(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
@@ -81 +94 @@
   public
     FrameSize: TPoint;
+    PixelFormat: TPixelFormat;
     DrawMethods: TObjectList; // TObjectList<TDrawMethod>
     Scenes: TObjectList; // TObjectList<TFastBitmap>
@@ -114 +128 @@
   NewDrawMethod: TDrawMethod;
   I: Integer;
+  PF: TPixelFormat;
 begin
   Scenes := TObjectList.Create;
@@ -126 +141 @@
   end;
 
+  for PF := Low(TPixelFormat) to High(TPixelFormat) do
+    ComboBox1.Items.Add(GetEnumName(TypeInfo(TPixelFormat), Integer(PF)));
+
   PageControl1.TabIndex := 0;
 end;
@@ -135 +153 @@
 begin
   with Method do begin
-    Init(DrawForm, FrameSize);
-    TestTerminated := False;
+    Init(DrawForm, FrameSize, PixelFormat);
     //Application.ProcessMessages;
     StartTime := NowPrecise;
@@ -154 +171 @@
     //FPS := GetFPS;
     Done;
-  end;
-end;
-
-procedure TMainForm.ButtonSingleTestClick(Sender: TObject);
-begin
-  if Assigned(ListViewMethods.Selected) then
-  try
-    SingleTestActive := True;
-    UpdateInterface;
-    TimerUpdateList.Enabled := True;
-    MethodIndex := ListViewMethods.Selected.Index;
-    TestTimeout := -1;
-    if MethodIndex >= 0 then
-      TestMethod(TDrawMethod(DrawMethods[MethodIndex]));
-  finally
-    //TimerUpdateList.Enabled := False;
-    SingleTestActive := False;
-    UpdateInterface;
-  end;
-end;
-
-procedure TMainForm.ButtonBenchmarkClick(Sender: TObject);
-var
-  I: Integer;
-begin
-  try
-    AllTestActive := True;
-    UpdateInterface;
-    TimerUpdateList.Enabled := True;
-    TestTerminated := False;
-    TestTimeout := FloatSpinEdit1.Value;
-    with ListViewMethods, Items do
-    for I := 0 to DrawMethods.Count - 1 do
-    with TDrawMethod(DrawMethods[I]) do begin
-      TestMethod(TDrawMethod(DrawMethods[I]));
-    end;
-  finally
-    TimerUpdateList.Enabled := False;
-    AllTestActive := False;
-    UpdateInterface;
   end;
 end;
@@ -225 +202 @@
 end;
 
-procedure TMainForm.ButtonStopClick(Sender: TObject);
+procedure TMainForm.AShowDrawFormExecute(Sender: TObject);
+begin
+  DrawForm.Show;
+end;
+
+procedure TMainForm.ATestAllMethodsExecute(Sender: TObject);
+var
+  I: Integer;
+begin
+  try
+    AllTestActive := True;
+    UpdateInterface;
+    TimerUpdateList.Enabled := True;
+    TestTerminated := False;
+    TestTimeout := FloatSpinEdit1.Value;
+    with ListViewMethods, Items do
+    for I := 0 to DrawMethods.Count - 1 do
+    with TDrawMethod(DrawMethods[I]) do begin
+      TestMethod(TDrawMethod(DrawMethods[I]));
+      if TestTerminated then Break;
+    end;
+  finally
+    TimerUpdateList.Enabled := False;
+    AllTestActive := False;
+    UpdateInterface;
+  end;
+end;
+
+procedure TMainForm.ATestOneMethodExecute(Sender: TObject);
+begin
+  if Assigned(ListViewMethods.Selected) then
+  try
+    SingleTestActive := True;
+    UpdateInterface;
+    TimerUpdateList.Enabled := True;
+    TestTerminated := False;
+    MethodIndex := ListViewMethods.Selected.Index;
+    TestTimeout := -1;
+    if MethodIndex >= 0 then
+      TestMethod(TDrawMethod(DrawMethods[MethodIndex]));
+  finally
+    //TimerUpdateList.Enabled := False;
+    SingleTestActive := False;
+    UpdateInterface;
+  end;
+end;
+
+procedure TMainForm.ATestStopExecute(Sender: TObject);
 begin
   TestTerminated := True;
@@ -249 +273 @@
 end;
 
+procedure TMainForm.ComboBox1Change(Sender: TObject);
+begin
+  PixelFormat := TPixelFormat(ComboBox1.ItemIndex);
+  UpdateInterface;
+end;
+
 procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
 begin
-  ButtonStopClick(Self);
+  ATestStop.Execute;
 end;
 
@@ -354 +384 @@
   CheckBoxEraseBackground.Checked := DrawForm.EraseBackgroundEnabled;
   CheckBox1.Checked := csOpaque in DrawForm.ControlStyle;
+  ComboBox1.ItemIndex := Integer(PixelFormat);
 end;