Delphi 创建用于实验的替代应用程序?

Delphi 创建用于实验的替代应用程序?,delphi,delphi-7,Delphi,Delphi 7,有一天,我有了一个疯狂的想法,要做一个全新的TApplication替代品来进行实验。我已经编译并运行了所有内容,它确实正确地显示了主窗体,所有内容都响应良好,但是在关闭窗体后,应用程序并没有停止。我确信我从原始Forms.pas应用程序(注册关闭事件)中复制了所有必要的内容,但我认为它不起作用。我必须以令人讨厌的方式终止调试会话 我在这个小实验中的目标是为非常简单的事情构建一个轻量级的应用程序,而不是一个TApplication可以处理的所有可能的事情,因此我在这个领域有一些很好的经验 这是我

有一天,我有了一个疯狂的想法,要做一个全新的
TApplication
替代品来进行实验。我已经编译并运行了所有内容,它确实正确地显示了主窗体,所有内容都响应良好,但是在关闭窗体后,应用程序并没有停止。我确信我从原始Forms.pas应用程序(注册关闭事件)中复制了所有必要的内容,但我认为它不起作用。我必须以令人讨厌的方式终止调试会话

我在这个小实验中的目标是为非常简单的事情构建一个轻量级的应用程序,而不是一个TApplication可以处理的所有可能的事情,因此我在这个领域有一些很好的经验

这是我现在拥有的单元,下面是它的实现

unit JDForms;

interface

uses
  Forms, Classes, SysUtils, StrUtils, Windows, Win7, XPMan, Variants,
  Messages, Dialogs;

