home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / vxcliser.zip / VXREXX.3 / SYSTEM / SETTABS.VRM < prev    next >
Text File  |  1994-12-23  |  11KB  |  370 lines
  1. /* Custom mainline for macro */
  2.  
  3.     call RXFuncAdd "VRLoadFuncs", "VROBJ", "VRLoadFuncs"
  4.     call VRLoadFuncs
  5.  
  6.     _VREVersion = SubWord( VRVersion( "VRObj" ), 1, 1 )
  7.     if( _VREVersion < 2.10 )then do
  8.         call VRMessage "", "This program requires VX-REXX version 2.1 to run.", "Error!"
  9.         return 32000
  10.     end
  11.  
  12.     signal on SYNTAX name _VRESyntax
  13.     signal _VREMain
  14.  
  15. _VRESyntax:
  16.     parse source . . _VRESourceSpec
  17.     call VRMessage "", "Syntax error in" _VRESourceSpec "line" SIGL":" ErrorText(rc), "Error!"
  18.     call VRFini
  19.     exit 32000
  20.  
  21. _VREMain:
  22. /*:VRX         Main
  23. */
  24. /*  Main
  25. */
  26.     signal on novalue
  27.     signal Main
  28. novalue:
  29.     parse source . . source
  30.     call VRMessage "", "Novalue error in" source "line" SIGL, "Error!"
  31.     _VREReturnValue = 32000
  32.     signal _VRELeaveMain
  33.  
  34. Main:
  35. /*  Process the arguments.
  36.     Get the parent window.
  37. */
  38.     parse source . calledAs .
  39.     parent = ""
  40.     argCount = arg()
  41.     argOff = 0
  42.     if( calledAs \= "COMMAND" )then do
  43.         if argCount >= 1 then do
  44.             parent = arg(1)
  45.             argCount = argCount - 1
  46.             argOff = 1
  47.         end
  48.     end
  49.     InitArgs.0 = argCount
  50.     if( argCount > 0 )then do i = 1 to argCount
  51.         InitArgs.i = arg( i + argOff )
  52.     end
  53.     drop calledAs argCount argOff
  54.  
  55. /*  Load the windows
  56. */
  57.     call VRInit
  58.     parse source . . spec
  59.     _VREPrimaryWindowPath = ,
  60.         VRParseFileName( spec, "dpn" ) || ".VRW"
  61.     _VREPrimaryWindow = ,
  62.         VRLoad( parent, _VREPrimaryWindowPath )
  63.     drop parent spec
  64.     if( _VREPrimaryWindow == "" )then do
  65.         call VRMessage "", "Cannot load window:" VRError(), ,
  66.             "Error!"
  67.         _VREReturnValue = 32000
  68.         signal _VRELeaveMain
  69.     end
  70.  
  71. /*  Process events
  72. */
  73.     call Init
  74.     signal on halt
  75.     do while( \ VRGet( _VREPrimaryWindow, "Shutdown" ) )
  76.         _VREEvent = VREvent()
  77.         interpret _VREEvent
  78.     end
  79. _VREHalt:
  80.     _VREReturnValue = Fini()
  81.     call VRDestroy _VREPrimaryWindow
  82. _VRELeaveMain:
  83.     call VRFini
  84. exit _VREReturnValue
  85.  
  86. VRLoadSecondary: procedure
  87.     name = arg( 1 )
  88.  
  89.     window = VRLoad( VRWindow(), VRWindowPath(), name )
  90.     call VRMethod window, "CenterWindow"
  91.     call VRSet window, "Visible", 1
  92.     call VRMethod window, "Activate"
  93. return window
  94.  
  95. /*:VRX         AddRecord
  96. */
  97. /*  Add a record for an object to the container.
  98. */
  99. AddRecord: procedure expose Fields. Classes.
  100.     parse arg object, objPos
  101.     if( VRMethod( "Application", "SupportsProperty", object, "Caption" ) ) then do
  102.         text = VRGet( object, "Caption" )
  103.     end
  104.     else if( VRMethod( "Application", "SupportsProperty", object, "Value" ) ) then do
  105.         text = VRGet( object, "Value" )
  106.     end
  107.     else do
  108.         text = ""
  109.     end  
  110.     name = VRGet( object, "Name" )
  111.     icon = IconNb( object )
  112.     record = VRMethod( "CN_Objects", "AddRecord", , "Last", name, icon )
  113.  
  114.     call VRMethod "CN_Objects", "SetFieldData", record, Fields.!tab, VRGet( object, "TabIndex" )
  115.     call VRMethod "CN_Objects", "SetFieldData", record, Fields.!handle, object
  116.     call VRMethod "CN_Objects", "SetFieldData", record, Fields.!pos, objPos
  117.     call VRMethod "CN_Objects", "SetFieldData", record, Fields.!icon, icon
  118.     call VRMethod "CN_Objects", "SetFieldData", record, Fields.!name, name
  119.     call VRMethod "CN_Objects", "SetFieldData", record, Fields.!text, text
  120. return
  121.  
  122. /*  Return the resource number for an icon.
  123. */
  124. IconNb: procedure expose Classes.
  125.     parse arg object
  126.     class = VRGet( object, "ClassName" )
  127.  
  128.     select
  129.         when( class = "Pointer" ) then do
  130.             num = '#100:VREDIT'
  131.         end
  132.         when( class = "DescriptiveText" ) then do
  133.             num = '#101:VREDIT'
  134.         end
  135.         when( class = "GroupBox" ) then do
  136.             num = '#102:VREDIT'
  137.         end
  138.         when( class = "PushButton" ) then do
  139.             num = '#103:VREDIT'
  140.         end
  141.         when( class = "RadioButton" ) then do
  142.             num = '#104:VREDIT'
  143.         end
  144.         when( class = "CheckBox" ) then do
  145.             num = '#105:VREDIT'
  146.         end
  147.         when( class = "ImagePushButton" ) then do
  148.             num = '#106:VREDIT'
  149.         end
  150.         when( class = "ImageRadioButton" ) then do
  151.             num = '#107:VREDIT'
  152.         end
  153.         when( class = "PictureBox" ) then do
  154.             num = '#108:VREDIT'
  155.         end
  156.         when( class = "ListBox" ) then do
  157.             num = '#109:VREDIT'
  158.         end
  159.         when( class = "ComboBox" ) then do
  160.             num = '#110:VREDIT'
  161.         end
  162.         when( class = "DropDownComboBox" ) then do
  163.             num = '#111:VREDIT'
  164.         end
  165.         when( class = "EntryField" ) then do
  166.             num = '#112:VREDIT'
  167.         end
  168.         when( class = "MultiLineEntryField" ) then do
  169.             num = '#113:VREDIT'
  170.         end
  171.         when( class = "SpinButton" ) then do
  172.             num = '#114:VREDIT'
  173.         end
  174.         when( class = "ValueSet" ) then do
  175.             num = '#115:VREDIT'
  176.         end
  177.         when( class = "Slider" ) then do
  178.             num = '#116:VREDIT'
  179.         end
  180.         when( class = "Notebook" ) then do
  181.             num = '#117:VREDIT'
  182.         end
  183.         when( class = "Container" ) then do
  184.             num = '#118:VREDIT'
  185.         end
  186.         when( class = "DDEClient" ) then do
  187.             num = '#119:VREDIT'
  188.         end
  189.         when( class = "Timer" ) then do
  190.             num = '#120:VREDIT'
  191.         end
  192.         otherwise do
  193.             num = FindOtherIcon( class )
  194.         end
  195.     end
  196. return num 
  197.  
  198. FindOtherIcon: procedure expose Classes.
  199.     num = ""
  200.     class = translate( arg(1) )
  201.     if( Classes.0 = 0 )then do
  202.         call VRMethod 'Application', 'ListClasses', 'Classes.', 'L'
  203.         if( Classes.0 = 0 )then do
  204.             return num
  205.         end
  206.     end
  207.     do i = 1 to Classes.0
  208.         parse var Classes.i "classname='"name"'" . "picturepath='"path"'" "dllname='"dll"'" .
  209.         if( translate( name ) = class )then do
  210.             if( pos( ':', path ) \= 0 )then do
  211.                 num = path
  212.             end; else do
  213.                 num = path || ':' || dll
  214.             end
  215.             i = Classes.0 + 1
  216.         end
  217.     end
  218. return num
  219. /*:VRX         Fini
  220. */
  221. Fini:
  222.     window = VRWindow()
  223.     call VRSet window, "Visible", 0
  224.     drop window
  225. return 0
  226.  
  227. /*:VRX         Halt
  228. */
  229. Halt:
  230.     signal _VREHalt
  231. return
  232.  
  233.  
  234. /*:VRX         Init
  235. */
  236. /*  Assume invoked as a VRXEDIT macro so
  237.         InitArgs.0 = 2
  238.         InitArgs.1 = <object>
  239.         InitArgs.2 = <editWindow>
  240. */
  241. Init: procedure expose InitArgs. Fields. Classes.
  242.     Classes.0 = 0
  243.  
  244.     window = VRWindow()
  245.     call VRSet "CN_Objects", "Painting", 0
  246.     call VRSet VRGet( window, "Parent" ), "Pointer", "Wait"
  247.  
  248.     /*  Set up the fields
  249.     */
  250.     Fields.!tab = VRMethod( "CN_Objects", "AddField", "ULong" )
  251.     Fields.!handle = VRMethod( "CN_Objects", "AddField", "String" )
  252.     Fields.!pos = VRMethod( "CN_Objects", "AddField", "String" )
  253.     Fields.!icon = VRMethod( "CN_Objects", "AddField", "Icon" )
  254.     Fields.!name = VRMethod( "CN_Objects", "AddField", "String", "Name" )
  255.     Fields.!text = VRMethod( "CN_Objects", "AddField", "String", "Caption/Value" )
  256.  
  257.     call VRMethod "CN_Objects", "SetFieldAttr", Fields.!tab, "Visible", 0
  258.     call VRMethod "CN_Objects", "SetFieldAttr", Fields.!handle, "Visible", 0
  259.     call VRMethod "CN_Objects", "SetFieldAttr", Fields.!pos, "Visible", 0
  260.     call VRMethod "CN_Objects", "SetFieldAttr", Fields.!icon, "ReadOnly", 1
  261.     call VRMethod "CN_Objects", "SetFieldAttr", Fields.!name, "ReadOnly", 1
  262.     call VRMethod "CN_Objects", "SetFieldAttr", Fields.!text, "ReadOnly", 1, "VertSeparator", 0
  263.  
  264.     call ListObjects InitArgs.2
  265.     call VRSet VRGet( window, "Parent" ), "Pointer", "<Default>"
  266.  
  267.     if( VRGet( "CN_Objects", "Count" ) = 0 ) then do
  268.         call VRMessage window, "No objects with the TabIndex property.", "Set tab order", "I"
  269.         call Quit
  270.     end
  271.     else do
  272.         call VRMethod "CN_Objects", "SortRecords"
  273.         call VRSet "CN_Objects", "Painting", 1
  274.         call VRMethod window, "CenterWindow"
  275.         call VRSet window, "Visible", 1
  276.         call VRMethod window, "Activate"
  277.     end
  278. return
  279.  
  280. /*  List objects which have the TabIndex property.
  281. */    
  282. ListObjects: procedure expose Fields. Classes.
  283.     parse arg parent, parentPos
  284.     object = VRGet( parent, "FirstChild" )
  285.     do while( object <> "" )
  286.         if( TabObject( object ) ) then do
  287.             call AddRecord object, parentPos || ObjectPos( object )
  288.         end 
  289.         else if( VRGet( object, "ClassName" ) = "GroupBox" ) then do
  290.             call ListObjects object, parentPos || ObjectPos( object )
  291.         end
  292.         object = VRGet( object, "Sibling" )
  293.     end
  294. return
  295.  
  296. /*  Determine if an object has the 'tabindex' property.
  297. */
  298. TabObject: procedure
  299.     parse arg object
  300.     tabobj = VRMethod( "Application", "SupportsProperty", object, "TabIndex" )
  301.     if( \tabobj ) then do
  302.         signal TabDone
  303.     end
  304.     if( VRGet( object, "ClassName" ) <> "DescriptiveText" ) then do
  305.         signal TabDone
  306.     end
  307.     if( Pos( "~", VRGet( object, "Caption" ) ) = 0 ) then do
  308.         tabobj = 0
  309.     end
  310. TabDone:
  311. return tabobj
  312.  
  313. ObjectPos: procedure
  314.     parse arg object
  315.     top = Right( VRGet( object, "Top" ), 10 )
  316.     left = Right( VRGet( object, "Left" ), 10 )
  317. return top || left
  318.  
  319. /*:VRX         PB_Auto_Click
  320. */
  321. /*  Set the TabIndex of all objects on the window based
  322.     on position and grouping.
  323.     
  324.     The basic tab order is left to right, top to bottom
  325.     except that when you enter a group you traverse all of
  326.     its objects before you start the next group.
  327.     
  328.     Assume InitArgs.2 is the editWindow.
  329. */
  330. PB_Auto_Click:
  331.     call VRSet "CN_Objects", "DetailSort", Fields.!pos
  332.     call VRMethod "CN_Objects", "SortRecords"
  333. return
  334.  
  335. /*:VRX         PB_Cancel_Click
  336. */
  337. PB_Cancel_Click:
  338.     call Quit
  339. return
  340.  
  341. /*:VRX         PB_OK_Click
  342. */
  343. /*  Set the tab index of each object to its position in
  344.     the list of objects.
  345. */
  346. PB_OK_Click:
  347.     call VRMethod "CN_Objects", "GetRecordList", "All", "objects."
  348.     do i = 1 to objects.0
  349.         handle = VRMethod( "CN_Objects", "GetFieldData", objects.i, Fields.!handle )
  350.         call VRSet handle, "TabIndex", i
  351.     end
  352.     call Quit
  353.     drop i handle objects.
  354. return
  355.  
  356. /*:VRX         Quit
  357. */
  358. Quit:
  359.     window = VRWindow()
  360.     call VRSet window, "Shutdown", 1
  361.     drop window
  362. return
  363.  
  364. /*:VRX         Window1_Close
  365. */
  366. Window1_Close:
  367.     call Quit
  368. return
  369.  
  370.