| 1 | unit VA508AccessibilityCompileInfo;
|
|---|
| 2 |
|
|---|
| 3 | interface
|
|---|
| 4 |
|
|---|
| 5 | {$UNDEF DELAY_BEFORE_SHOW}
|
|---|
| 6 | {$DEFINE DELAY_BEFORE_SHOW}
|
|---|
| 7 |
|
|---|
| 8 | uses
|
|---|
| 9 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
|---|
| 10 | Dialogs, ExtCtrls, StdCtrls, DateUtils, StrUtils;
|
|---|
| 11 |
|
|---|
| 12 | type
|
|---|
| 13 | TfrmProgress = class(TForm)
|
|---|
| 14 | pnlMain: TPanel;
|
|---|
| 15 | pnlProject: TPanel;
|
|---|
| 16 | lblProj: TLabel;
|
|---|
| 17 | lblProject: TLabel;
|
|---|
| 18 | pnlFile: TPanel;
|
|---|
| 19 | lblComp: TLabel;
|
|---|
| 20 | lblFile: TLabel;
|
|---|
| 21 | pnlErrorData: TPanel;
|
|---|
| 22 | pnlErrors: TPanel;
|
|---|
| 23 | lblNumErrors: TLabel;
|
|---|
| 24 | lblErrors: TLabel;
|
|---|
| 25 | pnlWarnings: TPanel;
|
|---|
| 26 | lblNumWarnings: TLabel;
|
|---|
| 27 | lblWarnings: TLabel;
|
|---|
| 28 | btnRelease: TButton;
|
|---|
| 29 | Panel1: TPanel;
|
|---|
| 30 | lblTotal: TLabel;
|
|---|
| 31 | lblTotalLines: TLabel;
|
|---|
| 32 | Panel2: TPanel;
|
|---|
| 33 | Label1: TLabel;
|
|---|
| 34 | lblBuilt: TLabel;
|
|---|
| 35 | Panel3: TPanel;
|
|---|
| 36 | Label2: TLabel;
|
|---|
| 37 | lblCached: TLabel;
|
|---|
| 38 | procedure FormCreate(Sender: TObject);
|
|---|
| 39 | procedure btnReleaseClick(Sender: TObject);
|
|---|
| 40 | private
|
|---|
| 41 | { Private declarations }
|
|---|
| 42 | public
|
|---|
| 43 | { Public declarations }
|
|---|
| 44 | end;
|
|---|
| 45 |
|
|---|
| 46 | type
|
|---|
| 47 | TStopCompileProc = procedure of object;
|
|---|
| 48 |
|
|---|
| 49 | procedure StartMonitor(ProjectText: string; StopProc: TStopCompileProc);
|
|---|
| 50 | procedure StopMonitor;
|
|---|
| 51 | procedure Update508Monitor(FileName: String; TotalLines,
|
|---|
| 52 | Warnings, Errors, Cached, Built: integer; ForceDisplay: boolean = false);
|
|---|
| 53 |
|
|---|
| 54 | implementation
|
|---|
| 55 |
|
|---|
| 56 | uses VAUtils;
|
|---|
| 57 |
|
|---|
| 58 | {$R *.dfm}
|
|---|
| 59 |
|
|---|
| 60 | const
|
|---|
| 61 | {$IFDEF DELAY_BEFORE_SHOW}
|
|---|
| 62 | SECONDS_BEFORE_SHOW = 3;
|
|---|
| 63 | {$ENDIF}
|
|---|
| 64 | UPDATE_FREQUENCY = 50;
|
|---|
| 65 |
|
|---|
| 66 | var
|
|---|
| 67 | frmProgress: TfrmProgress = nil;
|
|---|
| 68 | uProjectText: string;
|
|---|
| 69 | uStopProc: TStopCompileProc;
|
|---|
| 70 | uRunning: boolean = false;
|
|---|
| 71 | uLastUpdate: TDateTime;
|
|---|
| 72 | {$IFDEF DELAY_BEFORE_SHOW}
|
|---|
| 73 | uStartTime: TDateTime;
|
|---|
| 74 | {$ENDIF}
|
|---|
| 75 |
|
|---|
| 76 | procedure Hookup;
|
|---|
| 77 | begin
|
|---|
| 78 | if not assigned(frmProgress) then
|
|---|
| 79 | frmProgress := TfrmProgress.Create(nil);
|
|---|
| 80 | frmProgress.lblProject.Caption := GetFileWithShortenedPath(uProjectText, frmProgress.lblProject.Width, frmProgress.Canvas);
|
|---|
| 81 | frmProgress.lblFile.Caption := '';
|
|---|
| 82 | frmProgress.Show;
|
|---|
| 83 | Application.ProcessMessages;
|
|---|
| 84 | end;
|
|---|
| 85 |
|
|---|
| 86 | procedure StartMonitor(ProjectText: string; StopProc: TStopCompileProc);
|
|---|
| 87 | begin
|
|---|
| 88 | uLastUpdate := 0;
|
|---|
| 89 | uProjectText := ProjectText;
|
|---|
| 90 | uStopProc := StopProc;
|
|---|
| 91 | {$IFDEF DELAY_BEFORE_SHOW}
|
|---|
| 92 | if assigned(frmProgress) then
|
|---|
| 93 | Hookup
|
|---|
| 94 | else
|
|---|
| 95 | uStartTime := Now;
|
|---|
| 96 | {$ELSE}
|
|---|
| 97 | Hookup;
|
|---|
| 98 | {$ENDIF}
|
|---|
| 99 | end;
|
|---|
| 100 |
|
|---|
| 101 | procedure StopMonitor;
|
|---|
| 102 | begin
|
|---|
| 103 | if assigned(frmProgress) then
|
|---|
| 104 | FreeAndNil(frmProgress);
|
|---|
| 105 | end;
|
|---|
| 106 |
|
|---|
| 107 | procedure Update508Monitor(FileName: String; TotalLines,
|
|---|
| 108 | Warnings, Errors, Cached, Built: integer; ForceDisplay: boolean = false);
|
|---|
| 109 | begin
|
|---|
| 110 | {$IFDEF DELAY_BEFORE_SHOW}
|
|---|
| 111 | if not assigned(frmProgress) then
|
|---|
| 112 | begin
|
|---|
| 113 | if ForceDisplay or (SecondSpan(Now, uStartTime) > SECONDS_BEFORE_SHOW) then
|
|---|
| 114 | Hookup;
|
|---|
| 115 | end;
|
|---|
| 116 | {$ENDIF}
|
|---|
| 117 | if assigned(frmProgress) then
|
|---|
| 118 | begin
|
|---|
| 119 | frmProgress.lblFile.Caption := FileName;
|
|---|
| 120 | frmProgress.lblTotalLines.Caption := IntToStr(TotalLines);
|
|---|
| 121 | frmProgress.lblWarnings.Caption := IntToStr(Warnings);
|
|---|
| 122 | frmProgress.lblErrors.Caption := IntToStr(Errors);
|
|---|
| 123 | frmProgress.lblCached.Caption := IntToStr(Cached);
|
|---|
| 124 | frmProgress.lblBuilt.Caption := IntToStr(Built);
|
|---|
| 125 | if MilliSecondSpan(Now, uLastUpdate) > UPDATE_FREQUENCY then
|
|---|
| 126 | begin
|
|---|
| 127 | Application.ProcessMessages;
|
|---|
| 128 | uLastUpdate := Now;
|
|---|
| 129 | end;
|
|---|
| 130 | end;
|
|---|
| 131 | end;
|
|---|
| 132 |
|
|---|
| 133 | procedure TfrmProgress.btnReleaseClick(Sender: TObject);
|
|---|
| 134 | begin
|
|---|
| 135 | btnRelease.Enabled := False;
|
|---|
| 136 | if assigned(uStopProc) then
|
|---|
| 137 | uStopProc;
|
|---|
| 138 | Close;
|
|---|
| 139 | end;
|
|---|
| 140 |
|
|---|
| 141 | procedure TfrmProgress.FormCreate(Sender: TObject);
|
|---|
| 142 | begin
|
|---|
| 143 | Left := (Screen.Width - Width) div 2;
|
|---|
| 144 | Top := (Screen.Height - Height) div 3;
|
|---|
| 145 | end;
|
|---|
| 146 |
|
|---|
| 147 | initialization
|
|---|
| 148 |
|
|---|
| 149 | finalization
|
|---|
| 150 | if assigned(frmProgress) then
|
|---|
| 151 | FreeAndNil(frmProgress);
|
|---|
| 152 | end.
|
|---|