type
  TJDForm = class;
  TJDApplication = class; 
  TJDApplicationThread = class;

  TJDForm = class(TCustomForm)
  private

  public

  published

  end;

  TJDApplication = class(TComponent)
  private
    fRunning: Bool;
    fTerminated: Bool;
    fThread: TJDApplicationThread;
    fMainForm: TJDForm;
    fOnMessage: TMessageEvent;
    fShowMainForm: Bool;
    fHandle: HWND;
    procedure ThreadTerminated(Sender: TObject);
    procedure HandleMessage;
    procedure ProcessMessages;
    function ProcessMessage(var Msg: TMsg): Boolean;
    procedure ThreadSync(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    property Thread: TJDApplicationThread read fThread;
    procedure Initialize;
    procedure Run;
    procedure CreateForm(InstanceClass: TComponentClass; var Reference);
    procedure Terminate;
    property Terminated: Bool read fTerminated;
    procedure HandleException(Sender: TObject);
    property Handle: HWND read fHandle;
  published
    property ShowMainForm: Bool read fShowMainForm write fShowMainForm;
    property OnMessage: TMessageEvent read fOnMessage write fOnMessage;
  end;

  TJDApplicationThread = class(TThread)
  private
    fOwner: TJDApplication;
    fStop: Bool;
    fOnSync: TNotifyEvent;
    procedure DoSync;
  protected
    procedure Execute; override;
  public
    constructor Create(AOwner: TJDApplication);
    destructor Destroy; override;
    procedure Start;
    procedure Stop;
  published
    property OnSync: TNotifyEvent read fOnSync write fOnSync;
  end;

var
  JDApplication: TJDApplication;

implementation

procedure DoneApplication;
begin
  with JDApplication do begin
    if Handle <> 0 then ShowOwnedPopups(Handle, False);
    //ShowHint := False;
    Destroying;
    DestroyComponents;
  end;
end;

{ TJDApplication }

constructor TJDApplication.Create(AOwner: TComponent);
begin                                    
  fRunning:= False;
  fTerminated:= False;
  fMainForm:= nil;
  fThread:= TJDApplicationThread.Create(Self);
  fThread.FreeOnTerminate:= True;
  fThread.OnTerminate:= ThreadTerminated;
  fShowMainForm:= True;
end;

procedure TJDApplication.CreateForm(InstanceClass: TComponentClass; var Reference);
var
  Instance: TComponent;
begin
  Instance:= TComponent(InstanceClass.NewInstance);
  TComponent(Reference) := Instance;
  try
    Instance.Create(Self);
  except
    TComponent(Reference):= nil;
    raise;
  end;
  if (fMainForm = nil) and (Instance is TForm) then begin
    TForm(Instance).HandleNeeded;
    fMainForm:= TJDForm(Instance);

  end;
end;

procedure TJDApplication.HandleException(Sender: TObject);
begin
  {
  if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
  if ExceptObject is Exception then
  begin
    if not (ExceptObject is EAbort) then
      if Assigned(FOnException) then
        FOnException(Sender, Exception(ExceptObject))
      else
        ShowException(Exception(ExceptObject));
  end else
    SysUtils.ShowException(ExceptObject, ExceptAddr);
  }
end;

procedure TJDApplication.HandleMessage;
var
  Msg: TMsg;
begin
  if not ProcessMessage(Msg) then begin
    //Idle(Msg);
  end;
end;

function TJDApplication.ProcessMessage(var Msg: TMsg): Boolean;
var
  Handled: Boolean;
begin
  Result := False;
  if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
  begin
    Result := True;
    if Msg.Message <> WM_QUIT then begin
      Handled := False;
      if Assigned(FOnMessage) then FOnMessage(Msg, Handled);
      //if not IsHintMsg(Msg) and not Handled and not IsMDIMsg(Msg) and
        //not IsKeyMsg(Msg) and not IsDlgMsg(Msg) then
      begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
    end else begin
      fTerminated:= True;
    end;
  end;
end;

procedure TJDApplication.ProcessMessages;
var
  Msg: TMsg;
begin
  while ProcessMessage(Msg) do {loop};
end;

procedure TJDApplication.Initialize;
begin
  if InitProc <> nil then TProcedure(InitProc);
end;

procedure TJDApplication.Run;
begin  {
  fRunning := True;
  try
    AddExitProc(DoneApplication);
    if FMainForm <> nil then
    begin
      case CmdShow of
        SW_SHOWMINNOACTIVE: FMainForm.FWindowState := wsMinimized;
        SW_SHOWMAXIMIZED: MainForm.WindowState := wsMaximized;
      end;
      if FShowMainForm then
        if FMainForm.FWindowState = wsMinimized then
          Minimize else
          FMainForm.Visible := True;
      repeat
        try
          HandleMessage;
        except
          HandleException(Self);
        end;
      until Terminated;
    end;
  finally
    FRunning := False;
  end;
        }



  fRunning:= True;
  try
    AddExitProc(DoneApplication);
    if fMainForm <> nil then begin
      fHandle:= fMainForm.Handle;
      if fShowMainForm then begin
        fMainForm.Show;
      end;    
      fThread.Start;
      repeat
        try
          HandleMessage;
          //--- THREAD HANDLING MESSAGES ---

        except
          HandleException(Self);
        end;
      until fTerminated;
    end else begin
      //Main form is nil - can not run
    end;
  finally
    fRunning:= False;
    fTerminated:= True;
  end;
end;

procedure TJDApplication.Terminate;
begin
  fTerminated:= True;
  try
    fThread.Stop;
  except

  end;     
  if CallTerminateProcs then PostQuitMessage(0);
end;

procedure TJDApplication.ThreadTerminated(Sender: TObject);
begin
  //Free objects

end;

procedure TJDApplication.ThreadSync(Sender: TObject);
var
  Msg: TMsg;
begin
  if not ProcessMessage(Msg) then begin
    //Idle(Msg);
  end;
end;

{ TJDApplicationThread }

constructor TJDApplicationThread.Create(AOwner: TJDApplication);
begin
  inherited Create(True);
  fOwner:= AOwner;
end;

destructor TJDApplicationThread.Destroy;
begin

  inherited;
end;

procedure TJDApplicationThread.DoSync;
begin
  Self.fOwner.ThreadSync(Self);
//  if assigned(fOnSync) then fOnSync(Self);
end;

procedure TJDApplicationThread.Execute;
var
  ST: Integer;
begin
  ST:= 5;
  fStop:= False;
  while (not Terminated) and (not fStop) do begin
    //----- BEGIN -----

    Synchronize(DoSync);

    //-----  END  -----
    //Sleep(1000 * ST);
  end;
end;

procedure TJDApplicationThread.Start;
begin
  fStop:= False;
  Resume;
end;

procedure TJDApplicationThread.Stop;
begin
  fStop:= True;
  Suspend;
end;

initialization
  JDApplication:= TJDApplication.Create(nil);

finalization
  if assigned(JDApplication) then begin

    JDApplication.Free;
    JDApplication:= nil;
  end;

end.
表单“W7Form1”只是一个普通表单,上面有几个随机控件可供测试


这里的用户不应该问我为什么要这样做,我有我的理由。我是通过实践来学习的,而不是通过别人给我看,或者通过阅读一些书或者找到一堆我不知道它是如何工作的代码。这对我来说是一种更好地了解应用程序工作原理的方法,可以扩展我在该领域的知识,以便将来能够构建更复杂的应用程序。

请记住,
TCustomForm
没有您的
TJDApplication
类的概念,它只适用于
窗体。t应用程序
类。当
Forms.TApplication.Terminated
属性设置为True时,请确保您的
TJDApplication.Run()
方法正在退出。

如果构建轻量级应用程序是您的座右铭,我建议您使用:

  • 保罗·托斯
  • 基于SO成员的VCL灯光代码

这似乎毫无意义,行不通。你为什么不使用TApplication?那确实管用。我能有机会跳出框框思考一下吗?我不需要有你喜欢的理由来提问。我的问题非常清楚和切中要害,对你来说可能没有意义,但对我来说是有意义的。我不想改进任何东西,我想通过做更多的事情来学习更多,这个项目帮助我更好地理解应用程序如何在内部工作。我在实践中学习。如果你曾经让表单成为自我负责的窗口,也就是说,没有主表单,没有表单可以一起拖动以激活/最小化等,我可能会开始使用你的应用程序。我不知道你是否需要我的建议,但是尝试将Windows UI元素放在单独的线程中会带来很多痛苦,但没有任何好处。我已经开始从TWinControl构建一个自定义表单,它完全基于TWinControl,没有Windows边框或标题,所有表单都是自定义绘制和处理的。将添加对TJDApplication的考虑,如果它是主要形式,则结束应用程序。
program Win7FormTestD7;

uses
  Forms,
  W7Form1 in 'W7Form1.pas' {Win7Form1},
  JDForms in 'JDForms.pas';

begin
  JDApplication.Initialize;
  JDApplication.CreateForm(TWin7Form1, Win7Form1);
  JDApplication.Run;
end.