n día tuve la loca idea de hacer un reemplazo completamente nuevo deTApplication para la experimentación. Tengo todo para compilar y ejecutar, y muestra el formulario principal correctamente, todo responde bien, pero al cerrar el formulario, la aplicación no se detiene. Estoy seguro de que copié todas las cosas necesarias de la aplicación original Forms.pas TA (registrando un evento cerrado) pero no veo que funcione. Tengo que terminar la sesión de depuración de la manera desagradable.

Mi objetivo en este pequeño experimento es crear una aplicación liviana para cosas muy simples en lugar de todas las cosas posibles que una aplicación TA puede manejar, y también principalmente para tener una buena experiencia en ese campo.

Aquí está la unidad tal como la tengo ahora, y a continuación se muestra su implementación.

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.

Y aquí hay una aplicación que usa esto:

program Win7FormTestD7;

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

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

El formulario 'W7Form1' es simplemente un formulario simple con un par de controles aleatorios para probar.

Los usuarios aquí no deberían hacer la pregunta de por qué quiero hacer esto, tengo mis razones. Aprendo haciendo, no por alguien que me muestra o leyendo algún libro o encontrando un montón de código que no sé cómo funciona. Esta es una manera de aprender mejor el funcionamiento de las aplicaciones y poder ampliar mi conocimiento en el campo para poder construir aplicaciones más complejas en el futuro.