Если выполнение действия занимает продолжительное время, то желательно сообщать пользователю о том, как идут дела: какой процент действий выполнен и что именно делает сейчас программа. И в этом нам поможет универсальная функция отображения формы прогресса выполнения.

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, и я решил добавить в справочник разработчика удобный инструмент по их классификации, а также улучшению работы с модулями. Но об этом я расскажу в следующей статье.

Добавить комментарий

Ваш адрес email не будет опубликован. Обязательные поля помечены *