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类。

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

因为所有表单都是Tbase的子类，所以这样做的一些全局方式是理想的，所以我可以将代码添加到基本表单中，并让它适用于所有后代表单。

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

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;

你应该检查整个应用终端。

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

Answer 5

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

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

5 个答案: