home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Libraries / PNL Libraries / MyStandardFile.p < prev    next >
Encoding:
Text File  |  1995-10-27  |  6.6 KB  |  249 lines  |  [TEXT/CWIE]
  1. unit MyStandardFile;
  2.  
  3. interface
  4.  
  5.     uses
  6.         StandardFile;
  7.  
  8.     type
  9.         MySFReply = record
  10.                 Rgood: boolean;
  11.                 Rfolder: boolean;
  12.                 RfType: OSType;
  13.                 RvRefNum: integer;
  14.                 RdirID: longInt;
  15.                 RfName: str63;
  16.             end;
  17.  
  18.     function MFSPt: point;
  19.     procedure GetFile (ffilter: Ptr; numTypes: integer; typeList: SFTypeList; var reply: MySFReply);
  20.     procedure GetFile1 (t: OSType; var reply: MySFReply);
  21.     procedure GetFolder (ffilter: Ptr; numTypes: integer; typeList: SFTypeList; id: integer; var reply: MySFReply);
  22. { NOTE: GetFolder must be passed a Dialog ID with Button 11 being a folder button }
  23. { NOTE: reply.copy should be interpreted as reply.folder }
  24.     procedure PutFile (str, origName: str255; var reply: MySFreply);
  25.     procedure PutFolder (str, origName: str255; id: integer; var reply: MySFreply);
  26. { NOTE: PutFolder must be passed a Dialog ID with Button 9 being a folder button }
  27. { NOTE: reply.copy should be interpreted as reply.folder }
  28.     function Button11Hook (item: integer; dlg: DialogPtr): integer;
  29. { NOTE: Button11Hook sets Button11 when it converts Button 11 to Button 1 (Open) }
  30.     function Button9Hook (item: integer; dlg: DialogPtr): integer;
  31. { NOTE: Button9Hook sets Button9 when it converts Button 9 to Button 1 (Save) }
  32.     procedure SetSFFile (wdrn: integer; dirID: longInt);
  33.     procedure SegmentStandardFile;
  34.  
  35. implementation
  36.  
  37.     uses
  38.         MyTypes, MyUtils, MySystemGlobals, MyFileSystemUtils, MyButtons;
  39.  
  40.  {$S StandardFile}
  41.     procedure SegmentStandardFile;
  42.     begin
  43.     end;
  44.  
  45.     procedure SetSFFile (wdrn: integer; dirID: longInt);
  46.         var
  47.             oe: OSErr;
  48.             vrn: integer;
  49.             procID: longInt;
  50.     begin
  51.         if dirID = 0 then begin
  52.             oe := GetWDInfo(wdrn, vrn, dirID, procID);
  53.         end else begin
  54.             vrn := wdrn;
  55.         end;
  56.         integerP(SFSaveDiskA)^ := -vrn;
  57.         longIntP(CurDirStoreA)^ := dirID;
  58.     end;
  59.  
  60.     function MFSPt: point;
  61.         var
  62.             pt: point;
  63.     begin
  64.         pt.v := 40;
  65.         pt.h := 40;
  66.         MFSPt := pt;
  67.     end;
  68.  
  69.     procedure SetStdReply (var reply: MySFReply; stdReply: StandardFileReply);
  70.     begin
  71.         with reply do begin
  72.             Rgood := stdReply.sfGood;
  73.             Rfolder := ord(stdReply.sfIsFolder) <> 0;        { Argghhh!  Bloody Apple and there C booleans! }
  74.             RfType := stdReply.sfType;
  75.             RvRefNum := stdReply.sfFile.vRefNum;
  76.             RdirID := stdReply.sfFile.parID;
  77.             RfName := stdReply.sfFile.name;
  78.         end;
  79.     end;
  80.  
  81.     procedure SetOldReply (var reply: MySFReply; oldReply: SFReply);
  82.         var
  83.             junk: OSErr;
  84.     begin
  85.         with reply do begin
  86.             Rgood := oldReply.good;
  87.             Rfolder := oldReply.copy;
  88.             RfType := oldReply.fType;
  89.             junk := GetDirID(oldReply.vRefNum, RvRefNum, RdirID);
  90.             RfName := oldReply.fName;
  91.         end;
  92.     end;
  93.  
  94.     procedure GetFile (ffilter: Ptr; numTypes: integer; typeList: SFTypeList; var reply: MySFReply);
  95.         var
  96.             stdReply: StandardFileReply;
  97.             oldReply: SFReply;
  98.     begin
  99.         with reply do
  100.             if has_newStdFile then begin
  101.                 StandardGetFile(ffilter, numTypes, @typeList, stdReply);
  102.                 SetStdReply(reply, stdReply);
  103.             end
  104.             else begin
  105.                 SFGetFile(MFSPt, '', ffilter, numTypes, @typeList, nil, oldReply);
  106.                 oldReply.copy := false;
  107.                 SetOldReply(reply, oldReply);
  108.             end;
  109.     end;
  110.  
  111.     procedure GetFile1 (t: OSType; var reply: MySFReply);
  112.         var
  113.             typeList: SFTypeList;
  114.     begin
  115.         if t = OSType(noType) then begin
  116.             GetFile(nil, -1, typeList, reply);
  117.         end else begin
  118.             typeList[0] := t;
  119.             GetFile(nil, 1, typeList, reply);
  120.         end;
  121.     end;
  122.  
  123.     procedure PutFile (str, origName: str255; var reply: MySFreply);
  124.         var
  125.             stdReply: StandardFileReply;
  126.             oldReply: SFReply;
  127.     begin
  128.         with reply do
  129.             if has_newStdFile then begin
  130.                 StandardPutFile(str, origName, stdReply);
  131.                 SetStdReply(reply, stdReply);
  132.             end
  133.             else begin
  134.                 SFPutFile(MFSPt, str, origName, nil, oldReply);
  135.                 oldReply.copy := false;
  136.                 SetOldReply(reply, oldReply);
  137.             end;
  138.     end;
  139.  
  140.     var
  141.         oldReply: SFReply;
  142.         newReply: StandardFileReply;
  143. { item1 is ThisFolder }
  144.         item1: integer;
  145.         button1: boolean;
  146.         active1: boolean;
  147.  
  148.     procedure SetButtons (dlg: dialogPtr);
  149.         var
  150.             new1: boolean;
  151.     begin
  152.         if has_newStdFile then begin
  153.             new1 := newReply.sfFile.parID <> 1; { everywhere except  desktop???? }
  154.         end
  155.         else begin
  156.             new1 := true;
  157.         end;
  158.         SetButton(dlg, item1, active1, new1);
  159.     end;
  160.  
  161.     function ButtonModalFilter (dlg: dialogPtr; var er: eventRecord; var item: integer): boolean;
  162.     begin
  163.         SetButtons(dlg);
  164.         if (er.what = updateEvt) and (dlg = dialogPtr(er.message)) then begin
  165.             UpdateButton(dlg, item1, active1);
  166.         end;
  167.         ButtonModalFilter := false;
  168.     end;
  169.  
  170.     function ButtonModalFilterSys7 (dlg: dialogPtr; var er: eventRecord; var item: integer; data: ptr): boolean;
  171.     begin
  172.         ButtonModalFilterSys7 := ButtonModalFilter(dlg, er, item);
  173.     end;
  174.  
  175.     function ButtonHook (item: integer; dlg: DialogPtr): integer;
  176.     begin
  177.         if not has_newStdFile or (GetWRefCon(dlg) = longint(sfMainDialogRefCon)) then begin
  178.             if item = sfHookFirstCall then begin
  179.                 button1 := false;
  180.                 InitButton(dlg, item1, active1, active1);
  181.                 SetButtons(dlg);
  182.             end;
  183.             if active1 then begin
  184.                 if item <> sfHookLastCall then begin
  185.                     button1 := item = item1;
  186.                     if button1 then begin
  187.                         item := sfItemOpenButton;
  188.                     end;
  189.                 end;
  190.             end;
  191.         end;
  192.         ButtonHook := item;
  193.     end;
  194.  
  195.     function ButtonHookSys7 (item: integer; dlg: DialogPtr; data: ptr): integer;
  196.     begin
  197.         ButtonHookSys7 := ButtonHook(item, dlg);
  198.     end;
  199.  
  200.     procedure PutFolder (str, origName: str255; id: integer; var reply: MySFreply);
  201.     begin
  202.         if has_newStdFile then begin
  203.             item1 := 13;
  204.             active1 := true;
  205.             CustomPutFile(str, origName, newReply, id + 1, MFSPt, @ButtonHookSys7, @ButtonModalFilterSys7, nil, nil, nil); {@ButtonModalFilterSys7}
  206.             SetStdReply(reply, newReply);
  207.             reply.Rfolder := button1;
  208.         end
  209.         else begin
  210.             item1 := 9;
  211.             active1 := true;
  212.             SFPPutFile(MFSPt, str, origName, @ButtonHook, oldReply, id, nil);
  213.             oldReply.copy := button1;
  214.             SetOldReply(reply, oldReply);
  215.         end;
  216.     end;
  217.  
  218.     function CallFileFilterSys7 (pb: CInfoPBPtr; addr: ptr): boolean;
  219.     inline
  220.         $205F, $4E90;
  221.  
  222.     function FileFilterSys7 (pb: CInfoPBPtr; addr: ptr): boolean;
  223.     begin
  224.         if (BAND(pb^.ioFlAttrib, $0010) = 0) and (addr <> nil) then begin
  225.             FileFilterSys7 := CallFileFilterSys7(pb, addr);
  226.         end else begin
  227.             FileFilterSys7 := false;
  228.         end;
  229.     end;
  230.  
  231.     procedure GetFolder (ffilter: Ptr; numTypes: integer; typeList: SFTypeList; id: integer; var reply: MySFReply);
  232.     begin
  233.         if has_newStdFile then begin
  234.             item1 := 10;
  235.             active1 := true;
  236.             CustomGetFile(@FileFilterSys7, numTypes, @typeList, newReply, id + 1, MFSpt, @ButtonHookSys7, @ButtonModalFilterSys7, nil, nil, ffilter);
  237.             SetStdReply(reply, newReply);
  238.             reply.Rfolder := button1;
  239.         end
  240.         else begin
  241.             item1 := 11;
  242.             active1 := true;
  243.             SFPGetFile(MFSPt, '', ffilter, numTypes, @typeList, @ButtonHook, oldReply, id, nil);
  244.             oldReply.copy := button1;
  245.             SetOldReply(reply, oldReply);
  246.         end;
  247.     end;
  248.  
  249. end.