home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a065 / 1.img / TBPRGS.EXE / TB21.PRG < prev    next >
Encoding:
Text File  |  1992-03-05  |  4.9 KB  |  202 lines
  1.     // Tb21.prg
  2.     //
  3.     // A replacement for Achoice
  4.     //
  5.     // Link with Tbutils, dict
  6.     
  7.     #include "Inkey.ch"
  8.     #include "Tbutils.ch"
  9.     
  10.     #define KH_SELECT   1
  11.     #define KH_CONTINUE 2
  12.     #define KH_ABORT    3
  13.     
  14.     FUNCTION Tb21
  15.     
  16.     LOCAL aTest := Array(100)
  17.     LOCAL aSelectables := Array(102)
  18.     LOCAL i
  19.     LOCAL bKeyHandler := {|nKey, oTbr| MyKeyHandler(nKey, oTbr) }
  20.     
  21.       FOR i := 1 TO Len(aTest)
  22.         aTest[i] := Str(i * i)
  23.       NEXT
  24.     
  25.       Afill(aSelectables, .T.)
  26.       aSelectables[3]  := .F.
  27.       aSelectables[18] := .F.
  28.     
  29.       FOR i := 90 TO 100
  30.         aSelectables[i] := .F.
  31.       NEXT
  32.     
  33.       CLEAR SCREEN
  34.       ? Achoice(10, 10, 20, 20, aTest, aSelectables,, 10, 2)
  35.       Inkey(0)
  36.       CLEAR SCREEN 
  37.       aTest[1] := "123456789012345"
  38.     
  39.       aTest[10] := "123456789012345678901234567890"
  40.       Aadd(aTest, NIL)
  41.       Aadd(aTest, Space(25))
  42.     
  43.       ? Tchoice(10, 10, 20, 70, aTest, aSelectables, bKeyHandler, 10, 2)
  44.       Inkey(0)
  45.     
  46.     RETURN NIL
  47.     
  48.     #define GOING_UP(nKey) Chr(nKey) $ (Chr(K_UP) + Chr(K_PGUP) + ;
  49.                                         Chr(K_CTRL_PGUP))
  50.     
  51.     
  52.     FUNCTION Tchoice(nTop, nLeft, nBottom, nRight, aMenuItems, ;
  53.                      aSelectableItems, bKeyHandle, nInitialItem, nWindowRow)
  54.     
  55.     LOCAL oTbr := TBrowseNew(nTop, nLeft, nBottom, nRight)
  56.     LOCAL oTbc
  57.     LOCAL nElem := iif(nInitialItem == NIL, 1, nInitialItem)
  58.     LOCAL lExitRequested := .F.
  59.     LOCAL nKey
  60.     LOCAL i
  61.     LOCAL nKeyHandleResult
  62.     
  63.       oTbc := TBColumnNew(, {|| aMenuItems[nElem]} )
  64.     
  65.       IF ValType(aSelectableItems) == "A"
  66.         oTbc:colorBlock := {|| iif(aSelectableItems[nElem], ;
  67.                                    {1, 2}, {5, 5}) }
  68.       ENDIF
  69.     
  70.       oTbc:width := Awidth(aMenuItems)
  71.     
  72.       oTbr:addColumn(oTbc)
  73.     
  74.       oTbr:goTopBlock    := {|| nElem := 1}
  75.       oTbr:goBottomBlock := {|| nElem := Len(aMenuItems) }
  76.       oTbr:skipBlock     := ARRAY_SKIPPER(nElem, aMenuItems)
  77.       lExitRequested := .F.
  78.       FullStabilize(oTbr)
  79.       IF nWindowRow != NIL
  80.         DispBegin()
  81.         oTbr:deHilite()
  82.         oTbr:autoLite := .F.
  83.         IF oTbr:rowPos > nWindowRow + 1
  84.           oTbr:rowPos := oTbr:rowCount
  85.           FOR i := 1 TO oTbr:rowPos - (nWindowRow + 1)
  86.             oTbr:down()
  87.             FullStabilize(oTbr)
  88.           NEXT
  89.           oTbr:rowPos := nWindowRow + 1
  90.         ELSE
  91.           oTbr:rowPos := 1
  92.           FOR i := 1 TO (nWindowRow + 1) - oTbr:rowPos
  93.             oTbr:up()
  94.             FullStabilize(oTbr)
  95.           NEXT
  96.           oTbr:rowPos := nWindowRow + 1
  97.         ENDIF
  98.         oTbr:autoLite := .T.
  99.         DispEnd()
  100.       ENDIF
  101.     
  102.       DO WHILE !lExitRequested
  103.         FullStabilize(oTbr)
  104.         IF !aSelectableItems[nElem]
  105.           IF GOING_UP(LastKey())
  106.             IF nElem != 1
  107.               KEYBOARD Chr(K_UP)
  108.             ELSE
  109.               KEYBOARD Chr(K_DOWN)
  110.             ENDIF
  111.           ELSE
  112.             IF nElem != Len(aMenuItems)
  113.               KEYBOARD Chr(K_DOWN)
  114.             ELSE
  115.               KEYBOARD Chr(K_UP)
  116.             ENDIF
  117.           ENDIF
  118.         ENDIF
  119.         nKey := Inkey(0)
  120.         IF bKeyHandle != NIL
  121.           nKeyHandleResult := Eval(bKeyHandle, nKey, oTbr)
  122.           DO CASE
  123.             CASE nKeyHandleResult == KH_SELECT
  124.               lExitRequested := .T.
  125.               
  126.             CASE nKeyHandleResult == KH_ABORT
  127.               lExitRequested := .T.
  128.               nElem := 0
  129.     
  130.             CASE nKeyHandleResult == KH_CONTINUE
  131.     
  132.           ENDCASE
  133.         ELSEIF !StdMeth(nKey, oTbr)
  134.           DO CASE
  135.             CASE nKey == K_ESC
  136.               lExitRequested := .T.
  137.               nElem := 0
  138.     
  139.             CASE nKey == K_ENTER
  140.               lExitRequested := .T.
  141.           ENDCASE
  142.         ENDIF
  143.       ENDDO
  144.     
  145.     RETURN nElem
  146.     
  147.     
  148.     FUNCTION MyKeyHandler(nKey, oTbr)
  149.     
  150.     LOCAL nKeyHandleResult := KH_CONTINUE
  151.     
  152.       IF !StdMeth(nKey, oTbr)
  153.         DO CASE
  154.           CASE nKey == K_ESC
  155.             nKeyHandleResult := KH_ABORT
  156.     
  157.           CASE nKey == K_ENTER
  158.             nKeyHandleResult := KH_SELECT
  159.         ENDCASE
  160.       ENDIF
  161.     
  162.     RETURN nKeyHandleResult
  163.     
  164.     
  165.     FUNCTION Awidth(aVar)
  166.     
  167.     LOCAL i
  168.     LOCAL nLen := Len(aVar)
  169.     LOCAL nLongest := 0
  170.     
  171.       FOR i := 1 TO nLen
  172.         nLongest := Max(nLongest, DataLen(aVar[i]))
  173.       NEXT
  174.     
  175.     RETURN nLongest
  176.     
  177.     
  178.     FUNCTION DataLen(xElem)
  179.     
  180.     LOCAL nLen
  181.     LOCAL cType := ValType(xElem)
  182.     
  183.       DO CASE
  184.         CASE cType $ "ACM"
  185.           nLen := Len(xElem)
  186.     
  187.         CASE cType == "N"
  188.           nLen := Len(Str(xElem))
  189.     
  190.         CASE cType == "L"
  191.           nLen := 1
  192.     
  193.         CASE cType == "D"
  194.           nLen := 8
  195.     
  196.         CASE cType == "U"   // Value NIL
  197.           nLen := 3
  198.     
  199.       ENDCASE
  200.         
  201.     RETURN nLen
  202.