OS/2 Shareware BBS: 18 REXX/18-REXX.zip/vxdemo.zip/SYSTEM.$$$/VRMESS.VRM

Text File | 1993-09-01 | 5KB | 229 lines

/* Custom mainline for macro */

    call RXFuncAdd "VRLoadFuncs", "VROBJ", "VRLoadFuncs"
    call VRLoadFuncs

    _VREVersion = SubWord( VRVersion( "VRObj" ), 1, 1 )
    if( _VREVersion < 1.01 )then do
        call VRMessage "", "This program requires VX-REXX version 1.01 to run", "Error!"
        _VREReturnValue = 32000
        signal _VRELeaveMain
    end

    signal on SYNTAX name _VRESyntax
    signal _VREMain

_VRESyntax:
    parse source . . _VRESourceSpec
    call VRMessage "", "Syntax error in" _VRESourceSpec "line" SIGL, "Error!"
    _VREReturnValue = 32000
    signal _VRELeaveMain

_VREMain:
/*:VRX         Main
*/
/*  Main
*/
Main:
/*  Process the arguments.
    Get the parent window.
*/
    parse source . calledAs .
    parent = ""
    argCount = arg()
    argOff = 0
    if( calledAs \= "COMMAND" )then do
        if argCount >= 1 then do
            parent = arg(1)
            argCount = argCount - 1
            argOff = 1
        end
    end
    InitArgs.0 = argCount
    if( argCount > 0 )then do i = 1 to argCount
        InitArgs.i = arg( i + argOff )
    end
    drop calledAs argCount argOff

/*  Load the windows
*/
    call VRInit
    parse source . . spec
    _VREPrimaryWindowPath = ,
        VRParseFileName( spec, "dpn" ) || ".VRW"
    _VREPrimaryWindow = ,
        VRLoad( parent, _VREPrimaryWindowPath )
    drop parent spec
    if( _VREPrimaryWindow == "" )then do
        call VRMessage "", "Cannot load window:" VRError(), ,
            "Error!"
        _VREReturnValue = 32000
        signal _VRELeaveMain
    end

/*  Process events
*/
    call Init
    signal on halt
    do while( \ VRGet( _VREPrimaryWindow, "Shutdown" ) )
        _VREEvent = VREvent()
        interpret _VREEvent
    end
_VREHalt:
    _VREReturnValue = Fini()
    call VRDestroy _VREPrimaryWindow
_VRELeaveMain:
    call VRFini
exit _VREReturnValue

VRLoadSecondary: procedure
    name = arg( 1 )

    window = VRLoad( VRWindow(), VRWindowPath(), name )
    call VRMethod window, "CenterWindow"
    call VRSet window, "Visible", 1
    call VRMethod window, "Activate"
return window

/*:VRX         Comments
*/
Comments:
/*
    VRMess: Generate a prototype for the VRMessage function

    Usage:  call VRMess <Parent>

    Where:  Parent is the parent window for the dialog

*/
return

/*:VRX         Error
*/
Error: procedure
    field = arg( 1 )
    error = arg( 2 )
    call VRMessage VRWindow(), error, "Error"
    call VRMethod field, "SetFocus"
return

/*:VRX         Fini
*/
Fini:
    window = VRWindow()
    call VRSet window, "Visible", 0
    drop window
return Prototype

/*:VRX         Halt
*/
Halt:
    signal _VREHalt
return

/*:VRX         Init
*/
Init:

    Prototype = ""
    call VRSet "IType", "Value", "None"

    window = VRWindow()
    call VRMethod window, "CenterWindow"
    call VRSet window, "Visible", 1
    call VRMethod window, "Activate"
    drop window
return

/*:VRX         PB_1_Click
*/
PB_1_Click:

    parent = 'VRWindow()'

    text = VRGet( "Text", "Value" )
    if VRGet( "Quotes2", "Set" ) then do
        text = '"' || text || '"'
    end

    title = VRGet( "Title", "Value" )
    if VRGet( "Quotes1", "Set" ) then do
        title = '"' || title || '"'
    end

    itype = VRGet( "IType", "Value" )
    itype = '"' || itype || '"'

    buttons = ""
    gbuttonlist = VRGet( "Quotes5", "Set" )
    if gbuttonlist then do
        buttonlist = VRGet( "Buttonlist", "Value" )
        sepchar = Left( buttonlist, 1 )
        i = 0
        interpret "parse var buttonlist '" || sepchar || "' buttonlist"
        do while buttonlist \= ""
            interpret "parse var buttonlist item '" || sepchar || "' buttonlist"
            if item \= "" then do
                i = i + 1
                Prototype = Prototype || 'Buttons.' || i ||,
                            ' = "' || item || '"' || "0d0a"x
            end
        end
        if i > 0 then do
            Prototype = Prototype || "Buttons.0 = " ||,
                        i || '0d0a'x || '0d0a'x
            buttons = '"Buttons."'
        end
    end
    else do
        buttonlist = VRGet( "Buttonlist", "Value" )
        if buttonlist \= "" then do
            if Lastpos( ".", buttonlist ) \= length( buttonlist ) then do
                call Error "Button list", "The button list must be a stem variable, followed by a period."
                return
            end
        end
        buttons = '"' || buttonlist || '"'
    end

    default = VRGet( "Default", "Value" )
    escape = VRGet( "Escape", "Value" )

    Prototype = Prototype || 'id = VRMessage( ' || parent ||,
                ', ' || text || ', ' || title ||,
                ', ' || itype || ', ' || buttons ||,
                ', ' || default || ', ' || escape || ' )'

    call Quit

return

/*:VRX         PB_2_Click
*/
PB_2_Click:
    rc = ""
    call Quit
return

/*:VRX         PB_3_Click
*/
PB_3_Click:
    "view a2z.inf VRMessage function"
return

/*:VRX         Quit
*/
Quit:
    window = VRWindow()
    call VRSet window, "Shutdown", 1
    drop window
return

/*:VRX         Window1_Close
*/
Window1_Close:
    rc = ""
    call Quit
return