home *** CD-ROM | disk | FTP | other *** search
/ TestDrive Super Store 2.3 / TESTDRIVE_2.ISO / realizer / formdev / menufile.rlz < prev    next >
Encoding:
Text File  |  1992-09-30  |  2.9 KB  |  128 lines
  1. '***********************************************************************
  2. '    FormDev: MenuFile.RLZ
  3. '
  4. '    Copyright ⌐ 1991-1992 Computer Associates International, Inc.
  5. '    All rights reserved.
  6. '
  7. '***********************************************************************
  8.  
  9. FUNC FDParseFN (str, extension, dirPart, filePart)
  10. 'Sets dirPart and filePart if successful.  Otherwise, does not touch them.
  11. 'If extension is specified, succeed only if that extension is in str.
  12. 'Also, if extension is specified, the extension is stripped from filePart.
  13.     LOCAL    s1, oldCS, any, J
  14.  
  15.     IF str = "" THEN
  16.         RETURN 0
  17.     END IF
  18.     s1 = FileQ(str, _Name)            ' into a local copy
  19.     IF extension <> "" THEN
  20.         oldCS = QSys(_CaseSensitive)
  21.         SetSys(_CaseSensitive, 0)
  22.         J = InStr(s1, extension)
  23.         SetSys(_CaseSensitive, oldCS)
  24.     ELSE
  25.         J = 1
  26.     END IF
  27.     IF J THEN
  28.         J = 0
  29.         any = InStr(s1, "\", J + 1)
  30.         WHILE any
  31.             J = any
  32.             any = InStr(s1, "\", J + 1)
  33.         END WHILE
  34.         IF J THEN
  35.             dirPart = LEFT$(s1, J)
  36.             filePart = RIGHT$(str, LEN(s1) - J)
  37.             IF extension <> "" THEN
  38.                 filePart = LEFT$(filePart, LEN(filePart) - LEN(extension))
  39.             END IF
  40.         END IF
  41.     ELSE
  42.         J = 0
  43.     END IF
  44.     IF NOT J THEN
  45.         IF extension <> "" THEN
  46.             s1 = extension + " "
  47.         ELSE
  48.             s1 = ""
  49.         END IF
  50.         INPUT "Invalid " + s1 + "filename: """ + str + """.", "FormDev";
  51.         RETURN 0
  52.     END IF
  53.     RETURN 1
  54. END FUNC
  55.  
  56.  
  57. PROC menuprocFile(params)
  58.     LOCAL    rm, fdFileName
  59.  
  60.     SELECT CASE params[_ItemNum]
  61.         CASE 100            ' New Form.
  62.             IF SaveIfChanged("Save current form before creating new form?") = _Cancel THEN
  63.                 EXIT PROC
  64.             END IF
  65.             IF FormQ(_Exists; fdMain) THEN
  66.                 lastFrameNum = 0
  67.                 FormSelect(fdMain)
  68.                 FormControl(_Close)
  69.             END IF
  70.             MainFormNew
  71.             MainFormCreate
  72.             fdChanged = 0
  73.             fdFormSaved = 0
  74.             FormSelect(fdMain)
  75.             FormControl(_Show)
  76.  
  77.         CASE 110            ' Open Form
  78.             IF SaveIfChanged("Save current form before opening new form?") = _Cancel THEN
  79.                 EXIT PROC
  80.             END IF
  81.             IF NOT FDParseFN(StdOpen(fdOpenPath + "*.rfd"), ".RFD", fdOpenPath, theform.name) THEN
  82.                 EXIT PROC
  83.             END IF
  84.  
  85.             IF FormQ(_Exists; fdMain) THEN
  86.                 lastFrameNum = 0
  87.                 FormSelect(fdMain)
  88.                 FormControl(_Close)
  89.             END IF
  90.  
  91.             SetHourglass
  92.  
  93.             ' Load in form.
  94.             fdFileName = theform.name
  95.             CLEAR form
  96.             FileImport(fdOpenPath + fdFileName + ".RFD", _Realizer, _Named)
  97.             IF NOT QVar(theform.font) THEN
  98.                 theform.font = 0
  99.                 theform.fldC = ColorPack(_White)
  100.                 theform.txtC = ColorPack(_Black)
  101.             END IF
  102.  
  103.             FdFontLoadAll
  104.             RecalcPixelsFromRaw
  105.             MainClientLocate
  106.             ItemsIntoPixels
  107.  
  108.             MainFormCreate
  109.             FOR i = 1 TO fdNumItems
  110.                 SafeSetObject(i, 0)
  111.             NEXT i
  112.             FormControl(_Show)
  113.             fdChanged = 0
  114.             fdFormSaved = 1
  115.  
  116.             ResetHourglass
  117.  
  118.         CASE 130                                        ' Save Form
  119.             rm = SaveForm(NOT fdFormSaved)
  120.  
  121.         CASE 140                                        ' Save As Form
  122.             rm = SaveForm(1)
  123.  
  124.         CASE 190                                        ' Exit
  125.             FDShutdown
  126.     END SELECT
  127. END PROC
  128.