Создание замены TApplication для экспериментов? - PullRequest
Новая
       2

Создание замены TApplication для экспериментов?

1 голос
/ 04 декабря 2011

Однажды мне пришла в голову сумасшедшая идея сделать совершенно новую замену TApplication для экспериментов.Я получил все для компиляции и запуска, и он действительно показывает основную форму, все отвечает хорошо, но после закрытия формы приложение не останавливается.Я уверен, что скопировал все необходимые вещи из оригинального приложения Forms.pas TApplication (регистрация события close), но не вижу, как оно работает.Я должен прекратить сеанс отладки неприятным способом.

Моя цель в этом небольшом эксперименте - создать легкое приложение для очень простых вещей вместо всех возможных вещей, с которыми может работать 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.

И вот приложение, использующее это: 

program Win7FormTestD7;

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

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

Форма 'W7Form1' представляет собой простую форму с парой случайных элементов управления для тестирования.

Пользователи здесь не должны задавать вопрос, почему я хочу это сделать, у меня естьмои причины.Я учусь на практике, а не на том, что кто-то показывает мне, или на чтении какой-то книги, или нахожу кучу кода, который я не знаю, как он работает.Для меня это способ лучше изучить работу приложений и расширить свои знания в этой области, чтобы в будущем можно было создавать более сложные приложения.

Ответы [ 2 ]

5 голосов
/ 05 декабря 2011

Если ваш девиз - создание легковесных приложений, я советую поиграть с:

4 голосов
/ 05 декабря 2011

Имейте в виду, что TCustomForm не имеет понятия о вашем классе TJDApplication, он работает только с классом Forms.TApplication.Убедитесь, что ваш метод TJDApplication.Run() завершается, когда для свойства Forms.TApplication.Terminated установлено значение True.

...