Delphi主訊息迴圈研究(Application.Run和Application.Initialize執行後的情況)

findumars發表於2013-08-19
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;

第一步,貌似什麼都不做,但如果提前定義InitProc就不一樣了

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

第二步,建立一部分Form,特別是MainForm

procedure TApplication.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; // 這句話大有講究,執行了許多動作。包括遞迴建立Parent的Handle
    FMainForm := TForm(Instance);
  end;
end;

第三步,使用repeat建立訊息迴圈

procedure TApplication.Run;
var
  i: integer;
  d1,d2: TDateTime;
begin
  i:=0;
  d1:=now;
  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;
      // 注意1,當滑鼠移出當前視窗的範圍時,不會繼續執行當前repeat迴圈
      // 注意2,經測試發現,每次點選滑鼠或者按鍵,都會產生5個訊息。
      // 注意3,這裡給每一個訊息處理都包裹了一個異常處理。
      repeat
      begin
        try
          HandleMessage;
        except
          HandleException(Self);
        end;
    // 這裡可以觀察,當前視窗處理了多少個訊息
        inc(i);
        if (i=200) then begin d2:=now; ShowMessage(IntToStr(MinutesBetween(d1,d2))); end;
        MainForm.Canvas.TextOut(0,0,IntToStr(i));
      end
      until Terminated;
    end;
  finally
    FRunning := False;
  end;
end;

第3.1步,具體處理每一個訊息迴圈

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

第3.2步,取得訊息並分發訊息,但是分發前好像還會先執行FOnMessage(Msg, Handled);

function TApplication.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
      FTerminate := True;
  end;
end;

第3.3步 處理Hint,同步主執行緒,再呼叫 WaitMessage

procedure TApplication.Idle(const Msg: TMsg);
var
  Control: TControl;
  Done: Boolean;
begin
  Control := DoMouseIdle;
  if FShowHint and (FMouseControl = nil) then CancelHint;
  Application.Hint := GetLongHint(GetHint(Control));
  Done := True;
  try
    if Assigned(FOnIdle) then FOnIdle(Self, Done);
    if Done then DoActionIdle;
  except
    HandleException(Self);
  end;
  if (GetCurrentThreadID = MainThreadID) and CheckSynchronize then
    Done := False;
  // 當一個執行緒的訊息佇列中無其它訊息時,該函式就將控制權交給另外的執行緒,同時將該執行緒掛起,直到一個新的訊息被放入執行緒的訊息佇列之中才返回。
  // 在指定型別的新的輸入訊息抵達之前,它是不會返回的。
  // 如果沒有這句,或者不呼叫這個Idle,當前訊息迴圈會不間斷瘋狂的去佇列裡取訊息,1分鐘即可執行30多萬次,CPU 100%被佔用
  if Done then WaitMessage; 
end;

第四步,程式設計師手工建立訊息迴圈:
自己建立一個訊息處理迴圈(while),把當前訊息佇列的所有訊息一次性處理完畢,且不呼叫Idle。可以在while加上計數,看每次處理了多少個訊息。

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

 個人感想:程式的任何一個地方,都可以主動執行PeekMessage等訊息函式,接管主程式的訊息迴圈,參考:

http://blog.csdn.net/mengde666/article/details/4045656

相關文章