Changeset 446


Ignore:
Timestamp:
Nov 22, 2012, 1:48:16 PM (12 years ago)
Author:
chronos
Message:
  • Modified: Method execution code form single test and all methods benchmark united to single method.
Location:
GraphicTest
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • GraphicTest/GraphicTest.lpi

    r443 r446  
    2424            <SyntaxOptions>
    2525              <SyntaxMode Value="Delphi"/>
     26              <CStyleOperator Value="False"/>
     27              <AllowLabel Value="False"/>
    2628              <UseAnsiStrings Value="False"/>
    2729            </SyntaxOptions>
    2830          </Parsing>
    2931          <CodeGeneration>
     32            <SmartLinkUnit Value="True"/>
    3033            <Optimizations>
    3134              <OptimizationLevel Value="3"/>
    … …  
    3639              <GenerateDebugInfo Value="False"/>
    3740            </Debugging>
     41            <LinkSmart Value="True"/>
    3842            <Options>
    3943              <Win32>
    … …  
    123127      <SyntaxOptions>
    124128        <SyntaxMode Value="Delphi"/>
     129        <CStyleOperator Value="False"/>
     130        <AllowLabel Value="False"/>
    125131        <UseAnsiStrings Value="False"/>
    126132      </SyntaxOptions>

  • GraphicTest/UMainForm.lfm

    r445 r446  
    11object MainForm: TMainForm
    2   Left = 302
     2  Left = 336
    33  Height = 308
    4   Top = 181
     4  Top = 194
    55  Width = 554
    66  Caption = 'Graphic test'
    … …  
    167167    TabOrder = 8
    168168  end
    169   object Timer1: TTimer
     169  object TimerUpdateList: TTimer
    170170    Interval = 500
    171     OnTimer = Timer1Timer
     171    OnTimer = TimerUpdateListTimer
    172172    left = 238
    173173    top = 136

  • GraphicTest/UMainForm.pas

    r445 r446  
    3232    SpinEditWidth: TSpinEdit;
    3333    SpinEditHeight: TSpinEdit;
    34     Timer1: TTimer;
     34    TimerUpdateList: TTimer;
    3535    procedure ButtonBenchmarkClick(Sender: TObject);
    3636    procedure ButtonSingleTestClick(Sender: TObject);
    … …  
    4747    procedure SpinEditHeightChange(Sender: TObject);
    4848    procedure SpinEditWidthChange(Sender: TObject);
    49     procedure Timer1Timer(Sender: TObject);
     49    procedure TimerUpdateListTimer(Sender: TObject);
    5050  private
    5151    MethodIndex: Integer;
    5252    SingleTestActive: Boolean;
    5353    AllTestActive: Boolean;
     54    TestTerminated: Boolean;
     55    TestTimeout: Real;
    5456    procedure GenerateSceneFrames;
     57    procedure TestMethod(Method: TDrawMethod);
    5558    procedure UpdateMethodList;
    5659    procedure UpdateInterface;
    … …  
    9396end;
    9497
     98procedure TMainForm.TestMethod(Method: TDrawMethod);
     99var
     100  StepStartTime: TDateTime;
     101  StartTime: TDateTime;
     102begin
     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;
     118end;
     119
    95120procedure TMainForm.ButtonSingleTestClick(Sender: TObject);
    96 var
    97   StepStartTime: TDateTime;
    98 begin
     121begin
     122  if Assigned(ListViewMethods.Selected) then
    99123  try
    100124    SingleTestActive := True;
    101125    UpdateInterface;
    102     Timer1.Enabled := True;
     126    TimerUpdateList.Enabled := True;
    103127    MethodIndex := ListViewMethods.Selected.Index;
    104     Timer1.Enabled := True;
     128    TestTimeout := -1;
    105129    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]));
    118131  finally
    119     Timer1.Enabled := False;
     132    TimerUpdateList.Enabled := False;
    120133    SingleTestActive := False;
    121134    UpdateInterface;
    … …  
    126139var
    127140  I: Integer;
    128   StartTime: TDateTime;
    129   StepStartTime: TDateTime;
    130141begin
    131142  try
    132143    AllTestActive := True;
    133144    UpdateInterface;
    134     Timer1.Enabled := True;
     145    TimerUpdateList.Enabled := True;
     146    TestTerminated := False;
     147    TestTimeout := FloatSpinEdit1.Value;
    135148    with ListViewMethods, Items do
    136149    for I := 0 to DrawMethods.Count - 1 do
    137150    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]));
    149152    end;
    150153  finally
    151     Timer1.Enabled := False;
     154    TimerUpdateList.Enabled := False;
    152155    AllTestActive := False;
    153156    UpdateInterface;
    … …  
    157160procedure TMainForm.ButtonStopClick(Sender: TObject);
    158161begin
     162  TestTerminated := True;
    159163  SingleTestActive := False;
    160164  AllTestActive := False;
    … …  
    225229end;
    226230
    227 procedure TMainForm.Timer1Timer(Sender: TObject);
     231procedure TMainForm.TimerUpdateListTimer(Sender: TObject);
    228232begin
    229233  UpdateMethodList;
Note: See TracChangeset for help on using the changeset viewer.