Советы по Delphi
Линейка прогресса в консольном приложении
Кодом делится Slava Kostin:
|
(*Данный юнит содержит описание класса для отображения в консольном окне прогресса выполнения какой-либо длительной операции. (c) Slava Kostin Период с которым будет производиться вывод на экран задается функцией SetPause(), в качестве параметра в нее передается период (в секундах) вывода сообщений на экран. Сообщение может содержать ключевые слова MIN - в эту позицию выводится минимальное значение прогресса MAX - ---''--- максимум CURRENT - ---''--- текущая позиция PROGRESS - ---''--- прогресс (процент завершения) TIME - ---''--- время, в течение которого работает программа LEFTTIME - ---''--- сколько приблизительно осталось работать TOTALTIME - ---''--- общее время работы процесса Все ключевые слова должны предваряться escape-символом, который по умолчанию равен '#', но его можно менять функцией SetEsc(); Формат вывода процентов задается переменной ProgressFmt (как его правильно составить - см. Help Delphi по функции FormatFloat). По умолчанию формат равен '00.00', что означает, что выводится процент завершения с точностью до второго знака. Текущее значение параметра, характеризующего прогресс (см. переменную i в примере) задается функцией SetCurr. Если значение этого параметра меняется при каждой итерации на единицу, можно использовать функцию Inc (не системную, а принадлежащую классу TConsoleProgress). Функция SetCurr возвращает код нажатой клавиши, если пользователем была нажата клавиша, код которой определяется параметром WaitKeys. Это массив из кодов клавиш, нажатие которых необходимо отлавливать. Добавление в список дополнительных кодов клавиш осуществляется функцией AddWaitKey, удаление из списка - DelWaitKey. Пример использования (В КОНСОЛЬНОМ ПРИЛОЖЕНИИ!!!): program ConsoleProgress; {$AppType Console} uses SysUtils, Progress in 'Progress.pas'; const g = 10000000; var p: TConsoleProgress; i: Integer; begin p := TConsoleProgress.Create(0, g, 1, 'Минимум = #MIN, Максимум = #max, Позиция = #CURRENT, Прогресс = #ProGreSs%'); p.AddWaitKey($1B); for i := 0 to g do if p.SetCurr(i) <> 0 then WriteLn('Escape key is pressed!'); p.Free; end. *) unit Progress; interface uses Sysutils, Windows; const DEF_MAX_STR_LEN = 79; //Максимальное число символов в строке const W_Num = 7; //Общее число обрабатываемых команд const W: array [0..W_Num - 1] of String = ( 'MIN', 'MAX', 'CURRENT', 'PROGRESS', 'TIME', 'LEFTTIME', 'TOTALTIME'); type TConsoleProgress = class private LastTime: TDateTime; Current: Integer; //текущее значение Pause: TDateTime; //Пауза между отображением прогресса StartTime: TDateTime; //Время начала тестирования ProgressFmt: String; //Формат команды FormatFloat для вывода процентов ParamCount: Integer; //Сколько параметров в строке Text TextParts: array of String; //Кусочки Text ParamNums: array of Integer; //Номера команд в порядке появления WaitKeys: array of Word; //Коды клавиш, нажатие на которые заставит //функции SetCurr и Inc вернуть значение false; isForce: Boolean; //Форсировать вывод на экран не дожидаясь завершения интервала ожидания Con_Hnd: THandle; //Хэндл консольного окна CCI: TConsoleCursorInfo; //Информация о курсоре function StrToOEM(str: String): String; //Конвертор строк в OEM function KeyHook: Word; procedure CursorON; //Включение курсора procedure CursorOFF; //Выключение курсора public Esc: Char; //Escape-символ, с которого начинаются служебные слова Min, Max: Integer; //Минимальное и максимальное значения TimeFmt, LeftTimeFmt, TotalTimeFmt: String; //Форматы вывода времени работы и оставшегося времени MaxStrLength: Integer; //Максимальная длина строки вывода на экран ClearOnComplete: Boolean; //Очищать ли строку вывода при достижении 100% NewLineOnComplete: Boolean; //Ставить перевод строки при достижении 100% isKeyPressed: Boolean; //Была ли нажата в процессе работы хотя бы одна клавиша PercentDone: Real; //Процент выполнения процесса constructor Create; overload; //Конструктор без параметров (по умолчанию) constructor Create(Max: Integer; Text: String); overload; constructor Create(Min, Max: Integer; Pause: Real; Text: String); overload; procedure Init; //Инициализация, обнуление всех счетчиков procedure SetPause(Pause: Real); procedure SetText(Text: String); procedure AddWaitKey(KeyCode: Word); procedure DelWaitKey(KeyCode: Word); function Inc(Step: Integer): Word; function SetCurr(CurrentPos: Integer): Word; procedure ShowP; procedure ForceShow; //Форсировать вывод на экран end; implementation { TConsoleProgress } constructor TConsoleProgress.Create; begin Min := 0; Max := 0; Pause := EncodeTime(0, 0, 1, 0); Esc := '#'; SetText('Done #PROGRESS%'); ProgressFmt := '00.00'; TimeFmt := 'h:nn:ss'; LeftTimeFmt := 'h:nn:ss'; TotalTimeFmt := 'h:nn:ss'; LastTime := Now; MaxStrLength := DEF_MAX_STR_LEN; GetConsoleCursorInfo(Con_Hnd, CCI); Init; end; constructor TConsoleProgress.Create(Max: Integer; Text: String); begin Min := 0; Self.Max := Max; Pause := EncodeTime(0, 0, 1, 0); Esc := '#'; SetText(Text); ProgressFmt := '00.00'; TimeFmt := 'h:nn:ss'; LeftTimeFmt := 'h:nn:ss'; TotalTimeFmt := 'h:nn:ss'; LastTime := Now; MaxStrLength := DEF_MAX_STR_LEN; Init; end; constructor TConsoleProgress.Create(Min, Max: Integer; Pause: Real; Text: String); begin Self.Min := Min; Self.Max := Max; SetPause(Pause); Esc := '#'; SetText(Text); ProgressFmt := '00.00'; TimeFmt := 'h:nn:ss'; LeftTimeFmt := 'h:nn:ss'; TotalTimeFmt := 'h:nn:ss'; LastTime := Now; MaxStrLength := DEF_MAX_STR_LEN; Init; end; procedure TConsoleProgress.DelWaitKey(KeyCode: Word); var i, j: Integer; begin i := 0; while (i < Length(WaitKeys)) and (WaitKeys[i] <> KeyCode) do System.Inc(i); if i < Length(WaitKeys) then begin for j := i + 1 to Length(WaitKeys) - 1 do WaitKeys[j - 1] := WaitKeys[j]; SetLength(WaitKeys, Length(WaitKeys) - 1); end; end; function TConsoleProgress.Inc(Step: Integer): Word; begin System.Inc(Current, Step); ShowP; Result := KeyHook; end; procedure TConsoleProgress.Init; begin Current := Min; StartTime := Now; isKeyPressed := false; Con_Hnd := GetStdHandle(STD_OUTPUT_HANDLE); GetConsoleCursorInfo(Con_Hnd,CCI); CursorOFF; end; function TConsoleProgress.SetCurr(CurrentPos: Integer): Word; begin Current := CurrentPos; ShowP; Result := KeyHook; end; procedure TConsoleProgress.SetPause(Pause: Real); begin Self.Pause := Pause / 24 / 60 / 60; end; procedure TConsoleProgress.SetText(Text: String); var i, p: Integer; begin Text := StrToOEM(Text + Char($0D)); ParamCount := 0; SetLength(TextParts, 1); p := Pos(Esc, Text); if p = 0 then p := Length(Text) - 1; TextParts[0] := Copy(Text, 1, p - 1); while p <= Length(Text) do begin if Text[p] = Esc then begin i := 0; while (i < W_Num) and (UpperCase(Copy(Text, p + 1, Length(W[i]))) <> W[i]) do System.Inc(i); if i < W_Num then begin System.Inc(ParamCount); SetLength(TextParts, ParamCount + 1); SetLength(ParamNums, ParamCount); ParamNums[ParamCount - 1] := i; System.Inc(p, Length(W[i]) + 1); end; end; TextParts[ParamCount] := TextParts[ParamCount] + Text[p]; System.Inc(p); end; end; procedure TConsoleProgress.ShowP; var i: Integer; c: String; begin if ((Now - LastTime) < Pause) and (Current < Max) and not isForce then Exit; c := TextParts[0]; for i := 0 to ParamCount - 1 do begin case ParamNums[i] of 0: //Команда MIN c := c + IntToStr(Min); 1: //Команда MAX c := c + IntToStr(Max); 2: //Команда CURRENT c := c + IntToStr(Current); 3: //Команда PROGRESS begin PercentDone := (Current - Min) / (Max - Min) * 100; if (Max - Min) <> 0 then c := c + FormatFloat(ProgressFmt, PercentDone); end; 4: //Команда TIME c := c + FormatDateTime(TimeFmt, Now - StartTime); 5: //Команда LEFTTIME if (Current - Min) > 0 then c := c + FormatDateTime(LeftTimeFmt, (Now - StartTime) * (Max - Current) / (Current - Min)); 6: //Команда TOTALTIME if (Current - Min) > 0 then c := c + FormatDateTime(TotalTimeFmt, (Now - StartTime) * (Max - Min) / (Current - Min)); end; c := c + TextParts[i + 1]; end; if Length(c) > MaxStrLength then SetLength(c, MaxStrLength); Write(c); if (Current = Max) then begin if ClearOnComplete then begin Write(StringOfChar(' ', DEF_MAX_STR_LEN)); if not NewLineOnComplete then Write(Char($0D)); end; if NewLineOnComplete then WriteLn; CursorON; end; LastTime := Now; end; function TConsoleProgress.StrToOEM(str: String): String; begin Result := str; CharToOEM(PChar(Result), PChar(Result)); end; procedure TConsoleProgress.AddWaitKey(KeyCode: Word); begin SetLength(WaitKeys, Length(WaitKeys) + 1); WaitKeys[Length(WaitKeys) - 1] := KeyCode; end; function TConsoleProgress.KeyHook: Word; var i: Integer; ks: TKeyboardState; begin Result := 0; for i := 0 to Length(WaitKeys) - 1 do if (GetKeyState(WaitKeys[i]) and $80) = $80 then begin Result := WaitKeys[i]; ks[Result] := 0; SetKeyboardState(ks); isKeyPressed := true; Exit; end; end; procedure TConsoleProgress.ForceShow; begin isForce := true; ShowP; end; procedure TConsoleProgress.CursorOFF; begin CCI.bVisible := false; SetConsoleCursorInfo(Con_Hnd, CCI); end; procedure TConsoleProgress.CursorON; begin CCI.bVisible := true; SetConsoleCursorInfo(Con_Hnd, CCI); end; end. |
[001945]
