実験のための交換TApplicationの作成？

Question

私はいつか実験のためにTApplicationの完全に新しい置き換えを作るために狂った考えを得た。私はコンパイルして実行するためのすべてを持って、それは正常にメインフォームを表示し、すべてが良好に応答しますが、フォームを閉じると、アプリケーションは停止しません。私は元のForms.pas TApplication（閉じるイベントを登録する）から必要なものをすべてコピーしたと確信していますが、うまく動作していません。私は厄介な方法でデバッグセッションを終了する必要があります。

この小さな実験で私の目標は、TApplicationが処理できるすべてのものではなく、非常に単純なものの軽量アプリケーションを構築することです。

ここに私が今持っているユニットがあります。以下はその実装です。

program Win7FormTestD7; 

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

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

フォームのW7Form1は 'でテストすることで夫婦のランダムなコントロールを持つ単なるフォームです：

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. 

そして、ここではこれを使用するアプリケーションです。

ここにいるユーザーは、なぜ私がこれをしたいのかという質問をするべきではありません、私は理由があります。私は、誰かが私を見せたり、本を読んだり、コードがわかりません。これは、アプリケーションの動作をよりよく理解し、将来的にはより複雑なアプリケーションを構築できるように、私の知識を現場で拡大できる方法です。

Answer 1

TCustomFormには、TJDApplicationクラスの概念がないため、代わりにForms.TApplicationクラスでのみ動作します。 Forms.TApplication.TerminatedプロパティがTrueに設定されている場合、TJDApplication.Run()メソッドが終了していることを確認してください。

Answer 2

軽量なアプリケーションを構築することは、あなたのモットーであるならば、私はあなたがで遊ぶことをお勧め者：VCLライトコードに基づいて

ポール・トス

LVCLによって

• KOL Library
• SDA Framework
• VCL Light SO会員Arnaud Bouchez。