Creating a System Modal Dialog Box in Delphi

Someone asked the other day how to create a system modal dialog box to log on to Windows 3.1, i.e. show a dialog box that has the focus and disables task switching to any other application.

This example illustrates ways to achieve this using the Win31 and Win32 API. It also illustrates how to encapsulate an interface function for a dialog and how to paint over the Windows desktop.

Due to the multitasking nature of Win32, it's not possible to implement a completely system modal dialog, but you can get a close approximation.

Running a Program at Startup

Logging on is a harder issue than just a system modal dialog because your program needs to interact with the Windows startup. Unexpected behaviour can occur under Windows 95 or NT due to the many tasks running at startup. This example also doesn't do anything about a hacker booting the computer from a floppy disk.

Programs can be run in Win31 startup by including the following in WIN.INI




[Windows]

run=c:\path\ winlogon.exe

Under Win32 a similar registry entry can be added:




Key  : HKEY_LOCALMACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\ or

Key  : HKEY_LOCALMACHINE\SOFTWARE\Microsoft\WindowsNT\CurrentVersion\Run\

Name : ZZZWinLogon {make it the last entry, sorted alphabetically, so it will load last}

Data : c:\path\winlogon.exe

Making a Dialog Box System Modal Under Win31

The Win31 API has a simple function called SysModalWindow that does the trick.

It needs to be called before the dialog box is visible. Also, you can't show messages or other windows while the system modal dialog is displayed. This means turning off hints and using a label on the form to show any feedback messages.

Here is the code for Delphi 1 and the Win31 API:




procedure TfrmSystemModal.FormCreate(Sender: TObject);

begin

  SetSysModalWindow(Handle);

end;

and the form properties of interest are:




BorderIcons = []

BorderStyle = bsDialog

Position = poScreenCenter

ShowHint = False

Visible = False

Making a Dialog Box System Modal Under Win32

As indicated, there's no perfect solution under Windows 95 that works happily at startup and runtime.

If you really need a custom logon dialog for Win32, you'll need to get down and dirty in the security interfaces in the Windows 95/Windows NT Resource Kits.

However two methods can give you a reasonable approximation:

The first way is to simulate a screensaver, using the SystemParametersInfo function.

The second way is more work and involves the following steps:

Ignore WM_SYSCOMMAND messages sent with the SC_NEXTWINDOW, SC_PREVWINDOW, SC_TASKLIST codes;
Subclass the desktop window and ignore mouse double clicks;
Disable all topmost windows except the ones for this dialog and its TApplication;
When the dialog closes we reverse all these actions.

Neither method works perfectly on system startup. They will not stop the operating system or another thread from creating a new window that the user can switch to.

Here is the code for Delphi 2 and the Win32 API, using the screen saver method:




procedure TfrmSystemModal.FormCreate(Sender: TObject);

var

 DisableTaskSwitch: BOOL;

begin

  {disable task switch for this dialog}

  DisableTaskSwitch := True;

  SystemParametersInfoA(SPI_SCREENSAVERRUNNING,Longint(True),@DisableTaskSwitch, 0);

end;



procedure TfrmSystemModal.FormClose(Sender: TObject;

  var Action: TCloseAction);

var

 DisableTaskSwitch: BOOL;

begin

  {restore task switch}

  DisableTaskSwitch := False;

  SystemParametersInfoA(SPI_SCREENSAVERRUNNING, Longint(True),@DisableTaskSwitch, 0);

end;

Here is the code for Delphi 2 and the Win32 API, using the second method:




function ShowLogon(...): TModalResult;

var

  frmSystemModal: TfrmSystemModal;

begin

  frmSystemModal := TfrmSystemModal.Create(Application);

  with frmSystemModal do

    try

      {...}

      DisableWindows;

      Result := ShowModal;

      EnableWindows;

    finally

      Free;

    end;

end;



function EnumWindowsCallBack(Handle: HWND; Info: Longint): BOOL; stdcall;

begin

  Result := True;



  if (Handle <> hThisWnd) and

     (Handle <> hThisParentWnd) then

      if Info = 1 then

         EnableWindow(Handle, TRUE)

      else

         EnableWindow(Handle, FALSE);

end;



procedure TfrmSystemModal.DisableWindows;

begin

  {subclass desktop window}

  FhDesktopWnd := GetDesktopWindow;

  FDesktopWndInstance := MakeObjectInstance(DesktopWndSubclassProc);

  FOrigDesktopWndProc := Pointer(GetWindowLong(FhDesktopWnd, GWL_WNDPROC));

  SetWindowLong(FhDesktopWnd, GWL_WNDPROC, Longint(FDesktopWndInstance));

  {disable all other windows except this one and its parent.

   NB this assumes this window is owned by TApplication.}

  hThisWnd := Handle;

  hThisParentWnd := GetParent(hThisWnd);

  Windows.EnumWindows(@EnumWindowsCallBack, 0);

end;



procedure TfrmSystemModal.EnableWindows;

begin

  {restore desktop window}

  SetWindowLong(FhDesktopWnd, GWL_WNDPROC, Longint(FOrigDesktopWndProc));

  FreeObjectInstance(FDesktopWndInstance);

  {enable all windows}

  Windows.EnumWindows(@EnumWindowsCallBack, 1);

end;



procedure TfrmSystemModal.DesktopWndSubclassProc(var Message: TMessage);

{

Subclass procedure for the desktop to prevent launching task list

if the user double clicks in the desktop window.

}

begin

  with Message do

    if Msg = WM_LBUTTONDBLCLK then

      Result := 0

    else

      Result := CallWindowProc(FOrigDesktopWndProc, FhDesktopWnd, Msg, WParam, LParam);

end;



procedure TfrmSystemModal.WMSysCommand(var Message: TWMSysCommand);

begin

  case Message.CmdType of

    SC_NEXTWINDOW, SC_PREVWINDOW, SC_TASKLIST:

      Message.Result := 1;

  else

    inherited;

  end;

end;

Download the Source for Delphi 1 and Delphi 2 Here