Creating replacement TApplication for experimentation?

Question

I got the crazy idea one day to make a completely new replacement of TApplication for experimentation. I got everything to compile and run, and it does show the main form properly, everything responds good, but upon closing the form, the application does not halt. I'm sure I copied all the necessary stuff from the original Forms.pas TApplication (registering close event) but I don't see it working. I have to terminate the debug session the nasty way.

My goal in this little experiment is to build a lightweight application for very simple things instead of all the possible things a TApplication can handle, and also mostly so I have some good experience in such a field.

Here's the unit as I have it now, and below is the implementation of it.

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.

And here's an application using this:

program Win7FormTestD7;

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

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

The form 'W7Form1' is just a plain form with a couple random controls on it to test with.

Users here should not ask the question of why I want to do this, I have my reasons. I learn by doing, not by someone showing me or by reading some book or finding a bunch of code which I don't know how it works. This is a way for me to better learn the workings of applications and be able to expand my knowledge in the field to be able to build more complex applications in the future.

Answer 1

Keep in mind that TCustomForm has no concept of your TJDApplication class, it only works with the Forms.TApplication class instead. Make sure your TJDApplication.Run() method is exiting when the Forms.TApplication.Terminated property has been set to True.