home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1996 March / macformat-035.iso / Shareware City / Developers / ICAppSourceKit1.2 / StandardGetFolder.p < prev   
Encoding:
Text File  |  1995-11-07  |  11.3 KB  |  272 lines  |  [TEXT/CWIE]
  1. {******************************************************************************}
  2. { StandardGetFolder.c                                                          }
  3. {                                                                              }
  4. {    This little chunk o' code implements a way to let the user choose a       }
  5. {    folder to save files in via a StandardFile Dialog.                        }
  6. {                                                                              }
  7. {    Since the code uses the CustomGetFile function and depends on the use of  }
  8. {    FSSpec records, it only works under System 7.0 or later.                  }
  9. {                                                                              }
  10. {    And don't forget to include the custom dialog resources ( a 'DITL' and    }
  11. {   'DLOG') in your project.                                                   }
  12. {                                                                              }
  13. {    Portions of this code were originally provided by Paul Forrester          }
  14. {    (paulf@apple.com) to the think-c internet mailing list in response to my  }
  15. {    my question on how to do exactly what this code does.  I've added a       }
  16. {    couple of features, such as the ability to handle aliased folders and     }
  17. {    the programmer definable prompt.  I also cleaned and tightened the code,  }
  18. {    stomped a couple of bugs, and packaged it up neatly.  Bunches of work,    }
  19. {    but I learned A LOT about Standard File, the File Manager, the Dialog     }
  20. {    Manager, and the Alias Manager.  I tried to include in the comments some  }
  21. {    of the neat stuff I discovered in my hours of pouring over Inside Mac.    }
  22. {    Hope you find it educational as well as useful.                           }
  23. {******************************************************************************}
  24. { Converted to Pascal by Peter N Lewis <peter.lewis@info.curtin.edu.au> Dec 1992 }
  25.  
  26. unit StandardGetFolder;
  27.  
  28. interface
  29.  
  30.     uses
  31.         Types, StandardFile;
  32.         
  33.     procedure GetSFLocation (var vrn: integer; var dirID: longInt);
  34.     procedure SetSFLocation (vrn: integer; dirID: longInt);
  35.     procedure StandardGetFolder (where: Point; message: Str255; var mySFReply: StandardFileReply);
  36.  
  37. implementation
  38.  
  39.     uses
  40.         Aliases, Script, TextUtils, ICMiscSubs;
  41.  
  42. { Resource IDs }
  43.     const
  44.         rGetFolderButton = 10;
  45.         rGetFolderMessage = 11;
  46.         rGetFolderSelectString = 12;
  47.         kFolderBit = $0010;
  48.         rGetFolderDialog = 2008;
  49.  
  50. { Global Variables }
  51.  
  52.     var
  53.         gCurrentSelectedFolder: str255;
  54.  
  55.     const
  56.         SFSaveDiskA = $214;
  57.         CurDirStoreA = $398;
  58.     type
  59.         intPtr = ^integer;
  60.         longPtr = ^longInt;
  61.  
  62. { The following set of routines are used to access a couple of low memory      }
  63. { globals that are necessary when extending Standard File.  One example is     }
  64. { trying to get the current directory while in a file filter.  These routines  }
  65. { were used to bottleneck all the low memory usage.  If the system one day     }
  66. { supports them with a trap call, then we can easily update these routines.    }
  67.  
  68.     procedure GetSFLocation (var vrn: integer; var dirID: longInt);
  69.     begin
  70.         vrn := -intPtr(SFSaveDiskA)^;
  71.         dirID := longPtr(CurDirStoreA)^;
  72.     end;
  73.  
  74.     procedure SetSFLocation (vrn: integer; dirID: longInt);
  75.     begin
  76.         intPtr(SFSaveDiskA)^ := -vrn;
  77.         longPtr(CurDirStoreA)^ := dirID;
  78.     end;
  79.  
  80. {******************************************************************************}
  81. { MyCustomGetDirectoryFileFilter                                               }
  82. {                                                                              }
  83. {     This is the file filter passed to CustomGetFile. It passes folders only. }
  84. {******************************************************************************}
  85.     function MyCustomGetDirectoryFileFilter (var myPB: CInfoPBRec; ignored: Ptr): boolean;
  86.     begin
  87.         ignored := ignored; { Unused }
  88.         MyCustomGetDirectoryFileFilter := (BAND(myPB.ioFlAttrib, kFolderBit) = 0) | (BAND(myPB.ioDrUsrWds.frFlags, $4000) <> 0);
  89.     end;
  90.  
  91.  
  92. {******************************************************************************}
  93. { MyCustomGetDirectoryDlogHook                                                 }
  94. {                                                                              }
  95. {     This function lets us process item hits in the GetFolderDialog.  We're   }
  96. {     only interested if the user hit the selectFolder button. We pass all     }
  97. {     other item hits back to ModalDialog.                                     }
  98. {******************************************************************************}
  99.  
  100.     function MyCustomGetDirectoryDlogHook (item: integer; theDialog: DialogPtr; myDataPtr: Ptr): integer;
  101.  
  102.         procedure SetButtonTitle (name: Str255);
  103.             var
  104.                 resultCode: integer;
  105.                 width: integer;
  106.                 TmpStr, left, right: str255;
  107.                 itemType: integer;
  108.                 itemHandle: handle;
  109.                 itemRect: rect;
  110.                 p: integer;
  111.         begin
  112.             if gCurrentSelectedFolder <> name then begin
  113.                 GetDialogItem(theDialog, rGetFolderSelectString, itemType, itemHandle, itemRect);
  114.                 GetDialogItemText(itemHandle, TmpStr);
  115.                 p := TPPos('^1', TmpStr);
  116.                 left := TPCopy(TmpStr, 1, p - 1);
  117.                 right := TPCopy(TmpStr, p + 2, 255);
  118.                 GetDialogItem(theDialog, rGetFolderButton, itemType, itemHandle, itemRect);
  119.                 gCurrentSelectedFolder := name;
  120.  
  121.     {*-------------------------------------------------------------------------}
  122.     { Find the width left over in the button after drawing the word 'Select'   }
  123.     { the quotation marks. Truncate the new name to this length.               }
  124.     {-------------------------------------------------------------------------*}
  125.                 width := (itemRect.right - itemRect.left) - StringWidth(concat(' ', left, right, ' '));
  126.  
  127.                 resultCode := TruncString(width, name, smTruncEnd);
  128.                 if resultCode < 0 then
  129.                     ;
  130.  
  131.                 TmpStr := concat(left, name, right);
  132.                 SetControlTitle(ControlHandle(itemHandle), TmpStr);
  133.                 ValidRect(itemRect);
  134.             end;
  135.         end;
  136.  
  137.         procedure SetFolderButtonTitle (vrn: integer; dirID: longInt);
  138.             var
  139.                 name: str63;
  140.                 pb: CInfoPBRec;
  141.                 oe: OSErr;
  142.         begin
  143.             pb.ioNamePtr := @name;
  144.             pb.ioVRefNum := vrn;
  145.             pb.ioDirID := dirID;
  146.             pb.ioFDirIndex := -1;
  147.             oe := PBGetCatInfoSync(@pb);
  148.  
  149.             if oe = noErr then begin
  150.                 SetButtonTitle(name);
  151.             end;
  152.         end;
  153.  
  154.         type
  155.             StandardFileReplyPtr = ^StandardFileReply;
  156.         var
  157.             itemType: integer;
  158.             itemRect: Rect;
  159.             itemHandle: Handle;
  160.             mySFRPtr: StandardFileReplyPtr;
  161.     begin
  162.  
  163.     {*-------------------------------------------------------------------------}
  164.     { CustomGet calls dialog hook for both main and subsidiary dialog boxes.   }
  165.     { Make sure that dialog record indicates that this is the main GetFolder   }
  166.     { dialog.                                                                  }
  167.     {-------------------------------------------------------------------------*}
  168.         if OSType(WindowPeek(theDialog)^.refCon) = sfMainDialogRefCon then begin
  169.  
  170.             mySFRPtr := StandardFileReplyPtr(myDataPtr);
  171.  
  172.             if item = sfHookFirstCall then begin
  173.  
  174.             {*-----------------------------------------------------------------}
  175.             { Set the prompt displayed above the file list...                  }
  176.             {-----------------------------------------------------------------*}
  177.                 GetDialogItem(theDialog, rGetFolderMessage, itemType, itemHandle, itemRect);
  178.                 SetDialogItemText(itemHandle, gCurrentSelectedFolder);
  179.                 gCurrentSelectedFolder := '';
  180.  
  181.             end else begin
  182. {    DebugStr(StringOf(ord(mySFRPtr^.sfIsFolder) <> 0, '"', mySFRPtr^.sfFile.name, '"', ';g'));}
  183.                 if (mySFRPtr^.sfFile.name = '') then begin
  184.                     GetSFLocation(mySFRPtr^.sfFile.vRefNum, mySFRPtr^.sfFile.parID); { these aren't always set properly }
  185.                     mySFRPtr^.sfFile.name := '';
  186.                     SetFolderButtonTitle(mySFRPtr^.sfFile.vRefNum, mySFRPtr^.sfFile.parID);
  187.                 end else begin
  188.                     SetButtonTitle(mySFRPtr^.sfFile.name);
  189.                 end;
  190.             end;
  191.  
  192.             if item = rGetFolderButton then begin
  193.                 item := sfItemCancelButton;
  194.                 mySFRPtr^.sfGood := true;
  195.             end;
  196.  
  197.         end;
  198.         MyCustomGetDirectoryDlogHook := item;
  199.     end;
  200.  
  201.  
  202. {******************************************************************************}
  203. { StandardGetFolder                                                            }
  204. {                                                                              }
  205. {     The StandardGetFolder function. You pass it the point where you want the }
  206. {     standard file dialog box drawn, the prompt to display above the file     }
  207. {     list, and a pointer to an StandardFileReply record.                      }
  208. {                                                                              }
  209. {     Upon return, the sfFile field of the SFReply record contains the volume  }
  210. {     reference number and directory ID that specify the folder the user       }
  211. {     chose. It also passes back the name of the chosen folder.  The sfGood    }
  212. {     field is set to true if the user chose a folder, or false if not.        }
  213. {******************************************************************************}
  214.  
  215.     procedure StandardGetFolder (where: Point; message: Str255; var mySFReply: StandardFileReply);
  216.         var
  217.             theTypeList: SFTypeList;
  218.             pb: CInfoPBRec;
  219.             isfolder, wasaliased: boolean;
  220.             oe: OSErr;
  221.     begin
  222.     {*-------------------------------------------------------------------------}
  223.     { Copy the prompt to be displayed above the file list into gCurrentSelectedFolder  }
  224.     { When MyCustomGetDirectoryDlogHook is called for   }
  225.     { the first time, it will use this info to draw the prompt.                }
  226.     {-------------------------------------------------------------------------*}
  227.         gCurrentSelectedFolder := message;
  228.  
  229.     {*-------------------------------------------------------------------------}
  230.     { Call CustomGetFile. Pass it a pointer to the file filter and dialog      }
  231.     { hook functions. Also pass a pointer to mySFReply in the user data field. }
  232.     {-------------------------------------------------------------------------*}
  233.         CustomGetFile(@MyCustomGetDirectoryFileFilter, -1, @theTypeList, mySFReply, rGetFolderDialog, where, @MyCustomGetDirectoryDlogHook, nil, nil, nil, @mySFReply);
  234.  
  235.     {*-------------------------------------------------------------------------}
  236.     { Ok, now the reply record contains the volume reference number and the    }
  237.     { name of the selected folder. We need to use PBGetCatInfo to get the      }
  238.     { directory ID of the selected folder.                                     }
  239.     {-------------------------------------------------------------------------*}
  240.         if mySFReply.sfGood then begin { Don't call PBGetCatInfo on cancel! }
  241.  
  242.             if mySFReply.sfFile.name <> '' then begin
  243.                 oe := ResolveAliasFile(mySFReply.sfFile, true, isfolder, wasaliased);
  244.                 if (oe = noErr) & not isfolder then
  245.                     DebugStr('Not folder?');
  246.                 if oe = noErr then begin
  247.                     pb.ioVRefNum := mySFReply.sfFile.vRefNum;
  248.                     pb.ioDirID := mySFReply.sfFile.parID;
  249.                     pb.ioNamePtr := @mySFReply.sfFile.name;
  250.                     pb.ioFDirIndex := 0;
  251.  
  252.                     oe := PBGetCatInfoSync(@pb);
  253.                 end;
  254.                 mySFReply.sfGood := oe = noErr;
  255.  
  256.                 mySFReply.sfFile.parID := pb.ioDrDirID;
  257.                 mySFReply.sfFile.name := '';
  258.             end;
  259. {    DebugStr(StringOf(oe, mySFReply.sfGood, mySFReply.sfFile.vRefNum, mySFReply.sfFile.parID, ';g'));}
  260.             if oe = noErr then begin
  261.                 pb.ioVRefNum := mySFReply.sfFile.vRefNum;
  262.                 pb.ioDirID := mySFReply.sfFile.parID;
  263.                 pb.ioNamePtr := @mySFReply.sfFile.name;
  264.                 pb.ioFDirIndex := -1;
  265.                 oe := PBGetCatInfoSync(@pb);
  266.             end;
  267. {    DebugStr(StringOf(oe, mySFReply.sfFile.vRefNum, mySFReply.sfFile.parID, '"', mySFReply.sfFile.name, '"', ';g'));}
  268.         end;
  269.  
  270.     end;
  271.  
  272. end.