Changeset 25


Ignore:
Timestamp:
Apr 5, 2016, 10:54:28 PM (8 years ago)
Author:
chronos
Message:
  • Added: Record transfer speed to chart during scan operation.
Location:
trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • trunk/Form/UFormMain.lfm

    r24 r25  
    3838    end
    3939  end
    40   object Panel1: TPanel
    41     Left = 597
    42     Height = 1014
    43     Top = 26
    44     Width = 1106
    45     Align = alClient
    46     BevelOuter = bvNone
    47     ClientHeight = 1014
    48     ClientWidth = 1106
    49     TabOrder = 1
    50     object Image1: TImage
    51       Left = 8
    52       Height = 998
    53       Top = 8
    54       Width = 1090
    55       Align = alClient
    56       BorderSpacing.Around = 8
    57       OnResize = Image1Resize
    58     end
    59   end
    6040  object Panel2: TPanel
    6141    Left = 0
    … …  
    6747    ClientHeight = 1014
    6848    ClientWidth = 592
    69     TabOrder = 2
     49    TabOrder = 1
    7050    object Panel3: TPanel
    7151      Left = 0
    … …  
    364344    Width = 5
    365345  end
     346  object PageControl1: TPageControl
     347    Left = 597
     348    Height = 1014
     349    Top = 26
     350    Width = 1106
     351    ActivePage = TabSheetSpeed
     352    Align = alClient
     353    TabIndex = 1
     354    TabOrder = 3
     355    object TabSheetSectors: TTabSheet
     356      Caption = 'Sector map'
     357      ClientHeight = 972
     358      ClientWidth = 1100
     359      object Image1: TImage
     360        Left = 4
     361        Height = 964
     362        Top = 4
     363        Width = 1092
     364        Align = alClient
     365        BorderSpacing.Around = 4
     366        OnResize = Image1Resize
     367      end
     368    end
     369    object TabSheetSpeed: TTabSheet
     370      Caption = 'Transfer speed'
     371      ClientHeight = 972
     372      ClientWidth = 1100
     373      object ChartSpeed: TChart
     374        Left = 4
     375        Height = 964
     376        Top = 4
     377        Width = 1092
     378        AxisList = <       
     379          item
     380            Marks.Format = '%0:.9g MB/s'
     381            Marks.Style = smsCustom
     382            Minors = <>
     383            Range.UseMin = True
     384            Title.LabelFont.Orientation = 900
     385          end       
     386          item
     387            Alignment = calBottom
     388            Minors = <>
     389          end>
     390        Foot.Brush.Color = clBtnFace
     391        Foot.Font.Color = clBlue
     392        Title.Brush.Color = clBtnFace
     393        Title.Font.Color = clBlue
     394        Title.Text.Strings = (
     395          'TAChart'
     396        )
     397        Align = alClient
     398        BorderSpacing.Around = 4
     399        object ChartSpeedLineSeries1: TLineSeries
     400          LinePen.Color = clWhite
     401        end
     402      end
     403    end
     404  end
    366405  object Timer1: TTimer
    367406    Interval = 500

  • trunk/Form/UFormMain.pas

    r24 r25  
    66
    77uses
    8   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    9   Menus, ComCtrls, ExtCtrls, ActnList, dateutils, syncobjs, UProject,
    10   UDriveScan, UPrefixMultiplier, ULastOpenedList, UPersistentForm, XMLConf,
    11   UPhysDrive;
     8  Classes, SysUtils, FileUtil, TAGraph, TASeries, Forms, Controls, Graphics,
     9  Dialogs, StdCtrls, Menus, ComCtrls, ExtCtrls, ActnList, dateutils, syncobjs,
     10  UProject, UDriveScan, UPrefixMultiplier, ULastOpenedList, UPersistentForm,
     11  XMLConf, UPhysDrive;
    1212
    1313type
    … …  
    3838    ButtonScan1: TButton;
    3939    ButtonScan2: TButton;
     40    ChartSpeed: TChart;
     41    ChartSpeedLineSeries1: TLineSeries;
    4042    ComboBoxDrive: TComboBox;
    4143    Image1: TImage;
    … …  
    8385    MenuItem9: TMenuItem;
    8486    OpenDialog1: TOpenDialog;
    85     Panel1: TPanel;
     87    PageControl1: TPageControl;
    8688    Panel2: TPanel;
    8789    Panel3: TPanel;
    … …  
    9193    Splitter1: TSplitter;
    9294    Splitter2: TSplitter;
     95    TabSheetSectors: TTabSheet;
     96    TabSheetSpeed: TTabSheet;
    9397    Timer1: TTimer;
    9498    ToolBar1: TToolBar;
    … …  
    135139    procedure DoDraw;
    136140    procedure UpdateInterface;
     141    procedure UpdateSpeedChart;
    137142  public
    138143    procedure SaveConfig;
    … …  
    176181    UpdateInterface;
    177182  end;
     183  PageControl1.TabIndex := 0;
    178184end;
    179185
    … …  
    465471      CurrentScan.Lock.Release;
    466472    end;
     473    UpdateSpeedChart;
    467474  end else
    468475  with Image1 do begin
    … …  
    522529end;
    523530
     531procedure TFormMain.UpdateSpeedChart;
     532var
     533  I: Integer;
     534begin
     535  if TabSheetSpeed.Visible then
     536  if Assigned(Core.Project) then
     537  with Core.Project do
     538  if Assigned(CurrentScan) then
     539  with CurrentScan do begin
     540    ChartSpeed.BottomAxis.Range.UseMax := True;
     541    ChartSpeed.BottomAxis.Range.Max := Length(SpeedSteps);
     542    ChartSpeedLineSeries1.Clear;
     543    for I := 0 to Length(SpeedSteps) - 1 do
     544    if not SpeedSteps[I].Null then
     545      ChartSpeedLineSeries1.AddXY(I, SpeedSteps[I].Average / (1024 * 1024));
     546  end;
     547end;
     548
    524549procedure TFormMain.SaveConfig;
    525550begin

  • trunk/UDriveScan.pas

    r24 r25  
    77uses
    88  Classes, SysUtils, Syncobjs, UBlockMap, Forms, DOM, UConfig, UPhysDrive,
    9   UXMLUtils, Contnrs;
     9  UXMLUtils, Contnrs, ExtCtrls, DateUtils;
    1010
    1111type
    1212  TDriveScan = class;
    1313
    14   TRunMode = (rmRead, rmWrite, rmNone);
     14  TRunMode = (rmRead, rmWrite, rmNone, rmSpeed);
    1515  TExceptionEvent = procedure (Sender: TObject; E: Exception) of object;
    1616
    … …  
    4747  end;
    4848
     49  { TSpeedValue }
     50
     51  TSpeedValue = record
     52    Null: Boolean;
     53    Max: Int64;
     54    Average: Int64;
     55    Min: Int64;
     56    procedure Reset;
     57    procedure UpdateValue(Value: Int64);
     58  end;
     59
    4960  { TDriveScan }
    5061
    … …  
    5768    ScanThread: TScanThread;
    5869    LastExceptionMessage: string;
     70    SpeedTimer: TTimer;
     71    SpeedTimeLast: TDateTime;
     72    SectorLast: Integer;
    5973    procedure DoOnExceptionSync;
    6074    procedure DoOnException(Sender: TObject; E: Exception);
    … …  
    6579    procedure SetDriveName(AValue: string);
    6680    procedure SetSectorCount(AValue: Integer);
     81    procedure SpeedTimerExecute(Sender: TObject);
    6782  public
    6883    Lock: TCriticalSection;
    … …  
    7792    SectorStart: Integer;
    7893    SectorEnd: Integer;
     94    SpeedSteps: array of TSpeedValue;
     95    SpeedStepsCount: Integer;
    7996    function GetName: string;
    8097    function GetElapsedTime: TDateTime;
    … …  
    107124  SUnknownRunMode = 'Unknown run mode';
    108125
     126{ TSpeedValue }
     127
     128procedure TSpeedValue.Reset;
     129begin
     130  Null := True;
     131end;
     132
     133procedure TSpeedValue.UpdateValue(Value: Int64);
     134begin
     135  if Null then begin
     136    Min := High(Int64);
     137    Max := Low(Int64);
     138    Average := 0;
     139  end;
     140  Null := False;
     141  if Value > Max then Max := Value;
     142  // TODO: Computer average
     143  Average := Value;
     144  if Value < Min then Min := Value;
     145end;
     146
    109147{ TDriveScanProfile }
    110148
    … …  
    213251
    214252procedure TDriveScan.Reset;
     253var
     254  I: Integer;
    215255begin
    216256  TimeStart := Now;
    … …  
    218258  BlockMap.Clear;
    219259  FSectorCurrent := SectorStart;
     260  SetLength(SpeedSteps, SpeedStepsCount);
     261  for I := 0 to Length(SpeedSteps) - 1 do
     262    SpeedSteps[I].Reset;
    220263end;
    221264
    … …  
    228271    ScanThread.Scan := Self;
    229272    ScanThread.Start;
     273    SpeedTimeLast := Now;
     274    SectorLast := SectorCurrent;
     275    SpeedTimer.Enabled := True;
    230276  end;
    231277end;
    … …  
    294340end;
    295341
     342procedure TDriveScan.SpeedTimerExecute(Sender: TObject);
     343var
     344  SpeedTimeCurrent: TDateTime;
     345  Index: Integer;
     346begin
     347  SpeedTimeCurrent := Now;
     348  Index := Trunc(SectorCurrent / SectorCount * SpeedStepsCount);
     349  if Index >= Length(SpeedSteps) then Index := Length(SpeedSteps) - 1;
     350  SpeedSteps[Index].UpdateValue(
     351    Trunc((SectorCurrent - SectorLast) * SectorSize / ((SpeedTimeCurrent - SpeedTimeLast) / OneSecond)));
     352  SpeedTimeLast := SpeedTimeCurrent;
     353  SectorLast := SectorCurrent;
     354end;
     355
    296356function TDriveScan.GetName: string;
    297357begin
    … …  
    305365begin
    306366  if not Terminated then begin
     367    SpeedTimer.Enabled := False;
    307368    Terminated := True;
    308369    ScanThread.Terminate;
    … …  
    324385  Lock := TCriticalSection.Create;
    325386  BlockMap := TBlockMap.Create;
     387  SpeedTimer := TTimer.Create(nil);
     388  SpeedTimer.Interval := 500;
     389  SpeedTimer.Enabled := False;
     390  SpeedTimer.OnTimer := SpeedTimerExecute;
     391  SpeedStepsCount := 1000;
    326392  SectorSize := 4096;
    327393  Terminated := True;
    … …  
    333399begin
    334400  Stop;
     401  FreeAndNil(SpeedTimer);
    335402  FreeAndNil(BlockMap);
    336403  FreeAndNil(Lock);
    … …  
    341408var
    342409  NewNode: TDOMNode;
     410  NewNode2: TDOMNode;
     411  NewNode3: TDOMNode;
     412  I: Integer;
    343413begin
    344414  with Node do begin
    … …  
    358428    AppendChild(NewNode);
    359429    BlockMap.SaveToNode(NewNode);
     430
     431    NewNode := OwnerDocument.CreateElement('Speed');
     432    AppendChild(NewNode);
     433    WriteInt64(NewNode, 'Count', Length(SpeedSteps));
     434    NewNode2 := OwnerDocument.CreateElement('Steps');
     435    NewNode.AppendChild(NewNode2);
     436    for I := 0 to Length(SpeedSteps) - 1 do
     437    if not SpeedSteps[I].Null then begin
     438      NewNode3 := OwnerDocument.CreateElement('Step');
     439      NewNode2.AppendChild(NewNode3);
     440      WriteInteger(NewNode3, 'Index', I);
     441      WriteInt64(NewNode3, 'Avg', SpeedSteps[I].Average);
     442      WriteInt64(NewNode3, 'Min', SpeedSteps[I].Min);
     443      WriteInt64(NewNode3, 'Max', SpeedSteps[I].Max);
     444    end;
    360445  end;
    361446end;
    … …  
    364449var
    365450  NewNode: TDOMNode;
     451  NewNode2: TDOMNode;
     452  NewNode3: TDOMNode;
     453  I: Integer;
    366454begin
    367455  with Node do begin
    … …  
    381469    if Assigned(NewNode) then
    382470      BlockMap.LoadFromNode(NewNode);
    383   end;
     471
     472    NewNode := FindNode('Speed');
     473    if Assigned(NewNode) then begin
     474      SpeedStepsCount := ReadInt64(NewNode, 'Count', 0);
     475      SetLength(SpeedSteps, SpeedStepsCount);
     476      NewNode2 := NewNode.FindNode('Steps');
     477      if Assigned(NewNode2) then begin
     478        NewNode3 := NewNode2.FirstChild;
     479        while Assigned(NewNode3) and (NewNode3.NodeName = 'Step') do begin
     480          I := ReadInteger(NewNode3, 'Index', 0);
     481          SpeedSteps[I].Average := ReadInt64(NewNode3, 'Avg', 0);
     482          SpeedSteps[I].Min := ReadInt64(NewNode3, 'Min', 0);
     483          SpeedSteps[I].Max := ReadInt64(NewNode3, 'Max', 0);
     484          SpeedSteps[I].Null := False;
     485          NewNode3 := NewNode3.NextSibling;
     486        end;
     487      end;
     488    end;
     489end;
    384490end;
    385491
Note: See TracChangeset for help on using the changeset viewer.