home *** CD-ROM | disk | FTP | other *** search
- '***********************************************************************
- ' FormDev: SaveFile.RLZ
- '
- ' Copyright ⌐ 1991-1992 Computer Associates International, Inc.
- ' All rights reserved.
- '
- '***********************************************************************
-
- PROC FDShutdown ()
- IF SaveIfChanged("Save current form before exiting FormDev?") = _Cancel THEN
- EXIT PROC
- END IF
- ' Reset the world.
- RESET _All - _Log
- EXIT PROGRAM
- END PROC
-
- PROC ShutdownProc (v)
- IF v[_Invoke] = _Close THEN
- FDShutdown()
- v[_UseRealizer] = 0
- END IF
- END PROC
-
- FUNC SaveIfChanged(message)
- IF fdChanged THEN
- SELECT CASE MessageBox(message, "FormDev", _MB_YesNoCancel, _MB_Question)
- CASE _Yes
- IF SaveForm(1) = 0 THEN
- RETURN _Cancel
- END IF
- RETURN _Yes
- CASE _No
- RETURN _No
- CASE _Cancel
- RETURN _Cancel
- END SELECT
- END IF
- RETURN 0
- END FUNC
-
- FUNC ReplaceDlg(fName)
- SELECT CASE MessageBox("Replace existing " + fName + "?", "FormDev", _MB_YesNoCancel, _MB_Question)
- CASE _Yes
- RETURN 1
- CASE _No, _Cancel
- RETURN 0
- END SELECT
- END FUNC
-
- FUNC SaveForm(sType)
- 'sType = 0 for save and 1 for save as
-
- LOCAL fdSaveForm, fdFileName, fdFileDir, fdOutLog, fdOutFile, badDir
- LOCAL dirPart, filePart
-
- PROC SetGrayNormal (toNormal; ..)
- LOCAL rsAttr, J
- rsAttr = IF toNormal THEN _Normal ELSE _Gray
- FOR J = 1 TO QNOptMods
- FormModifyObject(QOptMod(J), rsAttr)
- NEXT
- END PROC
-
- fdFileDir = LCase$(fdOpenPath)
- fdSaveForm = FormQUnique
- FormNew(fdSaveForm; "Save File", _Title)
- FormControl(_Size; _Center, _Center, 50 pct, 80 pct)
-
- FormSetObject(10, _CaptionLeft, "Directory:", 3 pct, 4 pct)
- FormSetObject(14, _CaptionLeft, "Form Name:", 3 pct, 14 pct)
- IF sType THEN
- FormSetObject(11, _TextBox, fdFileDir, 34 pct, 3 pct, 61 pct, _Default)
- FormSetObject(15, _TextBox, theform.name, 34 pct, 13 pct, 61 pct, _Default)
- ELSE
- FormSetObject(11, _CaptionLeft, fdFileDir, 35 pct, 4 pct)
- FormSetObject(15, _CaptionLeft, theform.name, 35 pct, 14 pct)
- END IF
-
- FormSetObject(20, _CheckBox, "Generate Code", 10 pct, 24 pct; _Notify, bitand(theform.saveflags, 1))
-
- FormSetObject(30, _GroupBox, "Generate:", 7 pct, 34 pct, 86 pct, 49 pct)
- FormSetObject(40, _OptionButton, "Form creation code only", 10 pct, 41 pct; bitand(theform.saveflags, 4))
- FormSetObject(50, _OptionButton, "Form creation and processing", 10 pct, 51 pct; bitand(theform.saveflags, 8))
- FormSetObject(60, _OptionButton, "Full application", 10 pct, 61 pct; bitand(theform.saveflags, 16))
- FormSetObject(70, _CheckBox, "Show code", 10 pct, 71 pct; bitand(theform.saveflags, 2))
- SetGrayNormal(FormQNum(20); 40, 50, 60, 70)
-
- FormSetObject(1, _DefButton, "OK", _Left, _Bottom)
- FormSetObject(2, _Button, "Cancel", _Right, _Bottom)
- LOOP
- FormSelect(fdSaveForm)
- LOOP
- SELECT CASE FormWait
- CASE 2
- FormControl(_Close)
- FormSelect(fdMain)
- RETURN 0
- CASE 1
- IF ValidFormName(FormQStr(15)) THEN
- EXIT LOOP
- END IF
- FormSetFoc(15)
- CASE 20
- SetGrayNormal(FormQNum(20); 40, 50, 60, 70)
- END SELECT
- END LOOP
- theform.saveflags = FormQNum(20) + 2*FormQNum(70) + 4*FormQNum(40) + 8*FormQNum(50) + 16*FormQNum(60)
- fdFileDir = FormQStr(11)
- IF FileQ(fdFileDir, _Directory) THEN
- badDir = 0
- ELSEIF Len(fdFileDir) = 2 AND Right$(fdFileDir, 1) = ":" THEN
- badDir = 2
- ELSEIF Len(fdFileDir) = 3 AND Right$(fdFileDir, 2) = ":\" THEN
- badDir = 2
- ELSE
- badDir = 1
- END IF
- IF badDir = 2 THEN
- IF FileQ(fdFileDir + ".", _Directory) THEN
- badDir = 0
- fdFileDir = fdFileDir + "."
- END IF
- END IF
- IF badDir THEN
- INPUT "Invalid directory.", "FormDev";
- FormSetFoc(11)
- ELSE
- IF Right$(fdFileDir, 1) <> "\" THEN
- fdFileDir = fdFileDir + "\"
- END IF
- fdFileName = fdFileDir + FormQStr(15) + ".RFD"
- IF FDParseFN(fdFileName, ".RFD", dirPart, filePart) THEN
- SELECT CASE FileQ(fdFileName, _Exists)
- CASE 0 ' File doesn't exist
- EXIT LOOP
- CASE 1 ' File exists
- IF sType = 0 THEN
- EXIT LOOP
- END IF
- IF ReplaceDlg(fdFileName) THEN
- EXIT LOOP
- END IF
- CASE 2 ' File Read-ONLY
- INPUT "Unable to write to a Read-Only file.", "FormDev";
- FormSetFoc(15)
- END SELECT
- END IF
- END IF
- END LOOP
- FormSelect(fdSaveForm)
- FormControl(_Close)
- FormSelect(fdMain)
- fdOpenPath = dirPart
- theform.name = filePart
-
- SetHourglass
-
- fdChanged = 0
- MainFormLocate
- ItemsLocateAll
-
- 'Write the RFD file out
- ItemsIntoRaw
- fdFileName = fdOpenPath + theform.name
- IF fdNumItems > 0 THEN
- FileExport(fdFileName + ".RFD", _Realizer, _Named, theform, item, fonts, fdNumItems, fdNextItem)
- ELSE
- FileExport(fdFileName + ".RFD", _Realizer, _Named, theform, fonts, fdNumItems, fdNextItem)
- END IF
- ItemsIntoPixels
-
- fdFormSaved = 1
- IF bitand(theform.saveflags, 1) THEN
- fdOutLog = LogQUnique
- LogNew(fdOutLog; fdFileName + ".code")
- IF NOT(GenerateCode(fdOutLog, theform.saveflags)) THEN
- ResetHourglass
- INPUT "The form was saved, but the code generation failed.", "FormDev";
- RETURN 0
- ELSE
- 'Write out source file.
- fdOutFile = FileQUnique
- FileOpen(fdOutFile, fdFileName + ".RLZ", _Write)
- FileWrite(fdOutFile, LogQStr(1))
- FileClose(fdOutFile)
- ResetHourglass
- IF bitand(theform.saveflags, 2) THEN
- LogControl(_Show)
- ELSE
- INPUT "Code generation complete.", "FormDev";
- LogControl(_Close)
- END IF
- END IF
- END IF
-
- ResetHourglass
- RETURN 1
- END FUNC
-