Если выполнение действия занимает продолжительное время, то желательно сообщать пользователю о том, как идут дела: какой процент действий выполнен и что именно делает сейчас программа. И в этом нам поможет универсальная функция отображения формы прогресса выполнения.
const
PROGRESS_FORM_WIDTH = 400;
PROGRESS_FORM_HEIGHT = 96;
PROGRESS_FORM_FRAME_COLOR = clBlack;
PROGRESS_IMAGE_SIZE = 80; // размер анимированной картинки
PROGRESS_IMAGE_FILENAME = IMAGES_DIR + 'progress.gif';
PROGRESS_FORM_CAPTION = 'Обработка данных';
var
ProgressForm:TForm; // форма прогресса
procedure Progress(ACurrent: Integer = 0; AMax: Integer = 0; AHint: string = ''; ACancelButton:boolean = False);
// отображение формы прогресса обработки
// ACurrent - текущее значение;
// AMax - максимальное значение: если AMax = 0, то индикатор не отображается, только пояснение
// AHint - пояснение
// Если вызвать без параметров, то форма станет невидимой.
var
tmpImage:TdbImage;
tmpAppName: TdbLabel;
tmpStatus: TdbLabel;
tmpProgressBar: TProgressBar;
tmpShape: TShape;
tmpButton: TdbButton;
begin
if ProgressForm = nil then
begin
ProgressForm := TForm.Create(Application);
// форма
with ProgressForm do
begin
Name := 'frmProgress';
Caption := PROGRESS_FORM_CAPTION;
Width := PROGRESS_FORM_WIDTH;
Height := PROGRESS_FORM_HEIGHT;
BorderStyle := bsNone;
DoubleBuffered := True;
end;
// рамка
tmpShape := TShape.Create(ProgressForm);
with tmpShape do
begin
Name := T_SHAPE+'Border';
Parent := ProgressForm;
Align := alClient;
Pen.Color := PROGRESS_FORM_FRAME_COLOR;
Brush.Style := bsClear;
end;
// анимированное изображение
tmpImage := TdbImage.Create(ProgressForm);
with tmpImage do
begin
Name := T_IMAGE+'GIFAnimation';
Parent := ProgressForm;
Left := 0;
Top := 8;
Width := PROGRESS_IMAGE_SIZE;
Height := PROGRESS_IMAGE_SIZE;
Transparent := True;
Picture.LoadFromFile( ExtractFilePath(Application.ExeName)+PROGRESS_IMAGE_FILENAME);
// TGIFImage(Picture.Graphic).AnimationSpeed:= 500;// регулировка скорости
end;
// статическая надпись
tmpAppName := TdbLabel.Create(ProgressForm);
with tmpAppName do
begin
Name := T_LABEL+'AppName';
Parent := ProgressForm;
Autosize := False;
Top := 0;
Left := PROGRESS_IMAGE_SIZE;
Height := 48;
Width := PROGRESS_FORM_WIDTH - PROGRESS_IMAGE_SIZE - 8;
LayOut := tlCenter;
Alignment := taCenter;
Caption := PROGRESS_FORM_CAPTION;
Font.Size := 16;
end;
// индикатор прогресса
tmpProgressBar := TProgressBar.Create(ProgressForm);
with tmpProgressBar do
begin
Name := 'prbIndicator';
Parent := ProgressForm;
Top := 48;
Left := PROGRESS_IMAGE_SIZE;
Height := 16;
Width := tmpAppName.Width;
end;
// пояснение к текущему действию
tmpStatus := TdbLabel.Create(ProgressForm);
with tmpStatus do
begin
Name := T_LABEL+'Status';
Parent := ProgressForm;
Autosize := False;
Top := 64;
Left := PROGRESS_IMAGE_SIZE;
Height := 32;
Width := tmpAppName.Width;
LayOut := tlCenter;
Alignment := taRightJustify;
Caption := '';
Font.Size := 11;
Font.Style := fsItalic;
end;
// кнопка прерывания
tmpButton := TdbButton.Create(ProgressForm);
with tmpButton do
begin
Name := 'btnCancel';
Parent := ProgressForm;
Width := 120;
Height := 36;
Font.Size := 11;
Caption := 'Прервать';
Top := PROGRESS_FORM_HEIGHT;
Left := PROGRESS_FORM_WIDTH - Width - PROGRESS_BUTTON_MARGIN;
AssignEvents(tmpButton);
dbOnClick := 'Progress_Cancel_OnClick';
// картинка на кнопку
Images_Set( tmpButton, DeleteSuffix(DeleteClassName(tmpButton.Name)), IMAGES_FORMAT_BUTTON, IMAGES_SIMPLE_MODEL );
end;
end;
// Находим элементы
FindC(ProgressForm,T_IMAGE+'GIFAnimation',tmpImage);
FindC(ProgressForm,T_LABEL+'AppName',tmpAppName);
FindC(ProgressForm,'prbIndicator',tmpProgressBar);
FindC(ProgressForm,T_LABEL+'Status',tmpStatus);
FindC(ProgressForm,'btnCancel',tmpButton);
//
if (ACurrent = 0) and (AMax = 0) and (AHint = '') then
begin
TGIFImage(tmpImage.Picture.Graphic).Animate := False; // выключить анимацию
ProgressForm.Hide;
end
else
begin
TGIFImage(tmpImage.Picture.Graphic).Animate := True; // выключить анимацию
// При каждом появлении формы прогрсса сбрасывать флаг прерывания
if not ProgressForm.Visible then
begin
if ACancelButton then
begin
ProgressCancel := False;
ProgressForm.Height := tmpButton.Top + tmpButton.Height + PROGRESS_BUTTON_MARGIN;
end
else
begin
ProgressForm.Height := PROGRESS_FORM_HEIGHT;
end;
end;
ProgressForm.Show; // отобразить форму
Form_Centered(ProgressForm); // центрировать
tmpStatus.Caption := AHint + ' '; // пробел нужен, чтобы нормально отображался наклонный шрифт
if AMax = 0 then
begin
tmpProgressBar.Visible := False;
end
else
begin
tmpProgressBar.Visible := True;
tmpProgressBar.Max := AMax;
tmpProgressBar.Position := ACurrent;
end;
Application.ProcessMessages;
end;
end;
procedure Progress_Cancel_OnClick( Sender: TObject; var Cancel: boolean);
begin
ProgressCancel := True;
end;
Code language: Delphi (delphi)
Для отображения формы прогресса достаточно вызвать процедуру Progress() с непустыми параметрами:
- ACurrent – текущее значение прогресса выполнения;
- AMax – максимальное значение: если AMax = 0, то индикатор не отображается
- AHint – пояснение, отображаемое на форме
- ACancelButton – отобразить кнопку прерывания процесса обработки
Для того, чтобы скрыть форму прогресса, необходимо вызвать процедуру Progress() без параметров.
Строки скрипта с 26 по 121 проверяют, существует ли отображаемая форма и при необходимости создают её. На форме находится статический текст, пояснение, а также индикатор прогресса – экземпляр класса TProgressBar.
В левой части формы находится анимированное изображение, которое загружается из файла в формате GIF, что оживляет форму даже в том случае, если индикатор прогресса отсутствует или движется очень медленно.
Процедура FindC() находит на форме компонент по имени и помещает в заданную переменную.
procedure FindC(AForm: TForm; AName: string; var AComponent: TComponent; ACheck: boolean = True);
// поиск компонента на форме с контролем
begin
if AForm = nil then
RaiseException('FindC() - AForm = nil');
AComponent := AForm.FindComponent(AName);
if ACheck and (AComponent = nil) then
RaiseException('FindC() - Не найден компонент ' + AForm.Name + '.' + AName);
end;
Code language: Delphi (delphi)
Процедура Form_Centered() центрирует форму на экране.
procedure Form_Centered(Sender: TObject);
// размещение формы по центру экрана
var
tmpForm: TAForm;
begin
tmpForm := TAForm(Sender);
tmpForm.Left := (Screen.Width - tmpForm.Width) div 2;
tmpForm.Top := (Screen.Height - tmpForm.Height) div 2;
end;
Code language: JavaScript (javascript)
Пример использования процедуры Progress():
Progress(0,0,'Обновление списка проектов');
tmpSQL := 'SELECT count(*) FROM project';
tmpMaxCount := SQLExecute(tmpSQL);
tmpCount := 0;
try
// проверка имеющихся записей
tmpSQL := 'SELECT * FROM project';
SQLQuery(tmpSQL,tmpDataSet);
try
while not tmpDataSet.EOF do
begin
Progress(tmpCount,tmpMaxCount,'Проверка папок');
if not DirectoryExists( tmpDataSet.FieldByName('path').asString ) then
begin
tmpSQL := 'UPDATE project SET status = "Путь не найден" WHERE id = '+tmpDataSet.FieldByName('id').asString;
SQLExecute(tmpSQL);
end;
tmpDataSet.Next;
inc(tmpCount);
end;
finally
tmpDataSet.Free;
end;
finally
Progress();
end;
Code language: Delphi (delphi)
Форма отображается в соответствии с выбранной темой стиля приложения и отлично вписывается в общий дизайн приложения.

Если использовать параметр , то форма прогресса увеличится по высоте, чтобы кнопка прерывания обработки стала доступной. При нажатии кнопки значение глобальной переменной ProgressCancel устанавливается в True. Это можно использовать в циклических алгоритмах для досрочного прерывания обработки.

Но для достижения идеала, пожалуй, нужно добавить функцию, которая будет выбирать файл для анимации в зависимости от выбранного стиля так, чтобы цвета на картинке сочетались с цветом формы.
А что, по вашему мнению, ещё должна уметь делать форма прогресса?
Эту форму я использовал в приложении “Справочник разработчика”, в новом функционале, связанном с проектами. За несколько лет работы и чтения форума у меня накопилась масса приложений, созданных с помощью My Visual Database, и я решил добавить в справочник разработчика удобный инструмент по их классификации, а также улучшению работы с модулями. Но об этом я расскажу в следующей статье.