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等訊息函式,接管主程式的訊息迴圈,參考: