How do I gracefully exit a MDI form that has code executing in Delphi

Question

I have a MDI application written in Delphi 2007.

If the user exits a form within it whilst code is executing it causes an exception, because the code is trying to update a component or use an object that has been freed with the form.

Is there anyway I can tell if code is executing in the exit event or is there a standard way to deal with this situation?

Update with more infomation

The exception usually happen in the following circumstance.

A button on the child mdi form is pressed, this activates a function in the form, the function will go to the database and retrieve data, it will then re-format it and display it in a visual component on the form (usable a TListView).

If the code is taking a long time to execute (say if there is a lot of data to process) the user will lose interest and click the close button (the speed of the code is been worked on to try to avoid this).

The code inside the function is still executing even though the form it belongs to has been freed (The code is in the private section of the form), now when it trys to update the visual components they no longer exist (as they were freed with the form) and it throws a exception.

The code in the child form is usably in a loop when this happen, cycling records and update the listview accordingly, the loops contain code that looks like so

inc(i);
if (i mod 25) = 0 then
begin
    StatusPnl.Caption := 'Loading ' + intToStr(i) + ', Please wait';
    application.ProcessMessages;
end;

Other Code samples

the fromClose event looks like so

//Snip
if (Not (Owner = nil)) then
with (Owner as  IMainForm)do
begin
    //Snip
    DoFormFree(Self,Self.Name);
end
else
//Snip

DoFormFree is a function in the main mdi parent form and looks like so

//Snip
(G_FormList.Objects[x] as TBaseForm).Release;
G_FormList.Objects[i] := nil;
G_FormList.Delete(i);
//Snip

All forms are stored in a list, as for various reasons, and all child forms extend the TBaseForm class.

Ideally I would like a way to tell if code in a form is executing, and prevent the user from closing the form, or hide it until the code is finished, as in some instances it may be generating a report and update as status panel when the exception happen, in that case the report will be incomplete.

as all forms are sub classes of TbaseFrom some global way of doing this would be ideal, so I can add the code to the base form and have it work on all descended forms.

Answer 1

Each form has a OnCloseQuery event.

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

You can use this to postpone close by setting CanClose to False.

You need to decide if you want to handle the close until processing has finished. Or you might require the user to close again.

Answer 2

You provide not enough information, but the easiest solution that comes to mind is to test in the OnCloseQuery handler whether code is executing, and if so set CanClose to False.

Alternatively you can decouple the code from the MDI form, by creating an intermediate object that both the form and the background code know about. You let this have a reference to the form, which is reset when the form is closed. By routing all access to the form through this intermediate object you can prevent the exceptions.

Edit: You need to provide information on how you execute the code that tries to access the MDI form after it has been freed. There are some ways to execute worker code, like:

• in a method of the form or of another object
• in a OnTimer event handler
• in the OnIdle handler of the Application object
• in a background thread

Note that in the first case the form could only be freed if you either do it yourself in code, or if you call Application.ProcessMessages. Without more information about what your code looks like, nobody can give you a specific answer to your question.

Edit 2: With your added information it seems that the code in question is always executed in methods of the form. This is easy to catch by creating a boolean member that is set to True when the execution starts, and that is set to False when the execution has finished. Now you only need to add a handler for OnCloseQuery in your base class, and set CanClose to False if the member (fExecuting for example) is True. You can silently forbid closing, or show an information box. I'd simply show a progress form or display something in the status bar, so as not to interrupt the user too much with modal info boxes.

What I would definitely do is allowing the user to cancel the long running process. So you could also show a message box asking the user whether they want to cancel the operation and close. You still need to skip the closing of the form then, but can store the request to close, and process it once the execution has ended.

Answer 3

Introduce private field in MDI form eg. FProcessing

in db call code do:

FProcessing := true;
try
  i := 0;  
  if (i mod 25) = 0 then
  begin
    // do your code 
    Application.ProcessMessages; 
  end;
finally
  FProcessing := false; 
end;

in MDIForm.FormCloseQuery() do

procedure TMDIForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if FProcesing then 
    CanClose := False;  
   // or you can ask user to stop fetching db data
end;

You should aslo check whole app terminaation.

Answer 4

I created an object that can execute a procedure or method for you without using a thread. It uses a timer but only exposes a simple one line call. It also supports RTTI so you can simply put in a button click either:

ExecuteMethodProc( MyCode ) or ExecuteMethodName( 'MyCode' );

Regards, Brian

// Method execution
//-----------------------------------------------------------------------------

type
  TArtMethodExecuter = class( TObject )
    constructor Create;
    destructor  Destroy; override;
  PRIVATE

    FMethod           : TProcedureOfObject;
    FTimer            : TTimer;
    FBusy             : boolean;
    FFreeAfterExecute : boolean;
    FHandleExceptions : boolean;

    procedure DoOnTimer( Sender : TObject );
    procedure SetBusy( AState : boolean );

  PUBLIC
    procedure ExecuteMethodProc(
                AMethod       : TProcedureOfObject;
                AWait         : boolean = False );

    procedure ExecuteMethodName(
                AMethodObject : TObject;
          const AMethodName   : string;
                AWait         : boolean = False );

    property  FreeAfterExecute : boolean
                read FFreeAFterExecute
                write FFreeAfterExecute;

    property  HandleExceptions : boolean
                read FHandleExceptions
                write FHandleExceptions;

    property  Busy : boolean
                read FBusy;

  end;





