home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyHandleQuitBoth.p < prev    next >
Encoding:
Text File  |  1996-05-29  |  1.5 KB  |  75 lines  |  [TEXT/CWIE]
  1. unit MyHandleQuitBoth;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.  
  8.     procedure StartupHandleQuitBoth;
  9.     procedure ConfigureHandleQuitBoth (creator: OSType; both_index, justus_index: integer);
  10.  
  11. implementation
  12.  
  13.     uses
  14.         TextUtils, Menus, 
  15.         MyTypes, MyProcesses, MyFMenus, MyStartup, MyOOMenus, 
  16.         BaseGlobals;
  17.  
  18.     var
  19.         quitBoth: boolean;
  20.         creatorType: OSType;
  21.         both, justus: integer;
  22.  
  23.     procedure DoQuit;
  24.     begin
  25.         quitNow := true;
  26.         if quitBoth then begin
  27.             QuitApplication(creatorType, application);
  28.         end;
  29.     end;
  30.  
  31.     procedure SetQuit (themenu, theitem: integer);
  32.         var
  33.             dummyb: boolean;
  34.             er: EventRecord;
  35.             nqb: boolean;
  36.             process: ProcessSerialNumber;
  37.             s: Str255;
  38.             fs: FSSpec;
  39.     begin
  40.         dummyb := GetOSEvent(0, er);
  41.         nqb := (BAND(er.modifiers, optionKey) <> 0) & FindProcess(creatorType, application, process, fs);
  42.         if nqb <> quitBoth then begin
  43.             quitBoth := nqb;
  44.             if quitBoth then begin
  45.                 GetIndString(s, global_strh_id, both);
  46.             end else begin
  47.                 GetIndString(s, global_strh_id, justus);
  48.             end;
  49.             SetMenuItemText(GetMenuHandle(themenu), theitem, s);
  50.         end;
  51.     end;
  52.  
  53.     function InitHandleQuitBoth(var msg: integer): OSStatus;
  54.     begin
  55. {$unused(msg)}
  56.         quitBoth := false;
  57.         SetFBoth(Cquit, DoQuit, SetQuit);
  58.         InitHandleQuitBoth:= noErr;
  59.     end;
  60.  
  61.     procedure ConfigureHandleQuitBoth (creator: OSType; both_index, justus_index: integer);
  62.     begin
  63.         creatorType := creator;
  64.         both := both_index;
  65.         justus := justus_index;
  66.     end;
  67.     
  68.     procedure StartupHandleQuitBoth;
  69.     begin
  70.         StartupFMenus;
  71.         StartupOOMenus;
  72.         SetStartup(InitHandleQuitBoth, nil, 0,nil);
  73.     end;
  74.     
  75. end.