home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / vxdemo.zip / MACROS.$$$ / SETTABS.VRM < prev    next >
Text File  |  1993-09-04  |  12KB  |  501 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 < 1.01 )then do
  8.         call VRMessage "", "This program requires VX-REXX version 1.01 to run", "Error!"
  9.         _VREReturnValue = 32000
  10.         signal _VRELeaveMain
  11.     end
  12.  
  13.     signal on SYNTAX name _VRESyntax
  14.     signal _VREMain
  15.  
  16. _VRESyntax:
  17.     parse source . . _VRESourceSpec
  18.     call VRMessage "", "Syntax error in" _VRESourceSpec "line" SIGL, "Error!"
  19.     _VREReturnValue = 32000
  20.     signal _VRELeaveMain
  21.  
  22. _VREMain:
  23. /*:VRX         Main
  24. */
  25. /*  Main
  26. */
  27.     signal on novalue
  28.     signal Main
  29. novalue:
  30.     parse source . . source
  31.     call VRMessage "", "Novalue error in" source "line" SIGL, "Error!"
  32.     _VREReturnValue = 32000
  33.     signal _VRELeaveMain
  34.  
  35. Main:
  36. /*  Process the arguments.
  37.     Get the parent window.
  38. */
  39.     parse source . calledAs .
  40.     parent = ""
  41.     argCount = arg()
  42.     argOff = 0
  43.     if( calledAs \= "COMMAND" )then do
  44.         if argCount >= 1 then do
  45.             parent = arg(1)
  46.             argCount = argCount - 1
  47.             argOff = 1
  48.         end
  49.     end
  50.     InitArgs.0 = argCount
  51.     if( argCount > 0 )then do i = 1 to argCount
  52.         InitArgs.i = arg( i + argOff )
  53.     end
  54.     drop calledAs argCount argOff
  55.  
  56. /*  Load the windows
  57. */
  58.     call VRInit
  59.     parse source . . spec
  60.     _VREPrimaryWindowPath = ,
  61.         VRParseFileName( spec, "dpn" ) || ".VRW"
  62.     _VREPrimaryWindow = ,
  63.         VRLoad( parent, _VREPrimaryWindowPath )
  64.     drop parent spec
  65.     if( _VREPrimaryWindow == "" )then do
  66.         call VRMessage "", "Cannot load window:" VRError(), ,
  67.             "Error!"
  68.         _VREReturnValue = 32000
  69.         signal _VRELeaveMain
  70.     end
  71.  
  72. /*  Process events
  73. */
  74.     call Init
  75.     signal on halt
  76.     do while( \ VRGet( _VREPrimaryWindow, "Shutdown" ) )
  77.         _VREEvent = VREvent()
  78.         interpret _VREEvent
  79.     end
  80. _VREHalt:
  81.     _VREReturnValue = Fini()
  82.     call VRDestroy _VREPrimaryWindow
  83. _VRELeaveMain:
  84.     call VRFini
  85. exit _VREReturnValue
  86.  
  87. VRLoadSecondary: procedure
  88.     name = arg( 1 )
  89.  
  90.     window = VRLoad( VRWindow(), VRWindowPath(), name )
  91.     call VRMethod window, "CenterWindow"
  92.     call VRSet window, "Visible", 1
  93.     call VRMethod window, "Activate"
  94. return window
  95.  
  96. /*:VRX         AutoOrder_Click
  97. */
  98. AutoOrder_Click:  procedure expose InitArgs. hndList.
  99.  
  100. /*
  101. call VRredirectStdio
  102. trace r
  103. */
  104.  
  105. /*  Set the TabIndex of all objects on the window based
  106.     on position and grouping.
  107.     
  108.     The basic tab order is left to right, top to bottom
  109.     except that one you enter a group you traverse all of
  110.     its objects before you start the next group.
  111.     
  112.     Assume InitArgs.2 is the editWindow     
  113. */
  114.     ok = VRMethod( "ObjectList", "Clear" )
  115.     ok = VRSet( "ObjectList", "Painting", 0 )
  116.  
  117.     hndList.0 = 0
  118.     call  AutoOrder InitArgs.2
  119.     call FillList
  120.  
  121.     ok = VRSet( "ObjectList", "Painting", 1 )
  122. return
  123.  
  124. AutoOrder: procedure expose hndList.
  125.  
  126.     arg object
  127.  
  128. /*  List all the immediate children of the current
  129.     window/groupbox.  Order these according to their
  130.     position, then add each to the hndList unless it
  131.     is a groupbox in which case we recurse.
  132. */
  133.     i = 0
  134.     object = VRGet( object, "FirstChild" )
  135.     do while( object \= "" )
  136.         ok = IsTabObject( object )
  137.         if ok = 0 then do
  138.             class = VRGet( object, "ClassName" ) 
  139.             if class = "GroupBox" then do
  140.                 ok = 2
  141.             end
  142.         end
  143.         if ok > 0 then do
  144.             i = i + 1
  145.             sibling.i = object
  146.             sibling.i.!type = ok                
  147.         end
  148.         object = VRGet( object, "Sibling" )
  149.     end
  150.     sibling.0 = i
  151.  
  152.     do i = 1 to sibling.0
  153.         object = sibling.i
  154.     top = VRGet(object, "Top")
  155.         top = Format( top, 8, 0 )                   
  156.     left = VRGet(object, "Left")
  157.         left = Format( left, 8, 0 )            
  158.         sibling.i = top || left || '\' || sibling.i.!type || ';' || sibling.i
  159.     end
  160.  
  161.     call VRSet "ObjectList", "Sort", "Ascending"
  162.     ok = VRMethod( "ObjectList", "Clear" )
  163.     ok = VRMethod( "ObjectList", "AddStringList", "sibling." )
  164.     ok = VRMethod( "ObjectList", "GetStringList", "sibling." )
  165.     call VRSet "ObjectList", "Sort", "None"
  166.  
  167.     do i = 1 to sibling.0
  168.         parse VAR sibling.i . '\' type ';' .
  169.         if type = 1 then do
  170.             j = hndList.0 + 1
  171.             hndList.0 = j
  172.             hndList.j = sibling.i
  173.         end                
  174.         else do
  175.             parse VAR sibling.i . ';' hnd
  176.             call AutoOrder hnd
  177.         end
  178.     end
  179.  
  180. return
  181.  
  182.  
  183. /*
  184.  
  185.  /* KNG:  To order the controls in order of top left to bottom right, */
  186.  /*        we need to know the coordinates of this controls parent if */
  187.  /*         it's inside a group box. */
  188.  
  189. parent = VRGet(object, "Parent")
  190. if VRGet(parent, "ClassName") = "GroupBox" Then Do
  191.     parentTop = VRGet(parent, "Top")
  192.     parentLeft = VRGet(parent, "Left")
  193. End
  194. else Do
  195.     parentTop = 0
  196.     parentLeft = 0
  197. End
  198.  
  199.     if( VRSupportsProperty( object, "TabIndex" ) )then do
  200.  
  201.  /* KNG: I added the next line so we don't get things that */
  202.  /*     don't even have tabstops at all. */
  203.  
  204.         if VRSupportsProperty(object, "TabStop") Then do
  205.  
  206.  /* KNG:  I don't particularly want to see items in this list */
  207.  /*        that have a TabStop property if that property is not set. */
  208.  
  209.             if VRGet(object, "TabStop") Then Do
  210.                 count = tabList.0 + 1
  211.                 tabList.0 = count
  212.  
  213.     /*            tabIndex = VRGet( object, "TabIndex" ) */
  214.  
  215.     top = VRGet(object, "Top") + parentTop
  216.     left = VRGet(object, "Left") + parentLeft
  217.  
  218.  /* KNG: We order the controls first by "topness" and then by "leftness" */
  219.  
  220.     tabIndex = Right("000000"||top, 6)||Right("000000"||left, 6)
  221.  
  222.     /*
  223.                 if( Length( tabIndex ) > Digits() )then do
  224.                     ok = VRMessage( VRWindow(), "TabIndex on '" ,
  225.                         || VRGet( object, "Name" ) ,
  226.                         || "' is too large for SetTabs macro" )
  227.                 end; else do
  228.                     tabIndex = Format( tabIndex, Digits(), 0 )
  229.                 end
  230.     */
  231.  
  232.                 tabList.count = tabIndex || ";" || object
  233.             end
  234.         end
  235.     end
  236.  
  237. return
  238.  
  239.  
  240. */
  241.  
  242. return
  243.  
  244.  
  245. /*:VRX         Cancel_Click
  246. */
  247. Cancel_Click:
  248.     call Quit
  249. return
  250.  
  251. /*:VRX         Down_Click
  252. */
  253. Down_Click: procedure expose hndList.
  254.  
  255.     ok = VRMethod( "ObjectList", "GetSelectedList", "selected." )
  256.     if( ok )then do
  257.         last = selected.0
  258.         if( selected.last < hndList.0 )then do
  259.             do index = last by -1 to 1
  260.                 call Swap selected.index, selected.index + 1
  261.                 selected.index = selected.index + 1
  262.             end
  263.             ok = VRMethod( "ObjectList", "SetSelectedList", "selected." )
  264.         end
  265.     end
  266.  
  267. return
  268.  
  269. /*:VRX         FillList
  270. */
  271. FillList: procedure expose hndList.
  272.  
  273. /*  Fill list with names of objects in hndList.
  274. */    
  275.     do i = 1 to hndList.0
  276.         parse VAR hndList.i . ';' hnd            
  277.         nameList.i = Left( VRGet( hnd, "Name" ), 20 )
  278.         text = ''
  279.         ok = VRMethod( "Application", "SupportsProperty", hnd, "Caption" )
  280.         if ok = 1 then do
  281.             text = VRGet( hnd, "Caption" )
  282.         end
  283.         else do
  284.             ok = VRMethod( "Application", "SupportsProperty", hnd, "Value" )
  285.             if ok = 1 then do
  286.                 text = VRGet( hnd, "Value" )
  287.             end
  288.         end
  289.         if text \= '' then do
  290.             nameList.i = nameList.i || ' ' || text
  291.         end
  292.     end
  293.     nameList.0 = hndList.0
  294.     ok = VRMethod( "ObjectList", "Clear" )
  295.     ok = VRMethod( "ObjectList", "AddStringList", "nameList." )
  296.     call VRSet "ObjectList", "Selected", 1
  297.  
  298. return
  299.  
  300. /*:VRX         Fini
  301. */
  302. Fini:
  303.     window = VRWindow()
  304.     call VRSet window, "Visible", 0
  305.     drop window
  306. return 0
  307.  
  308. /*:VRX         Halt
  309. */
  310. Halt:
  311.     signal _VREHalt
  312. return
  313.  
  314.  
  315. /*:VRX         Init
  316. */
  317.  
  318. Init: procedure expose InitArgs. hndList. 
  319.  
  320. /*  Assume invoked as a VRXEDIT macro so
  321.         InitArgs.0 = 2
  322.         InitArgs.1 = <object>
  323.         InitArgs.2 = <editWindow>
  324. */
  325.     window = VRWindow()
  326.     call VRMethod window, "CenterWindow"
  327.  
  328.     ok = VRMethod( InitArgs.2, "ListChildren", "hndList." )
  329.     j = 0
  330.     do i = 1 to hndList.0
  331.         ok = IsTabObject( hndList.i )
  332.         if ok = 1 then do
  333.             j = j + 1
  334.             tabIndex = VRGet( hndList.i, "TabIndex" )
  335.             tabIndex = Format( tabIndex, 8, 0 )
  336.             hndList.j = tabIndex || ';' || hndList.i
  337.         end  
  338.     end    
  339.     hndList.0 = j
  340.     if hndList.0 = 0 then do
  341.         signal NoTabObjects
  342.     end
  343.  
  344. /*  Sort by TabIndex
  345. */
  346.     call VRSet "ObjectList", "Sort", "Ascending"
  347.     ok = VRMethod( "ObjectList", "AddStringList", "hndList." )
  348.     ok = VRMethod( "ObjectList", "GetStringList", "hndList." )
  349.     call VRSet "ObjectList", "Sort", "None"
  350.  
  351. /*  Show the names in ObjectList
  352. */
  353.     call FillList
  354.     
  355.     call VRSet window, "Visible", 1
  356.     call VRMethod window, "Activate"
  357.     signal Done
  358.  
  359. NoTabObjects:
  360.     call VRMessage window, "No objects with the TabIndex property.", "Error!"
  361.     call Quit
  362. Done:
  363.     return
  364.  
  365.  
  366.  
  367.  
  368.  
  369.  
  370.  
  371.  
  372.  
  373.     nameList.0 = 0
  374.     nameList.0 = 0
  375.     nameList.0 = j
  376.  
  377.    
  378.  
  379.     if( hndList.0 = 0 )then do
  380.         call VRMessage window, "No objects with the TabIndex property.", "Error!"
  381.         call Quit
  382.         return
  383.     end
  384.  
  385.     ok = VRMethod( "ObjectList", "AddStringList", "nameList." )
  386.     ok = VRSet( "ObjectList", "Selected", 1 )
  387.  
  388.     call VRSet window, "Visible", 1
  389.     call VRMethod window, "Activate"
  390.  
  391. return    
  392.  
  393.  
  394.  
  395. /*:VRX         IsTabObject
  396. */
  397. IsTabObject: procedure
  398.  
  399.     arg object
  400.  
  401.     ok = VRMethod( "Application", "SupportsProperty", object, "TabIndex" )
  402.     if ok = 1 then do
  403.         class = VRGet( object, "ClassName" )
  404.         if class = "DescriptiveText" then do
  405.             caption = VRGet( object, "Caption" )
  406.             position  = Pos( "~", caption )
  407.             if position = 0 then do
  408.                 ok = 0
  409.             end
  410.         end
  411.     end
  412.  
  413. return ok
  414.  
  415. /*:VRX         OK_Click
  416. */
  417. OK_Click: procedure expose hndList.
  418.  
  419.     do index = 1 to hndList.0
  420.         parse VAR hndList.index . ';' hnd            
  421.         ok = VRSet( hnd, "TabIndex", index )
  422.     end
  423.     call Quit
  424.  
  425. return
  426.  
  427. /*:VRX         Quit
  428. */
  429. Quit:
  430.     window = VRWindow()
  431.     call VRSet window, "Shutdown", 1
  432.     drop window
  433. return
  434.  
  435. /*:VRX         Swap
  436. */
  437. Swap: procedure expose hndList.
  438.     x = arg( 1 )
  439.     y = arg( 2 )
  440.  
  441. /*  Assume x = y - 1 
  442. */
  443.     hndTemp = hndList.x
  444.     hndList.x = hndList.y
  445.     hndList.y = hndTemp
  446.  
  447.     string = VRMethod( "ObjectList", "GetString", y )
  448.     ok = VRMethod( "ObjectList", "Delete", y )
  449.     position = VRMethod( "ObjectList", "AddString", string, x )
  450.  
  451. return
  452.  
  453. /*:VRX         Up_Click
  454. */
  455. Up_Click: procedure expose hndList.
  456.  
  457.     ok = VRMethod( "ObjectList", "GetSelectedList", "selected." )
  458.     if( ok )then do
  459.         if( selected.1 > 1 )then do
  460.             do index = 1 to selected.0
  461.                 call Swap selected.index - 1, selected.index
  462.                 selected.index = selected.index - 1
  463.             end
  464.             ok = VRMethod( "ObjectList", "SetSelectedList", "selected." ) 
  465.         end
  466.     end
  467.  
  468. return
  469.  
  470. /*:VRX         Window1_Close
  471. */
  472. Window1_Close:
  473.     call Quit
  474. return
  475.  
  476. /*:VRX         Window1_Resize
  477. */
  478. Window1_Resize:
  479.  
  480.     ok = VRSet( "Window1", "Painting", 0 )
  481.  
  482.     top = VRGet( "ObjectList", "Top" )
  483.     left = VRGet( "ObjectList", "Left" )
  484.  
  485.     height = VRGet( "Window1", "InteriorHeight" ) ,
  486.         - VRGet( "Up", "Height" )
  487.     width = VRGet( "Window1", "InteriorWidth" )
  488.  
  489.     ok = VRSet( "Up", "Top", height - top )
  490.     ok = VRSet( "Down", "Top", height - top )
  491.  
  492.     ok = VRSet( "ObjectList", ,
  493.         "Height", height - 3 * top, ,
  494.         "Width", width - 3 * left, ,
  495.     )
  496.  
  497.     ok = VRSet( "Window1", "Painting", 1 )
  498.  
  499. return
  500.  
  501.