procedure ExecuteMethodName(
            AMethodObject : TObject;
     const  AMethodName    : string;
            AHandleExceptions : boolean = True );
// Executes this method of this object in the context of the application.
// Returns immediately, with the method executing shortly.

procedure ExecuteMethodProc(
            AMethodProc : TProcedureOfObject;
            AHandleExceptions : boolean = True );
// Executes this method of this object in the context of the application.
// Returns immediately, with the method executing shortly.

function  IsExecutingMethod : boolean;
// Returns TRUE if we are already executing a method.


// End method execution
//-----------------------------------------------------------------------------




// Method execution
//-----------------------------------------------------------------------------


{ TArtMethodExecuter }

var
  iMethodsExecutingCount : integer = 0;

const
  wm_ExecuteMethod = wm_User;

constructor TArtMethodExecuter.Create;
begin
  Inherited;
end;

destructor TArtMethodExecuter.Destroy;
begin
  FreeAndNil( FTimer );
  Inherited;
end;

procedure TArtMethodExecuter.DoOnTimer( Sender : TObject );

  procedure RunMethod;
  begin
    try
      FMethod
    except
      on E:Exception do
        ArtShowMessage( E.Message );
    end
  end;

begin
  FreeAndNil(FTimer);
  try
    If Assigned( FMethod ) then
      RunMethod
     else
      Raise EArtLibrary.Create(
        'Cannot execute method - no method defined.' );
  finally
    SetBusy( False );
    If FFreeAfterExecute then
      Free;
  end;
end;



procedure TArtMethodExecuter.SetBusy(AState: boolean);
begin
  FBusy := AState;

  If AState then
    Inc( iMethodsExecutingCount )
   else
    If iMethodsExecutingCount > 0 then
      Dec( iMethodsExecutingCount )
end;



procedure TArtMethodExecuter.ExecuteMethodProc(
          AMethod       : TProcedureOfObject;
          AWait         : boolean = False );
begin
  SetBusy( True );
  FMethod         := AMethod;
  FTimer          := TTimer.Create( nil );
  FTimer.OnTimer  := DoOnTimer;
  FTimer.Interval := 1;
  If AWait then
    While FBusy do
      begin
      Sleep( 100 );
      Application.ProcessMessages;
      end;
end;



procedure TArtMethodExecuter.ExecuteMethodName(AMethodObject: TObject;
  const AMethodName: string; AWait: boolean);
var
  RunMethod : TMethod;
begin
  RunMethod.code := AMethodObject.MethodAddress( AMethodName );
  If not Assigned( RunMethod.Code ) then
    Raise EArtLibrary.CreateFmt(
      'Cannot find method name "%s". Check that it is defined and published.', [AMethodName] );

  RunMethod.Data := AMethodObject;
  If not Assigned( RunMethod.Data ) then
    Raise EArtLibrary.CreateFmt(
      'Method object associated with method name "%s" is not defined.', [AMethodName] );

  ExecuteMethodProc(
    TProcedureOfObject( RunMethod ),
    AWait );
end;


procedure ExecuteMethodName(
            AMethodObject : TObject;
      const AMethodName   : string;
            AHandleExceptions : boolean = True );
// Executes this method of this object in the context of the application.
// Returns immediately, with the method executing shortly.
var
  ME : TArtMethodExecuter;
begin
  If IsExecutingMethod then
    If AHandleExceptions then
      begin
      ArtShowMessage( 'A method is already executing.' );
      Exit;
      end
     else
      Raise EArtLibrary.Create( 'A method is already executing.' );

  ME := TArtMethodExecuter.Create;
  ME.FreeAfterExecute := True;
  ME.HandleExceptions := AHandleExceptions;
  ME.ExecuteMethodName( AMethodObject, AMethodName );
end;


procedure ExecuteMethodProc(
            AMethodProc : TProcedureOfObject;
            AHandleExceptions : boolean = True );
// Executes this method of this object in the context of the application.
// Returns immediately, with the method executing shortly.
var
  ME : TArtMethodExecuter;
begin
  If IsExecutingMethod then
    If AHandleExceptions then
      begin
      ArtShowMessage( 'A method is already executing.' );
      Exit;
      end
     else
      Raise EArtLibrary.Create( 'A method is already executing.' );

  ME := TArtMethodExecuter.Create;
  ME.FreeAfterExecute := True;
  ME.HandleExceptions := AHandleExceptions;
  ME.ExecuteMethodProc( AMethodProc );
end;

function  IsExecutingMethod : boolean;
// Returns TRUE if we are already executing a method.
begin
  Result := iMethodsExecutingCount > 0;
end;

// End Method execution
//-----------------------------------------------------------------------------

Answer 5

If the user wants to give up because the operation is taking so long, they why not allow them too? Modify your code slightly to check (right before the application.process messages is a good place) a "wants to quit" variable, and when it is true then to bail from your loop, free up your objects and cancel. Then wrap this in what dmajkic suggested earlier.