If the execution of an action takes a long time, then it is desirable to inform the user about how things are going: what percentage of the actions have been completed and what exactly the program is doing now. And the universal function of displaying the progress form will help us with this.
const
PROGRESS_FORM_WIDTH = 400;
PROGRESS_FORM_HEIGHT = 96;
PROGRESS_FORM_FRAME_COLOR = clBlack;
PROGRESS_IMAGE_SIZE = 80; // animated picture size
PROGRESS_IMAGE_FILENAME = IMAGES_DIR + 'progress.gif';
PROGRESS_FORM_CAPTION = 'Data processing';
var
ProgressForm:TForm;
procedure Progress(ACurrent: Integer = 0; AMax: Integer = 0; AHint: string = ''; ACancelButton:boolean = False);
// display the processing progress form
// ACurrent - current value;
// AMax - maximum value: if AMax = 0, then the indicator is not displayed, only an explanation
// AHint - explanation
// If called without parameters, the form will become invisible.
var
tmpImage:TdbImage;
tmpAppName: TdbLabel;
tmpStatus: TdbLabel;
tmpProgressBar: TProgressBar;
tmpShape: TShape;
tmpButton: TdbButton;
begin
if ProgressForm = nil then
begin
ProgressForm := TForm.Create(Application);
// form
with ProgressForm do
begin
Name := 'frmProgress';
Caption := PROGRESS_FORM_CAPTION;
Width := PROGRESS_FORM_WIDTH;
Height := PROGRESS_FORM_HEIGHT;
BorderStyle := bsNone;
DoubleBuffered := True;
end;
// frame
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;
// animated image
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;
// static text
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;
// progress indicator
tmpProgressBar := TProgressBar.Create(ProgressForm);
with tmpProgressBar do
begin
Name := 'prbIndicator';
Parent := ProgressForm;
Top := 48;
Left := PROGRESS_IMAGE_SIZE;
Height := 16;
Width := tmpAppName.Width;
end;
// explanation for the current action
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;
// interrupt button
tmpButton := TdbButton.Create(ProgressForm);
with tmpButton do
begin
Name := 'btnCancel';
Parent := ProgressForm;
Width := 120;
Height := 36;
Font.Size := 11;
Caption := 'Cancel';
Top := PROGRESS_FORM_HEIGHT;
Left := PROGRESS_FORM_WIDTH - Width - PROGRESS_BUTTON_MARGIN;
AssignEvents(tmpButton);
dbOnClick := 'Progress_Cancel_OnClick';
// image for button
Images_Set( tmpButton, DeleteSuffix(DeleteClassName(tmpButton.Name)), IMAGES_FORMAT_BUTTON, IMAGES_SIMPLE_MODEL );
end;
end;
// Find elements
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; // turn on animation
ProgressForm.Hide;
end
else
begin
TGIFImage(tmpImage.Picture.Graphic).Animate := True; // turn off animation
// Reset the interrupt flag every time the progress form appears.
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 + ' '; // the space is needed to properly display italic font
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)To display the progress form, just call the Progress() procedure with non-empty parameters:
- ACurrent – current progress value;
- AMax – maximum value: if AMax = 0, then the indicator is not displayed
- AHint – explanation displayed on the form
- ACancelButton – display a process interrupt button
To hide the progress form, you need to call the Progress() procedure with no parameters.
Lines 26 to 121 of the script check if the form to be displayed exists and create it if necessary. The form contains static text, an explanation, and a progress indicator – an instance of the TProgressBar class.
On the left side of the form is an animated image that is loaded from a GIF file, which brings the form to life.
The FindC() procedure finds a component by name on the form and places it in the specified variable.
procedure FindC(AForm: TForm; AName: string; var AComponent: TComponent; ACheck: boolean = True);
// search for a component on a form with control
begin
if AForm = nil then
RaiseException('FindC() - AForm = nil');
AComponent := AForm.FindComponent(AName);
if ACheck and (AComponent = nil) then
RaiseException('FindC() - Component not found: ' + AForm.Name + '.' + AName);
end;Code language: Delphi (delphi)The Form_Centered() procedure centers the form on the screen.
procedure Form_Centered(Sender: TObject);
// placing the form in the center of the screen
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)An example of using the Progress() procedure:
Progress(0,0,'Updating the list of projects');
tmpSQL := 'SELECT count(*) FROM project';
tmpMaxCount := SQLExecute(tmpSQL);
tmpCount := 0;
try
// checking existing records
tmpSQL := 'SELECT * FROM project';
SQLQuery(tmpSQL,tmpDataSet);
try
while not tmpDataSet.EOF do
begin
Progress(tmpCount,tmpMaxCount,'Checking folders');
if not DirectoryExists( tmpDataSet.FieldByName('path').asString ) then
begin
tmpSQL := 'UPDATE project SET status = "Path not found" 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)The form is rendered in accordance with the selected application style theme and fits perfectly into the overall design of the application.
If you use the parameter, the progress form will increase in height so that the processing interrupt button becomes available. When the button is clicked, the value of the global variable ProgressCancel is set to True. This can be used in round robin algorithms to abort early processing.
But to achieve the ideal, perhaps you need to add a function that will select a file for animation, depending on the selected style, so that the colors in the picture match the color of the form.
What else do you think a form of progress should be able to do?
I used this form in the Developer’s Handbook app, in the new project-related functionality. Over several years of working and reading the forum, I have accumulated a lot of applications created using My Visual Database, and I decided to add a convenient tool for classifying them, as well as improving working with modules, to the developer’s reference book. But I will talk about this in the next article.