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

Question

我有一个用 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 的子类，因此某种全局方法是理想的，因此我可以将代码添加到基本表单中，并让它在所有下降表单上工作。

Answer 1

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

或者，您可以通过创建表单和后台代码都知道的中间对象，将代码与 MDI 表单分离。 您让它拥有对表单的引用，该引用在表单关闭时重置。 通过通过此中间对象路由对表单的所有访问，您可以防止异常。

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

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

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

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

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

Answer 2

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

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

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

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

Answer 3

以MDI形式引入私有字段，例如。 FProcessing

在数据库调用代码中执行：

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;

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

Answer 4

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

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

Answer 5

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