The C Users' Group Library 1994 August/wc-cdrom-cusersgrouplibrary-1994-08.iso/listings/v_03_01/3n01044a

Text File | 1991-10-17 | 6KB | 186 lines

{ LISTING 1 }
{$M 2048,1024,R-,S-,D-,L-,N-,A-}
Program Bye;

   (* BYE.PAS - Quick Exit For Windows in Generic Windows API
    * Written by Richard R. Sands in Turbo Pascal for Windows
    *)

   {$R BYE1}

   USES
     WinTypes, WinProcs;

   CONST
     AppName  = 'Bye';
     Confirm  : Boolean = FALSE;  { Confirm Windows Shutdown? }

     idm_Quit    = 100;  { Sys Message Command: Quit Windows }
     idm_Confirm = 101;  { Sys Message Command: Confirm Exit }
     idm_OS      = 102;  { Sys Message Command: Execute DOS Shell }
     idm_About   = 103;  { Sys Message Command: Show About Dialog }

{ -------------------------------------------------------------------------- }
function About(Dialog: hWnd; Message, wParam: Word; lParam: Longint): Bool; EXPORT;
  begin
    About := True;
    case Message of
      wm_InitDialog: EXIT;
      wm_Command   : if (wParam = id_Ok) or (wParam = id_Cancel) then
                     begin
                        EndDialog(Dialog, 1);
                        EXIT
                     end;
    end;
    About := False
  end;

{ -------------------------------------------------------------------------- }
procedure DoAbout(Window:hWnd);
  var AboutProc: tFarProc;
  begin
     AboutProc := MakeProcInstance(@About, hInstance);
     DialogBox(hInstance, 'AboutBox', Window, AboutProc);
     FreeProcInstance(AboutProc)
  end;

{ -------------------------------------------------------------------------- }
Procedure SetConfirmState;
  { Sets the [BYE]
             Confirm=Y/N
     WIN.INI setting }
  var Buffer: Array[0..1] of char;
  begin
     if Confirm then Buffer[0] := 'Y'
     else
        Buffer[0] := 'N';
     Buffer[1] := #0;  { Null terminate the String }
     WriteProfileString(AppName, 'Confirm', Buffer);
  end;

{ -------------------------------------------------------------------------- }
procedure Quit(Window: hWnd);
  begin
     if Confirm then
     begin
        MessageBeep(0);
        if MessageBox(Window,'Are you sure you want to exit Windows?', 'Exit Windows?',
                      mb_IconQuestion + mb_OkCancel) = id_Cancel then
           EXIT
     end;
     SetConfirmState;   { Write our Confirm=Y/N entry in WIN.INI }
     ExitWindows(0, 0)  { See 'ya }
  end;

{ -------------------------------------------------------------------------- }
Procedure ToggleConfirm(Window : hWnd);
  var SysMenu  : hMenu;
  begin
      SysMenu := GetSystemMenu(Window, FALSE);
      Confirm := NOT Confirm;
      if Confirm then
         CheckMenuItem(SysMenu, idm_Confirm, mf_byCommand + mf_Checked)
      else
         CheckMenuItem(SysMenu, idm_Confirm, mf_byCommand + mf_UnChecked)
  end;

{ -------------------------------------------------------------------------- }
function WindowProc(Window: hWnd; Message, WParam: Word; LParam: Longint): Longint; EXPORT;

  { This is the main message handling routine.  If there is a System Menu
    command, then wm_SysCommand is sent with the menu option.  Otherwise,
    I check for a double click on the icon, which is sent as a
    wm_QueryOpen message, as a signal to close Windows }

  begin
    WindowProc := 0;
    case Message of
      wm_SysCommand:
          case wParam of
            idm_About  : DoAbout(Window);
            idm_Confirm: ToggleConfirm(Window);
            idm_OS     : WinExec('Command.Com', sw_Normal);
            idm_Quit   : Quit(Window);
          end;
      wm_QueryOpen:          { Double click on Icon }
          begin
              Quit(Window);
              { If returns 0 then we cannot open - this suppresses the
                restore window function }
              EXIT
          end;
      wm_Destroy:
          begin
              SetConfirmState;  { Update WIN.INI with Confirm Setting }
              PostQuitMessage(0);
              EXIT
          end;
    end;
    { For all messages we don't care about, they are handled by the
      "default window process" }
    WindowProc := DefWindowProc(Window, Message, wParam, lParam)
  end;

{ -------------------------------------------------------------------------- }
procedure WinMain;
  var Window  : hWnd;
      Message : tMsg;
      SysMenu : hMenu;
      Buffer  : Array[0..1] of char;
  const
    WindowClass: tWndClass = (
      style      : 0;
      lpfnWndProc: @WindowProc;
      cbClsExtra : 0;
      cbWndExtra : 0;
      hInstance  : 0;
      hIcon      : 0;
      hCursor    : 0;
      hbrBackground: 0;
      lpszMenuName : AppName;
      lpszClassName: AppName);
  begin
    if hPrevInst = 0 then
    begin
      WindowClass.hInstance := hInstance;
      WindowClass.hIcon := LoadIcon(hInstance, 'ICON');
      WindowClass.hCursor := LoadCursor(0, idc_Arrow);
      WindowClass.hbrBackground := GetStockObject(white_Brush);
      if not RegisterClass(WindowClass) then Halt(255);
    end
    else
       Halt(0);  { Only One Instance Allowed }
    Window := CreateWindow(AppName, AppName,
                  ws_OverlappedWindow,
                  cw_UseDefault, cw_UseDefault, cw_UseDefault, cw_UseDefault,
                  0, 0, hInstance, nil);

    SysMenu := GetSystemMenu(Window, FALSE);

    { Add Items to the System Menu }
    AppendMenu(SysMenu, mf_SysMenu + mf_Separator, 0, NIL);
    AppendMenu(SysMenu, mf_SysMenu, idm_Quit,    '&Exit Windows');
    AppendMenu(SysMenu, mf_SysMenu, idm_Confirm, 'Confirm &Shutdown');
    AppendMenu(SysMenu, mf_SysMenu, idm_OS,      '&Operating System');
    AppendMenu(SysMenu, mf_SysMenu, idm_About,   '&About Bye...');

    GetProfileString(AppName, 'Confirm', 'N', Buffer, sizeof(Buffer));
    if Buffer[0] = 'Y' then
       ToggleConfirm(Window);

    ShowWindow(Window, sw_Minimize);  { This minimizes the window }

    { The application's message loop }
    while GetMessage(Message, 0, 0, 0) do
    begin
       TranslateMessage(Message);
       DispatchMessage(Message)
    end;
    Halt(Message.wParam)
  end;

{ -------------------------------------------------------------------------- }
begin
   WinMain
end.