如何优雅地退出在 Delphi 中执行代码的 MDI 表单答案

【问题标题】：How do I gracefully exit a MDI form that has code executing in Delphi如何优雅地退出在 Delphi 中执行代码的 MDI 表单
【发布时间】：2009-01-26 09:23:02
【问题描述】：

我有一个用 Delphi 2007 编写的 MDI 应用程序。

如果用户在执行代码时退出其中的表单，则会导致异常，因为代码正在尝试更新组件或使用已随表单释放的对象。

无论如何我可以判断代码是否在退出事件中执行，或者是否有处理这种情况的标准方法？

更新更多信息

异常通常发生在以下情况。

按下子 mdi 表单上的一个按钮，这会激活表单中的一个功能，该功能将转到数据库并检索数据，然后重新格式化并在表单上的可视组件中显示它（可用的 TListView)。

如果代码需要很长时间执行（比如有很多数据要处理）用户会失去兴趣并点击关闭按钮（代码的速度正在努力避免这种情况)。

即使它所属的表单已被释放，函数内部的代码仍在执行（代码在表单的私有部分中），现在当它尝试更新它们不再存在的可视化组件时（因为它们与表单一起释放）并引发异常。

当这种情况发生时，子表单中的代码可以在循环中使用，循环记录并相应地更新列表视图，循环包含看起来像这样的代码

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

其他代码示例

fromClose 事件如下所示

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

DoFormFree 是主 mdi 父窗体中的一个函数，看起来像这样

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

由于各种原因，所有表单都存储在一个列表中，并且所有子表单都扩展了 TBaseForm 类。

理想情况下，我想要一种方法来判断表单中的代码是否正在执行，并防止用户关闭表单，或者在代码完成之前隐藏它，因为在某些情况下它可能会生成报告并更新为异常发生时的状态面板，在这种情况下报告将不完整。

由于所有表单都是 TbaseFrom 的子类，因此某种全局方式这样做是理想的，因此我可以将代码添加到基本表单并使其适用于所有下降的表单。

【问题讨论】：

标签： delphi error-handling mdi

【解决方案1】：

您提供的信息不足，但想到的最简单的解决方案是在 OnCloseQuery 处理程序中测试代码是否正在执行，如果是，请将 CanClose 设置为 False。

另外，您可以通过创建表单和后台代码都知道的中间对象来将代码与 MDI 表单分离。你让它有一个对表单的引用，当表单关闭时它会被重置。通过此中间对象路由对表单的所有访问，您可以防止异常。

编辑：您需要提供有关在释放 MDI 表单后如何执行尝试访问 MDI 表单的代码的信息。有一些方法可以执行工作代码，例如：

在表单或另一个对象的方法中
在 OnTimer 事件处理程序中
在 Application 对象的 OnIdle 处理程序中
在后台线程中

请注意，在第一种情况下，只有在您自己在代码中执行此操作或调用 Application.ProcessMessages 时才能释放表单。如果没有关于您的代码外观的更多信息，没有人可以为您的问题提供具体答案。

编辑 2： 根据您添加的信息，似乎有问题的代码总是在表单的方法中执行。这很容易通过创建一个布尔成员来捕获，该成员在执行开始时设置为 True，在执行完成时设置为 False。现在您只需在基类中为 OnCloseQuery 添加一个处理程序，如果成员（例如 fExecuting）为 True，则将 CanClose 设置为 False。您可以静默禁止关闭，或显示信息框。我只是在状态栏中显示一个进度表或显示一些东西，以免在模态信息框中过多地打扰用户。

我肯定会做的是允许用户取消长时间运行的进程。因此，您还可以显示一个消息框，询问用户是否要取消操作并关闭。您仍然需要跳过关闭表单，但可以存储关闭请求，并在执行结束后处理它。

【讨论】：

谢谢，我还需要提供什么？

【解决方案2】：

每个表单都有一个 OnCloseQuery 事件。

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

您可以通过将 CanClose 设置为 False 来使用它来推迟关闭。

在处理完成之前，您需要决定是否要处理关闭。或者您可能会要求用户再次关闭。

【讨论】：

【解决方案3】：

在 MDI 表单中引入私有字段，例如。 F处理

在db调用代码中做：

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

在MDIForm.FormCloseQuery()中做

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;

您还应该检查整个应用程序的终止情况。

【讨论】：

【解决方案4】：

我创建了一个对象，它可以在不使用线程的情况下为您执行过程或方法。它使用一个计时器，但只公开一个简单的单行调用。它还支持 RTTI，因此您只需单击按钮即可：

ExecuteMethodProc(MyCode) 或者 ExecuteMethodName('MyCode');

问候，布赖恩

// 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
//-----------------------------------------------------------------------------

【讨论】：

【解决方案5】：

如果用户因为操作时间太长而想放弃，他们为什么不让他们呢？稍微修改您的代码以检查（就在 application.process 消息是一个好地方之前）“想要退出”变量，当它是真的然后从你的循环中退出，释放你的对象并取消。然后将其包装在 dmajkic 之前建议的内容中。

【讨论】：