TestDrive Super Store 3.0/TESTDRIVE_3.ISO/realizer/formdev/savefile.rlz

Text File | 1992-09-30 | 5.5 KB | 200 lines

'***********************************************************************
'    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