Updating a Gauge and Detecting a User Interrupt (Delphi)

Take the following steps to update a gauge during processing and detect a user interrupt:

1.

Start with the project that you created in Loading and Displaying an Image.

2.

image\btndbtn.gif Select the Button control; then add the control to your main form. Put the control at the top of the form to keep it away from the image.

3.

In the Object Inspector box, change the Button control's Caption property to Do Median.

4.

image\btndbtn.gif Select the Button control; then add another control to your main form. Put the control at the top of the form to keep it away from the image.

5.

In the Object Inspector box, change the Button control's Caption property to Quit.

6.

Build a gauge consisting of two rectangular shape objects (Shape1 and Shape2). Put the gauge at the top of the form next to the Quit button. Use Shape1 as the frame of the gauge. Use Shape2 as the fill color by putting it inside of Shape1, flush left. Change Shape2's brush color to any contrasting color, and change its Width property to 1.

7.

Add the following declarations to the private section of the Unit1 file:

fEscape: Boolean; {Used with the Gauge example}
fInProc: Boolean; {Used with the Gauge example}

8.

Code the Do Median button's Click procedure as follows:

procedure TForm1.Button1Click(Sender: TObject);

begin
{Enable the Status event}
Lead1.EnableProgressEvent := True;

{Initialize the indicators}
fEscape := False; {The user does not want to quit}
fInProc := True; {Processing is taking place}

{Perform a relatively slow median filter}
Lead1.Median(5);

{Clean up}
fInProc := False; {Processing is no longer taking place}
Lead1.ForceRepaint;
end;

9.

Code LEAD control's Status procedure as follows

procedure TForm1.Lead1Status(Sender: TObject;
  Percent: Integer);
var
WinMsg: TMsg; {Windows message}

begin
{Are there any messages in the queue (like a mouse click) ?}
while( PeekMessage(WinMsg,Handle, 0, 0, PM_REMOVE) ) do
begin
    TranslateMessage( WinMsg ); {Translates virtual key codes.}
    DispatchMessage( WinMsg ); {Dispatches message to window.}
end;

If fEscape = False Then { Look for the Click on the Quit button}
  Shape2.Width := round(Shape1.Width * Percent / 100) {Udpate the gauge}
Else
  Lead1.EnableProgressEvent := False; {Cancel the task}
end;

10.

Code the Quit button's Click procedure as follows:

procedure TForm1.Button2Click(Sender: TObject);
begin
fEscape := True; {The user wants to quit}
Shape2.Width := 1; {Set the gauge back to the beginning}
end;

11.

Code the main form's CloseQuery procedure as follows:

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
If fInProc Then {If processing is taking place}
  CanClose := False; {Do not let the user close the form}

end;

12.

Run your program to test it.