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

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

procedure TForm1.Timer1Timer(Sender: TObject);
var
  cvs: TCanvas;
  Rect: TRect;
  Str: string;
begin
  cvs := Canvas;
  cvs.Font.Style := [fsBold, fsItalic];
  cvs.Font.Size := 48;
  Randomize;
  cvs.Font.Color := Random($FFFFFF);
  Rect := Screen.DesktopRect;
  Str := 'Delphi 绘图';
  cvs.TextRect(Rect, 100, 100, 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 <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
  ReleaseCapture;
  Application.ModalStarted;
  try
  Include(FFormState, fsModal);
  ActiveWindow := GetActiveWindow;
  SaveFocusCount := FocusCount;
  Screen.FSaveFocusedList.Insert(0, Screen.FFocusedForm);
  Screen.FFocusedForm := Self;
  SaveCursor := Screen.Cursor;
  Screen.Cursor := crDefault;
  SaveCount := Screen.FCursorCount;
  WindowList := DisableTaskWindows(0);
  try
    Show;
    try
      SendMessage(Handle, CM_ACTIVATE, 0, 0);
      ModalResult := 0;
      repeat
        Application.HandleMessage; // 该怎么处理还是怎么处理,消息该发送给谁,还是发送给谁
        if Application.FTerminate then ModalResult := mrCancel else
          if ModalResult <> 0 then CloseModal;
      until ModalResult <> 0;
      Result := ModalResult;
      SendMessage(Handle, CM_DEACTIVATE, 0, 0);
      if GetActiveWindow <> Handle then ActiveWindow := 0;
    finally
      Hide;
    end;
  finally
    if Screen.FCursorCount = SaveCount then
      Screen.Cursor := SaveCursor
    else Screen.Cursor := crDefault;
    EnableTaskWindows(WindowList);
    if Screen.FSaveFocusedList.Count > 0 then
    begin
      Screen.FFocusedForm := Screen.FSaveFocusedList.First;
      Screen.FSaveFocusedList.Remove(Screen.FFocusedForm);
    end else Screen.FFocusedForm := nil;
    if ActiveWindow <> 0 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, 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;

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

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

constructor TTimer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEnabled := True;
  FInterval := 1000;
  FWindowHandle := Classes.AllocateHWnd(WndProc);
end;

procedure TTimer.UpdateTimer;
begin
  KillTimer(FWindowHandle, 1);
  if (FInterval <> 0) and FEnabled and Assigned(FOnTimer) then
    if SetTimer(FWindowHandle, 1, FInterval, nil) = 0 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}, 0, 0, 0, 0, 0, 0, HInstance, nil);
  if Assigned(Method) then
    SetWindowLong(Result, GWL_WNDPROC, Longint(MakeObjectInstance(Method)));
end;

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

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

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

原文地址:https://www.cnblogs.com/findumars/p/5342689.html