Changeset 317 for GraphicTest/UMainForm.pas

Timestamp:

Feb 1, 2012, 3:02:33 PM (12 years ago)

Author:

chronos

Message:

• Modified: Updated BGRABitmap package to version 5.5.
• Modified: Removed draw method ComboBox and reorganized method list to single listview with using ownerdraw facility.
• Added: New draw method TBitmap.RawImage.Data Move which use fast Move operation. It requires same pixel format.
• Added: New draw method Dummy for comparion of empty method and to determine possibily max frame rate limit.

File:

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

GraphicTest/UMainForm.pas

@@ -20 +20 @@
 
   TMainForm = class(TForm)
+    ButtonStop: TButton;
     ButtonBenchmark: TButton;
-    ButtonStart: TButton;
-    ButtonStop: TButton;
-    ComboBox1: TComboBox;
+    ButtonSingleTest: TButton;
     FloatSpinEdit1: TFloatSpinEdit;
     Image1: TImage;
     Label1: TLabel;
     Label2: TLabel;
-    Label3: TLabel;
-    Label4: TLabel;
-    Label5: TLabel;
-    ListView1: TListView;
+    ListViewMethods: TListView;
     PageControl1: TPageControl;
     PaintBox1: TPaintBox;
@@ -39 +35 @@
     Timer1: TTimer;
     procedure ButtonBenchmarkClick(Sender: TObject);
-    procedure ButtonStartClick(Sender: TObject);
+    procedure ButtonSingleTestClick(Sender: TObject);
     procedure ButtonStopClick(Sender: TObject);
     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+    procedure ListViewMethodsData(Sender: TObject; Item: TListItem);
+    procedure ListViewMethodsSelectItem(Sender: TObject; Item: TListItem;
+      Selected: Boolean);
     procedure Timer1Timer(Sender: TObject);
   private
@@ -50 +50 @@
     TextureData: Pointer;
     MethodIndex: Integer;
+    SingleTestActive: Boolean;
+    AllTestActive: Boolean;
     procedure OpenGLControl1Resize(Sender: TObject);
     procedure InitGL;
+    procedure UpdateMethodList;
+    procedure UpdateInterface;
   public
     DrawMethods: TObjectList; // TObjectList<TDrawMethod>
@@ -86 +90 @@
   Bitmap.PixelFormat := pf24bit;
   Image1.Picture.Bitmap.SetSize(TFastBitmap(Scenes[0]).Size.X, TFastBitmap(Scenes[0]).Size.Y);
+  Image1.Picture.Bitmap.PixelFormat := pf32bit;
   Bitmap.SetSize(TFastBitmap(Scenes[0]).Size.X, TFastBitmap(Scenes[0]).Size.Y);
 
@@ -100 +105 @@
 
   DrawMethods := TObjectList.Create;
-  ComboBox1.Clear;
   for I := 0 to High(DrawMethodClasses) do begin
     NewDrawMethod := DrawMethodClasses[I].Create;
@@ -109 +113 @@
     NewDrawMethod.Init;
     DrawMethods.Add(NewDrawMethod);
-    ComboBox1.Items.Add(NewDrawMethod.Caption);
-  end;
-  ComboBox1.ItemIndex := DrawMethods.Count - 1;
-end;
-
-procedure TMainForm.ButtonStartClick(Sender: TObject);
-begin
-  MethodIndex := ComboBox1.ItemIndex;
-  ButtonStop.Enabled := True;
-  ButtonStart.Enabled := False;
-  Timer1.Enabled := True;
-  if MethodIndex >= 0 then
-  with TDrawMethod(DrawMethods[MethodIndex]) do begin
-    PageControl1.TabIndex := Integer(PaintObject);
-    Application.ProcessMessages;
-    repeat
-      DrawFrameTiming(TFastBitmap(Scenes[SceneIndex]));
-      SceneIndex := (SceneIndex + 1) mod Scenes.Count;
+  end;
+end;
+
+procedure TMainForm.ButtonSingleTestClick(Sender: TObject);
+begin
+  try
+    SingleTestActive := True;
+    UpdateInterface;
+    Timer1.Enabled := True;
+    MethodIndex := ListViewMethods.Selected.Index;
+    Timer1.Enabled := True;
+    if MethodIndex >= 0 then
+    with TDrawMethod(DrawMethods[MethodIndex]) do begin
+      PageControl1.TabIndex := Integer(PaintObject);
       Application.ProcessMessages;
