Советы по 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]




Начало  Назад  Вперед



Книжный магазин