Changeset 25
- Timestamp:
- Apr 5, 2016, 10:54:28 PM (9 years ago)
- Location:
- trunk
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Form/UFormMain.lfm
r24 r25 38 38 end 39 39 end 40 object Panel1: TPanel41 Left = 59742 Height = 101443 Top = 2644 Width = 110645 Align = alClient46 BevelOuter = bvNone47 ClientHeight = 101448 ClientWidth = 110649 TabOrder = 150 object Image1: TImage51 Left = 852 Height = 99853 Top = 854 Width = 109055 Align = alClient56 BorderSpacing.Around = 857 OnResize = Image1Resize58 end59 end60 40 object Panel2: TPanel 61 41 Left = 0 … … 67 47 ClientHeight = 1014 68 48 ClientWidth = 592 69 TabOrder = 249 TabOrder = 1 70 50 object Panel3: TPanel 71 51 Left = 0 … … 364 344 Width = 5 365 345 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 366 405 object Timer1: TTimer 367 406 Interval = 500 -
trunk/Form/UFormMain.pas
r24 r25 6 6 7 7 uses 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,9 Menus, ComCtrls, ExtCtrls, ActnList, dateutils, syncobjs, UProject,10 U DriveScan, 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; 12 12 13 13 type … … 38 38 ButtonScan1: TButton; 39 39 ButtonScan2: TButton; 40 ChartSpeed: TChart; 41 ChartSpeedLineSeries1: TLineSeries; 40 42 ComboBoxDrive: TComboBox; 41 43 Image1: TImage; … … 83 85 MenuItem9: TMenuItem; 84 86 OpenDialog1: TOpenDialog; 85 Pa nel1: TPanel;87 PageControl1: TPageControl; 86 88 Panel2: TPanel; 87 89 Panel3: TPanel; … … 91 93 Splitter1: TSplitter; 92 94 Splitter2: TSplitter; 95 TabSheetSectors: TTabSheet; 96 TabSheetSpeed: TTabSheet; 93 97 Timer1: TTimer; 94 98 ToolBar1: TToolBar; … … 135 139 procedure DoDraw; 136 140 procedure UpdateInterface; 141 procedure UpdateSpeedChart; 137 142 public 138 143 procedure SaveConfig; … … 176 181 UpdateInterface; 177 182 end; 183 PageControl1.TabIndex := 0; 178 184 end; 179 185 … … 465 471 CurrentScan.Lock.Release; 466 472 end; 473 UpdateSpeedChart; 467 474 end else 468 475 with Image1 do begin … … 522 529 end; 523 530 531 procedure TFormMain.UpdateSpeedChart; 532 var 533 I: Integer; 534 begin 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; 547 end; 548 524 549 procedure TFormMain.SaveConfig; 525 550 begin -
trunk/UDriveScan.pas
r24 r25 7 7 uses 8 8 Classes, SysUtils, Syncobjs, UBlockMap, Forms, DOM, UConfig, UPhysDrive, 9 UXMLUtils, Contnrs ;9 UXMLUtils, Contnrs, ExtCtrls, DateUtils; 10 10 11 11 type 12 12 TDriveScan = class; 13 13 14 TRunMode = (rmRead, rmWrite, rmNone );14 TRunMode = (rmRead, rmWrite, rmNone, rmSpeed); 15 15 TExceptionEvent = procedure (Sender: TObject; E: Exception) of object; 16 16 … … 47 47 end; 48 48 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 49 60 { TDriveScan } 50 61 … … 57 68 ScanThread: TScanThread; 58 69 LastExceptionMessage: string; 70 SpeedTimer: TTimer; 71 SpeedTimeLast: TDateTime; 72 SectorLast: Integer; 59 73 procedure DoOnExceptionSync; 60 74 procedure DoOnException(Sender: TObject; E: Exception); … … 65 79 procedure SetDriveName(AValue: string); 66 80 procedure SetSectorCount(AValue: Integer); 81 procedure SpeedTimerExecute(Sender: TObject); 67 82 public 68 83 Lock: TCriticalSection; … … 77 92 SectorStart: Integer; 78 93 SectorEnd: Integer; 94 SpeedSteps: array of TSpeedValue; 95 SpeedStepsCount: Integer; 79 96 function GetName: string; 80 97 function GetElapsedTime: TDateTime; … … 107 124 SUnknownRunMode = 'Unknown run mode'; 108 125 126 { TSpeedValue } 127 128 procedure TSpeedValue.Reset; 129 begin 130 Null := True; 131 end; 132 133 procedure TSpeedValue.UpdateValue(Value: Int64); 134 begin 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; 145 end; 146 109 147 { TDriveScanProfile } 110 148 … … 213 251 214 252 procedure TDriveScan.Reset; 253 var 254 I: Integer; 215 255 begin 216 256 TimeStart := Now; … … 218 258 BlockMap.Clear; 219 259 FSectorCurrent := SectorStart; 260 SetLength(SpeedSteps, SpeedStepsCount); 261 for I := 0 to Length(SpeedSteps) - 1 do 262 SpeedSteps[I].Reset; 220 263 end; 221 264 … … 228 271 ScanThread.Scan := Self; 229 272 ScanThread.Start; 273 SpeedTimeLast := Now; 274 SectorLast := SectorCurrent; 275 SpeedTimer.Enabled := True; 230 276 end; 231 277 end; … … 294 340 end; 295 341 342 procedure TDriveScan.SpeedTimerExecute(Sender: TObject); 343 var 344 SpeedTimeCurrent: TDateTime; 345 Index: Integer; 346 begin 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; 354 end; 355 296 356 function TDriveScan.GetName: string; 297 357 begin … … 305 365 begin 306 366 if not Terminated then begin 367 SpeedTimer.Enabled := False; 307 368 Terminated := True; 308 369 ScanThread.Terminate; … … 324 385 Lock := TCriticalSection.Create; 325 386 BlockMap := TBlockMap.Create; 387 SpeedTimer := TTimer.Create(nil); 388 SpeedTimer.Interval := 500; 389 SpeedTimer.Enabled := False; 390 SpeedTimer.OnTimer := SpeedTimerExecute; 391 SpeedStepsCount := 1000; 326 392 SectorSize := 4096; 327 393 Terminated := True; … … 333 399 begin 334 400 Stop; 401 FreeAndNil(SpeedTimer); 335 402 FreeAndNil(BlockMap); 336 403 FreeAndNil(Lock); … … 341 408 var 342 409 NewNode: TDOMNode; 410 NewNode2: TDOMNode; 411 NewNode3: TDOMNode; 412 I: Integer; 343 413 begin 344 414 with Node do begin … … 358 428 AppendChild(NewNode); 359 429 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; 360 445 end; 361 446 end; … … 364 449 var 365 450 NewNode: TDOMNode; 451 NewNode2: TDOMNode; 452 NewNode3: TDOMNode; 453 I: Integer; 366 454 begin 367 455 with Node do begin … … 381 469 if Assigned(NewNode) then 382 470 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; 489 end; 384 490 end; 385 491
Note:
See TracChangeset
for help on using the changeset viewer.