home *** CD-ROM | disk | FTP | other *** search
- ; Copyright (c) 1987-1989 Borland International. All Rights Reserved.
- ;
- ; General permission to re-distribute all or part of this script is granted,
- ; provided that this statement, including the above copyright notice, is not
- ; removed. You may add your own copyright notice to secure copyright
- ; protection for new matter that you add to this script, but Borland
- ; International will not support, nor assume any legal responsibility for,
- ; material added or changes made to this script.
- ;
- ; Revs.: MJP 5/20/87, DCY 12/13/88
- ; ****************************************************************************
- ; GetFile prompts a user to enter a file name in Paradox fashion. That is, a
- ; user can either enter a file name or just press [Enter] for a sub-menu of
- ; files in the current (or otherwise specified) directory.
- ;
- ; If a user presses [Esc], GetFile returns a null ("") string. Otherwise, it
- ; returns the file name selected.
- ;
- ; GetFile requires the following arguments:
- ;
- ; Mask: File mask of acceptable file names and files to be displayed in
- ; sub-menu (e.g. "??Table.DB", "*.SC")
- ; Prmpt: Prompt to appear on top prompt line (e.g., "Table:", "Script:")
- ; Msg: Message to display underneath prompt line
- ; FName: Default file name (or null string "" for none)
- ; Rqd: (Logical) If True, requires file name to already exist
- ;
- ; NOTE: There is no way to specify that the file cannot exist, because it
- ; is not clear what to do if it does. (Put up a "Cancel/Replace"
- ; menu? Put up a Cancel/Modify/Replace menu? Disallow the
- ; selection entirely?)
- ;
- Proc GetFile(Mask,Prmpt,Msg,FName,Rqd)
- Private;Mask ;Specifies which files to display
- ;Prmpt ;Top prompt line
- ;Msg ;Second prompt line
- ;FName ;Currently selected file name
- ;Rqd ;Determines whether file must already exist
- Ext, ;Stores the file extension of the mask
- OldMask, ;Stores the original mask, as it is subject to change
- OldFName, ;Stores current FName before destroyed by show command
- AWidth, ;Maximum width for Accept, based upon length of Prmpt
- X ;General purpose scratch variable
-
- X = Match(Mask,"..\".\"..",X,Ext)
- Ext = "." + Upper(Ext)
- OldMask = Mask
- AWidth = "A"+Strval(79-Len(Prmpt))
-
- Style Attribute SysColor(0)
- While True
- Canvas Off
- @ 0,0 ;Display prompt information
- ?? Spaces(80)+Msg+Spaces(80-Len(Msg))
- @ 0,0
- ?? Prmpt+" "
- Canvas On
- Accept AWidth ;Accept the file name
- Default FName
- To FName
- Switch
- Case not Retval: ;Esc was pressed
- Style
- Return ""
- Case IsBlank(FName) or DirExists(FName)=1: ;Enter was pressed
- If Match(FName,"..@",X,X) ;Is FName non-blank?
- Then If X <> "\\" and X <> ":" ;Is last character "\"?
- Then FName = FName+"\\" ;Append backslash to
- Endif ; directory name
- X = Search(".",Mask)-1 ;Remove dirname from mask
- While Substr(Mask,X,1) <> "\\" and Substr(Mask,X,1) <> ":"
- and X > 0
- X = X-1
- Endwhile
- Mask = FName+Substr(Mask,X+1,255);Ignore specified
- Endif ; directory name since the
- OldFName = FName ; user specified one
- ShowFiles ;Show specified files
- NoExt
- Mask
- Prmpt+" "+FName
- To FName
- If FName = "None" ;No files were selected by Mask
- Then Message "None found"
- Endif
- If FName = "Esc" or FName = "None" ;User did not select a file
- Then FName = OldFName ;Restore user-specified file name
- Mask = OldMask ;Restore original mask value
- Else Style
- Return OldFName+FName ;Attach path name to file name
- Endif
- Case Rqd: ;File must already exist
- Switch
- Case DirExists(FName) = -1: ;Assumes valid directory names
- Message "Invalid file name" ; are valid file names
- Case IsFile(FName+Ext):
- Style
- Return FName
- Otherwise:
- Message FName+" does not exist"
- Endswitch
- Otherwise: ;We don't care if file name exists
- If DirExists(FName) = -1 ;Make sure it's a valid name
- Then Message "Invalid file name"
- Else If Substr(FName,Len(FName),1) = "\\"
- Then Message FName+" does not exist"
- Else Style
- Return FName
- Endif
- Endif
- Endswitch
- Endwhile
- Endproc
-