home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / Finger 1.3.5 / source / My Units / MyInternetMenu.unit < prev    next >
Encoding:
Text File  |  1992-02-24  |  3.3 KB  |  148 lines  |  [TEXT/PJMM]
  1. unit MyInternetMenu;
  2.  
  3. { This code is part of the Finger/Fingerd source code, written in THINK Pascal 4 }
  4. { Copyright 1991-1992 Peter N Lewis }
  5. { If you use this code, you must give me credit in your about box and documentation }
  6. { This is part of my generic library of routines }
  7.  
  8. interface
  9.  
  10.     procedure InitInternetMenu;
  11.     procedure FinishInternetMenu;
  12.     procedure AddInternetCommand (s: str255);
  13.     function GetInternetCommand (themenu, theitem: integer): str255;
  14.     procedure RemoveInternetCommand (themenu, theitem: integer);
  15.     procedure SetXMenu (themenu, theitem: integer);
  16.  
  17. implementation
  18.  
  19.     uses
  20.         AppGlobals, MyUtils, MyPreferences, MyFMenus;
  21.  
  22.     var
  23.         send_to_mh, remove_mh: menuHandle;
  24.         modified: boolean;
  25.  
  26.     procedure AddInternetCommand (s: str255);
  27.         var
  28.             i, c: integer;
  29.             lessthan: boolean;
  30.             mi: str255;
  31.     begin
  32.         c := CountMItems(send_to_mh);
  33.         i := 1;
  34.         lessthan := false;
  35.         while (i <= c) and not lessthan do begin
  36.             GetItem(send_to_mh, i, mi);
  37.             lessthan := (s <= mi);
  38.             if not lessthan then
  39.                 i := i + 1;
  40.         end;
  41.         if not lessthan or (s <> mi) then begin
  42.             InsMenuItem(send_to_mh, 'fred', i - 1);
  43.             InsMenuItem(remove_mh, 'fred', i - 1);
  44.             SetItem(send_to_mh, i, s);
  45.             SetItem(remove_mh, i, s);
  46.         end;
  47.         modified := true;
  48.     end;
  49.  
  50.     procedure SetXMenu (themenu, theitem: integer);
  51.     begin
  52.         SetIDItemEnable(themenu, theitem, CountMItems(send_to_mh) > 0);
  53.     end;
  54.  
  55.     function GetInternetCommand (themenu, theitem: integer): str255;
  56.         var
  57.             s: str255;
  58.     begin
  59.         GetItem(send_to_mh, theitem, s);
  60.         GetInternetCommand := s;
  61.     end;
  62.  
  63.     procedure RemoveInternetCommand (themenu, theitem: integer);
  64.     begin
  65.         DelMenuItem(send_to_mh, theitem);
  66.         DelMenuItem(remove_mh, theitem);
  67.         modified := true;
  68.     end;
  69.  
  70.     procedure SaveInternetMenu;
  71.         type
  72.             intPtr = ^integer;
  73.             intHandle = ^intPtr;
  74.         var
  75.             oe, ooe: OSErr;
  76.             vrn: integer;
  77.             dirID: longInt;
  78.             i, rn, count, len: integer;
  79.             s: str255;
  80.             h: handle;
  81.     begin
  82.         if modified then begin
  83.             count := CountMItems(send_to_mh);
  84.             len := SizeOf(integer);
  85.             for i := 1 to count do begin
  86.                 GetItem(send_to_mh, i, s);
  87.                 len := len + Length(s) + 1;
  88.             end;
  89.             h := NewHandle(len);
  90.             if h <> nil then begin
  91.                 intHandle(h)^^ := count;
  92.                 len := 2;
  93.                 for i := 1 to count do begin
  94.                     GetItem(send_to_mh, i, s);
  95.                     BlockMove(@s, ptr(longInt(h^) + len), Length(s) + 1);
  96.                     len := len + Length(s) + 1;
  97.                 end;
  98.                 SetPrefsResource(to_rsrc, to_strh_id, h);
  99.             end;
  100.             modified := false;
  101.         end;
  102.     end;
  103.  
  104.     procedure SetSaveMenu (themenu, theitem: integer);
  105.     begin
  106.         SetIDItemEnable(themenu, theitem, modified);
  107.     end;
  108.  
  109.     procedure LoadInternetMenu;
  110.         type
  111.             intPtr = ^integer;
  112.             intHandle = ^intPtr;
  113.         var
  114.             i, rn, count: integer;
  115.             s: str255;
  116.             h: handle;
  117.     begin
  118.         rn := GetPrefsResource(to_rsrc, to_strh_id, h);
  119.         if h <> nil then begin
  120.             count := intHandle(h)^^;
  121.             for i := 1 to count do begin
  122.                 GetIndString(s, to_strh_id, i);
  123.                 AddInternetCommand(s);
  124.             end;
  125.             DisposHandle(h);
  126.         end;
  127.         if rn <> -1 then
  128.             CloseResFile(rn);
  129.     end;
  130.  
  131.     procedure InitInternetMenu;
  132.     begin
  133.         send_to_mh := NewMenu(M_InternetTo, 'Send To');
  134.         InsertMenu(send_to_mh, -1);
  135.         remove_mh := NewMenu(M_RemoveTo, 'Remove');
  136.         InsertMenu(remove_mh, -1);
  137.         LoadInternetMenu;
  138.         modified := false;
  139.         SetFBoth(CSaveMenu, @SaveInternetMenu, @SetSaveMenu);
  140.         SetFSetMenu(CXInternet, @SetXMenu);
  141.         SetFSetMenu(CXRemove, @SetXMenu);
  142.     end;
  143.  
  144.     procedure FinishInternetMenu;
  145.     begin
  146.     end;
  147.  
  148. end.