home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 18 REXX
/
18-REXX.zip
/
rxbas223.zip
/
RXBASMAC.VRM
< prev
next >
Wrap
Text File
|
1995-07-23
|
15KB
|
509 lines
/* Custom mainline for macro */
call RXFuncAdd "VRLoadFuncs", "VROBJ", "VRLoadFuncs"
call VRLoadFuncs
_VREVersion = SubWord( VRVersion( "VRObj" ), 1, 1 )
if( _VREVersion < 2.10 )then do
call VRMessage "", "This program requires VX-REXX version 2.1 to run.", "Error!"
return 32000
end
signal on SYNTAX name _VRESyntax
signal _VREMain
_VRESyntax:
parse source . . _VRESourceSpec
call VRMessage "", "Syntax error in" _VRESourceSpec "line" SIGL":" ErrorText(rc), "Error!"
call VRFini
exit 32000
_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; else do
call VROptions 'ImplicitNames'
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:
__vrlsWait = abbrev( 'WAIT', translate(arg(2)), 1 )
if __vrlsWait then do
call VRFlush
end
__vrlsHWnd = VRLoad( VRWindow(), VRWindowPath(), arg(1) )
if __vrlsHWnd = '' then signal __vrlsDone
if __vrlsWait \= 1 then signal __vrlsDone
call VRSet __vrlsHWnd, 'WindowMode', 'Modal'
__vrlsTmp = __vrlsWindows.0
if( DataType(__vrlsTmp) \= 'NUM' ) then do
__vrlsTmp = 1
end
else do
__vrlsTmp = __vrlsTmp + 1
end
__vrlsWindows.__vrlsTmp = VRWindow( __vrlsHWnd )
__vrlsWindows.0 = __vrlsTmp
do while( VRIsValidObject( VRWindow() ) = 1 )
__vrlsEvent = VREvent()
interpret __vrlsEvent
end
__vrlsTmp = __vrlsWindows.0
__vrlsWindows.0 = __vrlsTmp - 1
call VRWindow __vrlsWindows.__vrlsTmp
__vrlsHWnd = ''
__vrlsDone:
return __vrlsHWnd
/*:VRX Cancel_Click
*/
Cancel_Click:
ResultString = ""
call Quit
return
/*:VRX DisableGenFunc
*/
DisableGenFunc:
/* Set the GenFunc-Objects disabled */
call VRSet 'DT_Functionname', 'Enabled', 0
call VRSet 'DT_Para1', 'Enabled', 0
call VRSet 'DT_Para2', 'Enabled', 0
call VRSet 'DT_Para3', 'Enabled', 0
call VRSet 'DT_Para4', 'Enabled', 0
call VRSet 'DT_Para1B', 'Enabled', 0
call VRSet 'DT_Para2B', 'Enabled', 0
call VRSet 'DT_Para3B', 'Enabled', 0
call VRSet 'DT_Para4B', 'Enabled', 0
call VRSet 'EF_Para1', 'Enabled', 0
call VRSet 'EF_Para2', 'Enabled', 0
call VRSet 'EF_Para3', 'Enabled', 0
call VRSet 'EF_Para4', 'Enabled', 0
call VRSet 'CB_Para1', 'Enabled', 0
call VRSet 'CB_Para2', 'Enabled', 0
call VRSet 'CB_Para3', 'Enabled', 0
call VRSet 'CB_Para4', 'Enabled', 0
return
/*:VRX DisableSetXXVar
*/
DisableSetXXVar:
/* Set the SetVar-objects disabled */
call VRSet 'RB_ConVarA', 'Enabled', 0
call VRSet 'RB_ConVarB', 'Enabled', 0
call VRSet 'RB_ConVarC', 'Enabled', 0
call VRSet 'RB_ConVarD', 'Enabled', 0
call VRSet 'DT_ConVarTitel', 'Enabled', 0
call VRSet 'DT_RB_ConVarA', 'Enabled', 0
call VRSet 'DT_RB_ConVarB', 'Enabled', 0
call VRSet 'DT_RB_ConVarC', 'Enabled', 0
call VRSet 'DT_RB_ConVarD', 'Enabled', 0
return
/*:VRX Fini
*/
Fini:
window = VRWindow()
call VRSet window, "Visible", 0
drop window
return ResultString
/*:VRX Halt
*/
Halt:
signal _VREHalt
return
/*:VRX Help_Click
*/
/* This routine is invoked when the user wants help for
the dialog... in this case I just invoke the help
for the REXXBASE called function */
Help_Click:
address cmd 'view rexxbase'
return
/*:VRX Init
*/
Init:
/* Before I display the window, I initialize things.
Note that InitArgs.1 is the argument string that
is passed to me from the MTC file. */
ResultString = ""
/* Ask for parameters and goto special routine: */
parse var InitArgs.2 Function'_'codetype'_'Para1'_'Para2'_'Para3'_'Para4
/* Check out the Layout of the parsed Function */
If codetype = 'GenFunc' then
If Para3 = '?RXBHEXACT' then
signal FindRec
else
signal GenFunc
If codetype = 'SetContVar' then signal SetContVar
If codetype = 'Getrxerror' then signal GetRxError
If codetype = 'InitRXBAS' then signal InitRXBAS
Genfunc:
/* -- */
/* Set the SetVar-objects disabled */
call DisableSetXXVar
If Para1 = '-' then do
call VRSet 'DT_Para1', 'Enabled', 0
call VRSet 'EF_Para1', 'Enabled', 0
call VRSet 'CB_Para1', 'Enabled', 0
end
If Para2 = '-' then do
call VRSet 'DT_Para2', 'Enabled', 0
call VRSet 'EF_Para2', 'Enabled', 0
call VRSet 'CB_Para2', 'Enabled', 0
end
If Para3 = '-' then do
call VRSet 'DT_Para3', 'Enabled', 0
call VRSet 'EF_Para3', 'Enabled', 0
call VRSet 'CB_Para3', 'Enabled', 0
end
If Para4 = '-' then do
call VRSet 'DT_Para4', 'Enabled', 0
call VRSet 'EF_Para4', 'Enabled', 0
call VRSet 'CB_Para4', 'Enabled', 0
end
/* Set the titles of the Generate-Function-objects (GenFunc) */
call VRSet 'DT_Functionname', 'Caption', 'Function: rexxbase_'Function
call VRSet 'DT_Para1', 'Caption', Para1
call VRSet 'DT_Para2', 'Caption', Para2
call VRSet 'DT_Para3', 'Caption', Para3
call VRSet 'DT_Para4', 'Caption', Para4
call VRSet 'DT_Para1B', 'Caption', 'Quote 'Para1
call VRSet 'DT_Para2B', 'Caption', 'Quote 'Para2
call VRSet 'DT_Para3B', 'Caption', 'Quote 'Para3
call VRSet 'DT_Para4B', 'Caption', 'Quote 'Para4
/* Call the open-window-code */
signal ViewWindow
FindRec:
/* -- */
/* Set the SetVar-objects disabled */
call DisableSetXXVar
/* Change the visible objects from GenFunc to FindRec Values */
call VRSet 'DT_Para3', 'Visible', 0
call VRSet 'EF_Para3', 'Visible', 0
call VRSet 'DT_Para4B', 'Visible', 0
call VRSet 'DT_Para4', 'Visible', 0
call VRSet 'EF_Para4', 'Visible', 0
call VRSet 'CB_Para4', 'Visible', 0
call VRSet 'DT_Para3B', 'Caption', 'EXACT search'
/* Change Para3-Parts to EXACT-Search-Values */
call VRSet 'DT_Para3B', 'HintText', 'Check this, if RexxBase has to do an EXACT search'
call VRSet 'CB_Para3', 'HintText', 'Check this, if RexxBase has to do an EXACT search'
/* Set the titles of the Generate-Function-objects (GenFunc) */
call VRSet 'DT_Functionname', 'Caption', 'Function: rexxbase_'Function
call VRSet 'DT_Para1', 'Caption', Para1
call VRSet 'DT_Para2', 'Caption', Para2
call VRSet 'DT_Para3', 'Caption', Para3
call VRSet 'DT_Para4', 'Caption', Para4
/* Call the open-window-code */
signal ViewWindow
SetContVar:
/* Set the GenFunc-objects disabled */
call DisableGenFunc
call VRSet 'DT_Result', 'Enabled', 0
call VRSet 'EF_Result', 'Enabled', 0
/* Set the titles of the Control-Var objects */
call VRSet 'DT_ConVarTitel', 'Caption', 'Control Variable: rexxbase.'Function
If (Para1 \= '-') & (Para2 \= '-') & (Para3 = '-') & (Para4 = '-') then
do
call VRSet 'RB_ConVarC', 'Enabled', 0
call VRSet 'RB_ConVarD', 'Enabled', 0
call VRSet 'DT_RB_ConVarC', 'Enabled', 0
call VRSet 'DT_RB_ConVarD', 'Enabled', 0
call VRSet 'DT_RB_ConVarC', 'Caption', '-'
call VRSet 'DT_RB_ConVarD', 'Caption', '-'
end
else do
call VRSet 'DT_RB_ConVarC', 'Caption', 'Value: 'Para3
call VRSet 'DT_RB_ConVarD', 'Caption', 'Value: 'Para4
end
call VRSet 'DT_RB_ConVarA', 'Caption', 'Value: 'Para1
call VRSet 'DT_RB_ConVarB', 'Caption', 'Value: 'Para2
/* Call the open-window-code */
signal ViewWindow
SetFieldVar:
/* Set the GenFunc-Objects disabled */
call DisableGenFunc
/* ...but enable the 1st field for the databasename and the Functiontitle */
call VRSet 'DT_Para1', 'Enabled', 1
call VRSet 'EF_Para1', 'Enabled', 1
call VRSet 'CB_Para1', 'Enabled', 1
call VRSet 'DT_Para1B', 'Enabled', 1
call VRSet 'DT_Functionname', 'Caption', 'Field-Variable: '
/* ...and if required, the 2nd for the values */
If (translate(Function) = 'FIELDNAME') | (translate(Function) = 'INDEXFIELDNAME') | (translate(Function) = 'INDEXFILENAME') then
do
call VRSet 'DT_Para2', 'Enabled', 1
call VRSet 'EF_Para2', 'Enabled', 1
call VRSet 'CB_Para2', 'Enabled', 1
call VRSet 'DT_Para2B', 'Enabled', 1
/* Set the Title */
call VRSet 'DT_Para2', 'Caption', 'Field Number'
end
/* Set the Titles */
call VRSet
call VRSet 'DT_Para1', 'Caption', Para1
/* Change the visible Objects from SetContVar to SetFieldVar */
call UnvisibleSetVar
call VRSet 'DDCB_SetFieldVar', 'Visible', 1
/* Call the open-window-code */
signal ViewWindow
GetRxError:
/* Set the resultstring */
ResultString = 'RxbError = rexxbase.error'
/* exit the macro without starting the window */
call Quit
signal Ende
InitRXBAS:
/* Set the resultstring */
ResultString = " rc = rxFuncAdd( rexxbase_init, Rexxbase, 'Rexxbase_Init' )"'0d0a'x" rc = rexxbase_init()"
/* exit the macro without starting the window */
call Quit
signal Ende
ViewWindow:
window = VRWindow()
call VRMethod window, "CenterWindow"
call VRSet window, "Visible", 1
call VRMethod window, "Activate"
drop window
/* goto the end of the codefile */
signal Ende
Ende:
return
/*:VRX OK_Click
*/
OK_Click:
If codetype = 'GenFunc' then signal GenFuncOK
If codetype = 'SetContVar' then signal SetContVarOK
GenFuncOK:
If Para3 = '?RXBHEXACT' then signal FndRecrd
Para1 = VRGet( 'EF_Para1', 'Value' )
If Para1 \= '' then
If (VRGet( "CB_Para1", "Set" ) = 1) & (Datatype(Para1) \= 'NUM') then xPara1 = '"'Para1'"'
else xPara1 = Para1
Para2 = VRGet( 'EF_Para2', 'Value' )
If Para2 \= '' then
If (VRGet( "CB_Para2", "Set" ) = 1) & (Datatype(Para2) \= 'NUM') then xPara2 = '"'Para2'"'
else xPara2 = Para2
Para3 = VRGet( 'EF_Para3', 'Value' )
If Para3 \= '' then
If (VRGet( "CB_Para3", "Set" ) = 1) & (Datatype(Para3) \= 'NUM') then xPara3 = '"'Para3'"'
else xPara3 = Para3
Para4 = VRGet( 'EF_Para4', 'Value' )
If Para4 \= '' then
If (VRGet( "CB_Para4", "Set" ) = 1) & (Datatype(Para4) \= 'NUM') then xPara4 = '"'Para4'"'
else xPara4 = Para4
If (Para1 = '') & (Para2 = '') & (Para3 = '') & (Para4 = '') then
Params = ''
If (Para1 \= '') & (Para2 = '') & (Para3 = '') & (Para4 = '') then
Params = xPara1
If (Para1 \= '') & (Para2 \= '') & (Para3 = '') & (Para4 = '') then
Params = xPara1', 'xPara2
If (Para1 \= '') & (Para2 \= '') & (Para3 \= '') & (Para4 = '') then
Params = xPara1', 'xPara2', 'xPara3
If (Para1 \= '') & (Para2 \= '') & (Para3 \= '') & (Para4 \= '') then
Params = xPara1', 'xPara2', 'xPara3', 'xPara4
/* Create the ResultString */
result = VRGet( 'EF_result', 'Value' )
ResultString = 'Rxb'result' = rexxbase_'Function'( 'Params' )'
/* Jump to the end of the file */
signal Fileend
FndRecrd:
Para1 = VRGet( 'EF_Para1', 'Value' )
If Para1 \= '' then
If VRGet( "CB_Para1", "Set" ) = 1 then xPara1 = '"'Para1'"'
else xPara1 = Para1
Para2 = VRGet( 'EF_Para2', 'Value' )
If Para2 \= '' then
If VRGet( "CB_Para2", "Set" ) = 1 then xPara2 = '"'Para2'"'
else xPara2 = Para2
If VRGet( "CB_Para3", "Set" ) = 1 then
do
Para3 = 'EXACT'
end
else Para3 = ''
If (Para1 \= '') & (Para2 \= '') & (Para3 = '') then
Params = xPara1', 'xPara2
If (Para1 \= '') & (Para2 \= '') & (Para3 \= '') then
Params = xPara1', 'xPara2', 'Para3
/* Create the ResultString */
result = VRGet( 'EF_result', 'Value' )
ResultString = 'Rxb'result' = rexxbase_'Function'( 'Params' )'
/* Jump to the end of the File */
signal Fileend
SetContVarOK:
/* Ask, which RadioButton is set */
setA = VRGet( "RB_ConVarA", "Set" )
setB = VRGet( "RB_ConVarB", "Set" )
setC = VRGet( "RB_ConVarC", "Set" )
setD = VRGet( "RB_ConVarD", "Set" )
select
when setA = 1 then GeneralPara = Para1
when setB = 1 then GeneralPara = Para2
when setC = 1 then GeneralPara = Para3
otherwise GeneralPara = Para4
end
/* Create the ResultString */
If Datatype(GeneralPara) = 'NUM' then
ResultString = 'rexxbase.'Function' = 'GeneralPara
else
ResultString = 'rexxbase.'Function' = "'GeneralPara'"'
/* Jump to the end of the File */
signal Fileend
Fileend:
/* Close the codefile and the macro */
call Quit
return
/*:VRX Quit
*/
Quit:
window = VRWindow()
call VRSet window, "Shutdown", 1
drop window
return
/*:VRX UnvisibleSetVar
*/
UnvisibleSetVar:
/* Make the SetControlVariable Objects unvisible */
call VRSet 'RB_ConVarA', 'Visible', 0
call VRSet 'RB_ConVarB', 'Visible', 0
call VRSet 'RB_ConVarC', 'Visible', 0
call VRSet 'RB_ConVarD', 'Visible', 0
call VRSet 'DT_RB_ConVarA', 'Visible', 0
call VRSet 'DT_RB_ConVarB', 'Visible', 0
call VRSet 'DT_RB_ConVarC', 'Visible', 0
call VRSet 'DT_RB_ConVarD', 'Visible', 0
return
/*:VRX Window1_Close
*/
Window1_Close:
call Quit
return