-    until not ButtonStop.Enabled;
-  end;
-  ButtonStopClick(Self);
+      repeat
+        DrawFrameTiming(TFastBitmap(Scenes[SceneIndex]));
+        SceneIndex := (SceneIndex + 1) mod Scenes.Count;
+        Application.ProcessMessages;
+      until not SingleTestActive;
+    end;
+  finally
+    Timer1.Enabled := False;
+    SingleTestActive := False;
+    UpdateInterface;
+  end;
 end;
 
 procedure TMainForm.ButtonBenchmarkClick(Sender: TObject);
 var
-  NewItem: TListItem;
   I: Integer;
   C: Integer;
   StartTime: TDateTime;
 begin
-  Timer1.Enabled := True;
-  with ListView1, Items do
   try
-    //BeginUpdate;
-    Clear;
+    AllTestActive := True;
+    UpdateInterface;
+    Timer1.Enabled := True;
+    with ListViewMethods, Items do
     for I := 0 to DrawMethods.Count - 1 do
     with TDrawMethod(DrawMethods[I]) do begin
@@ -154 +161 @@
         SceneIndex := (SceneIndex + 1) mod Scenes.Count;
         Application.ProcessMessages;
-      until (NowPrecise - StartTime) > OneSecond * FloatSpinEdit1.Value;
-      NewItem := Add;
-      NewItem.Caption := Caption;
-      NewItem.SubItems.Add(FloatToStr(RoundTo(FrameDuration / OneMillisecond, -3)));
-      NewItem.SubItems.Add(FloatToStr(RoundTo(1 / (FrameDuration / OneSecond), -3)));
+      until ((NowPrecise - StartTime) > OneSecond * FloatSpinEdit1.Value) or not AllTestActive;
     end;
   finally
-    //EndUpdate;
+    Timer1.Enabled := False;
+    AllTestActive := False;
+    UpdateInterface;
   end;
 end;
@@ -167 +172 @@
 procedure TMainForm.ButtonStopClick(Sender: TObject);
 begin
-  ButtonStart.Enabled := True;
-  ButtonStop.Enabled := False;
+  SingleTestActive := False;
+  AllTestActive := False;
 end;
 
@@ -184 +189 @@
 end;
 
+procedure TMainForm.FormShow(Sender: TObject);
+begin
+  UpdateMethodList;
+  UpdateInterface;
+end;
+
+procedure TMainForm.ListViewMethodsData(Sender: TObject; Item: TListItem);
+begin
+  if (Item.Index >= 0) and (Item.Index < DrawMethods.Count) then
+  with TDrawMethod(DrawMethods[Item.Index]) do begin
+    Item.Caption := Caption;
+    if FrameDuration > 0 then
+      Item.SubItems.Add(FloatToStr(RoundTo(1 / (FrameDuration / OneSecond), -3)))
+      else Item.SubItems.Add('0');
+    Item.SubItems.Add(FloatToStr(RoundTo(FrameDuration / OneMillisecond, -3)) + ' ms');
+  end;
+end;
+
+procedure TMainForm.ListViewMethodsSelectItem(Sender: TObject; Item: TListItem;
+  Selected: Boolean);
+begin
+  UpdateInterface;
+end;
+
 procedure TMainForm.Timer1Timer(Sender: TObject);
 begin
-  if (MethodIndex >= 0) then
-  with TDrawMethod(DrawMethods[MethodIndex]) do begin
-    if (FrameDuration > 0) then
-      Label2.Caption := FloatToStr(RoundTo(1 / (FrameDuration / OneSecond), -3))
-      else Label2.Caption := '0';
-    Label4.Caption := FloatToStr(RoundTo(FrameDuration / OneMillisecond, -3)) + ' ms';
-  end;
+  UpdateMethodList;
 end;
 
@@ -220 +243 @@
 end;
 
+procedure TMainForm.UpdateMethodList;
+begin
+  ListViewMethods.Items.Count := DrawMethods.Count;
+  ListViewMethods.Refresh;
+end;
+
+procedure TMainForm.UpdateInterface;
+begin
+  ButtonSingleTest.Enabled := not SingleTestActive and not AllTestActive and Assigned(ListViewMethods.Selected);
+  ButtonBenchmark.Enabled := not AllTestActive and not SingleTestActive;
+  ButtonStop.Enabled := SingleTestActive or AllTestActive;
+end;
+
 end.