TForm.ShowModal只是接管消息循环,禁止外部键盘和鼠标输入到别的窗口,但并不*其它窗口继续获取消息(比如WM_TIMER消息仍可被发送到别的窗口上)

时间:2022-12-12 10:38:03

窗体上放一个TTimer,然后双击输入:

procedure TForm1.Timer1Timer(Sender: TObject);
var
cvs: TCanvas;
Rect: TRect;
Str: string;
begin
cvs := Canvas;
cvs.Font.Style := [fsBold, fsItalic];
cvs.Font.Size := ;
Randomize;
cvs.Font.Color := Random($FFFFFF);
Rect := Screen.DesktopRect;
Str := 'Delphi 绘图';
cvs.TextRect(Rect, , , Str);
end;

再添加一个新窗体和2个按钮:

procedure TForm1.Button1Click(Sender: TObject);
var
s : AnsiString;
begin
s:='dddd';
ShowMessage(s);
end; procedure TForm1.Button2Click(Sender: TObject);
begin
form2.ShowModal;
end;

执行Button1或者Button2之后,Timer1仍在主窗体上不停的绘制文字,这是为什么?

------------------------------------------------------------------------------------

查看ShowModal的内容:

function TCustomForm.ShowModal: Integer;
var
WindowList: Pointer;
SaveFocusCount: Integer;
SaveCursor: TCursor;
SaveCount: Integer;
ActiveWindow: HWnd;
begin
CancelDrag;
if Visible or not Enabled or (fsModal in FFormState) or
(FormStyle = fsMDIChild) then
raise EInvalidOperation.Create(SCannotShowModal);
if GetCapture <> then SendMessage(GetCapture, WM_CANCELMODE, , );
ReleaseCapture;
Application.ModalStarted;
try
Include(FFormState, fsModal);
ActiveWindow := GetActiveWindow;
SaveFocusCount := FocusCount;
Screen.FSaveFocusedList.Insert(, Screen.FFocusedForm);
Screen.FFocusedForm := Self;
SaveCursor := Screen.Cursor;
Screen.Cursor := crDefault;
SaveCount := Screen.FCursorCount;
WindowList := DisableTaskWindows();
try
Show;
try
SendMessage(Handle, CM_ACTIVATE, , );
ModalResult := ;
repeat
Application.HandleMessage; // 该怎么处理还是怎么处理,消息该发送给谁,还是发送给谁
if Application.FTerminate then ModalResult := mrCancel else
if ModalResult <> then CloseModal;
until ModalResult <> ;
Result := ModalResult;
SendMessage(Handle, CM_DEACTIVATE, , );
if GetActiveWindow <> Handle then ActiveWindow := ;
finally
Hide;
end;
finally
if Screen.FCursorCount = SaveCount then
Screen.Cursor := SaveCursor
else Screen.Cursor := crDefault;
EnableTaskWindows(WindowList);
if Screen.FSaveFocusedList.Count > then
begin
Screen.FFocusedForm := Screen.FSaveFocusedList.First;
Screen.FSaveFocusedList.Remove(Screen.FFocusedForm);
end else Screen.FFocusedForm := nil;
if ActiveWindow <> then SetActiveWindow(ActiveWindow);
FocusCount := SaveFocusCount;
Exclude(FFormState, fsModal);
end;
finally
Application.ModalFinished;
end;
end;

再看看Application.HandleMessage的源码:

procedure TApplication.HandleMessage;
var
Msg: TMsg;
begin
if not ProcessMessage(Msg) then Idle(Msg);
end; function TApplication.ProcessMessage(var Msg: TMsg): Boolean;
var
Handled: Boolean;
begin
Result := False;
if PeekMessage(Msg, , , , 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;

------------------------------------------------------------------------------------

顺便我还查了一下TTimer的源码,发现它的句柄是借来的,而不是控件所在窗体的句柄:

constructor TTimer.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FEnabled := True;
FInterval := ;
FWindowHandle := Classes.AllocateHWnd(WndProc);
end; procedure TTimer.UpdateTimer;
begin
KillTimer(FWindowHandle, );
if (FInterval <> ) and FEnabled and Assigned(FOnTimer) then
if SetTimer(FWindowHandle, , FInterval, nil) = then
raise EOutOfResources.Create(SNoTimers);
end; function AllocateHWnd(Method: TWndMethod): HWND;
var
TempClass: TWndClass;
ClassRegistered: Boolean;
begin
UtilWindowClass.hInstance := HInstance;
ClassRegistered := GetClassInfo(HInstance, UtilWindowClass.lpszClassName,
TempClass);
if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then
begin
if ClassRegistered then
Windows.UnregisterClass(UtilWindowClass.lpszClassName, HInstance);
Windows.RegisterClass(UtilWindowClass);
end;
Result := CreateWindowEx(WS_EX_TOOLWINDOW, UtilWindowClass.lpszClassName,
'', WS_POPUP {!0}, , , , , , , HInstance, nil);
if Assigned(Method) then
SetWindowLong(Result, GWL_WNDPROC, Longint(MakeObjectInstance(Method)));
end;

但是不管怎么说,TTimer的句柄所在的窗口也是也是另外一个窗口,所以不影响结论。

------------------------------------------------------------------------------------

总结:其实这个特性很重要。在许多程序中,模态窗口很重要,因为可以防止许多不必要的操作失误。然而它的运行,却不妨碍程序后台继续运行消息循环从而运行其它任务(如有必要的话),这样的设计,实在是绝美!