home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a065 / 1.img / TBEXS.EXE / TBEX21.PRG < prev    next >
Encoding:
Text File  |  1992-03-18  |  11.7 KB  |  420 lines
  1. // Tbex21.prg
  2. //
  3. // Pull Down menu using TBrowse
  4. //
  5. // Compile with /a /m /n /w /dTEST for test version
  6. //
  7. // Link with Tbutils, Dict
  8.  
  9. #include "Inkey.ch"
  10. #include "Setcurs.ch"
  11. #include "Tbutils.ch"
  12.  
  13. #ifdef TEST
  14.   FUNCTION Tbex21
  15.  
  16.   LOCAL aPay30Pdown, aCustPdown, aRecPdown, aPayPdown, aMenuPrompts
  17.  
  18.     aPay30Pdown :=  { ;
  19.                       {"By Date",      "D", K_ALT_D, {|| Msg("pay_30date")} },  ;
  20.                       {"By Company",   "C", K_ALT_C, {|| Msg("pay_30comp")} },  ;
  21.                       {"Another Menu", "A", K_ALT_A, NIL } ;
  22.                     }
  23.  
  24.     aCustPdown  :=  { ;
  25.                       {"By Name", "N", K_ALT_N, {|| Msg("cust_byname")}, {|| Msg1("Entering Pull Down") }, {|| Msg1("Leaving Pull Down") }  }, ;
  26.                       {"By Id.",  "I", K_ALT_I, {|| Msg("cust_byid")}    }, ;
  27.                       {"By City", "C", K_ALT_C, {|| Msg("cust_bycity")}  }  ;
  28.                     }
  29.  
  30.     aRecPdown :=    { ;
  31.                       {"By Inv. Num", "I", K_ALT_I, {|| Msg("rec_byinv")} }, ;
  32.                       {"By conTact",  "T", K_ALT_T, {|| Msg("rec_bycon")} }, ;
  33.                       {"Current",     "C", K_ALT_C, {|| Msg("rec_cur")}   }, ;
  34.                       {"> 30 Days",   "3", K_ALT_3, {|| Msg("rec_30")}    }, ;
  35.                       {"> 60 Days",   "6", K_ALT_6, {|| Msg("rec_60")}    }  ;
  36.                     } 
  37.   
  38.     aPayPdown :=    { ;
  39.                       {"By comPany",  "P", K_ALT_P, {|| Msg("pay_comp")} }, ;
  40.                       {"By conTact",  "T", K_ALT_T, {|| Msg("pay_cont")} }, ;
  41.                       {"Current",     "C", K_ALT_C, {|| Msg("pay_cur")}  }, ;
  42.                       {"> 30 Days",   "3", K_ALT_3, aPay30Pdown    }, ;
  43.                       {"> 60 Days",   "6", K_ALT_6, {|| Msg("pay_60")}   }  ;
  44.                     }
  45.  
  46.     aMenuPrompts := { ;
  47.                       {"Customers",   "C", K_ALT_C, aCustPdown, {|| Msg1("Entering")}, {|| Msg1("Leaving") }  }, ;
  48.                       {"receiVables", "V", K_ALT_V, aRecPdown  }, ;
  49.                       {"paYables",    "Y", K_ALT_Y, aPayPdown  }  ;
  50.                     }
  51. /*
  52.                       {"Customers",   "C", K_ALT_C, aCustPdown }, ;
  53.                       {"receiVables", "V", K_ALT_V, aRecPdown  }, ;
  54.                       {"paYables",    "Y", K_ALT_Y, aPayPdown  }, ;
  55.                       {"Customers",   "C", K_ALT_C, aCustPdown }, ;
  56.                       {"receiVables", "V", K_ALT_V, aRecPdown  }, ;
  57.                       {"paYables",    "Y", K_ALT_Y, aPayPdown  }, ;
  58.                       {"Customers",   "C", K_ALT_C, aCustPdown }, ;
  59.                       {"receiVables", "V", K_ALT_V, aRecPdown  }, ;
  60.                       {"paYables",    "Y", K_ALT_Y, aPayPdown  }  ;
  61.                     }
  62. */
  63.     aPay30Pdown[3, 4] := aMenuPrompts
  64.  
  65.     SetCancel(.F.)
  66.     CLEAR SCREEN
  67.     DoMenu(aMenuPrompts)
  68.  
  69.   RETURN NIL
  70. #endif
  71.  
  72. #define PROMPT_SPACING    2
  73. #define LEFT_PROMPT_START 2
  74. #define PROMPT_ROW        1
  75.  
  76.  
  77. FUNCTION DoMenu(aMenuPrompts)
  78.  
  79. LOCAL nTBColumns := Len(aMenuPrompts)
  80. LOCAL i
  81. LOCAL oTbc
  82. LOCAL oTbr := TBrowseNew()
  83. LOCAL lExitRequested
  84. LOCAL nKey
  85. LOCAL cSaveScr := SaveScreen(PROMPT_ROW - 1, 0, PROMPT_ROW + 1, MaxCol())
  86. LOCAL nSaveCursor := SetCursor(SC_NONE)
  87. LOCAL nPromptWidths := 0
  88. LOCAL nPrompt
  89.  
  90.   // Set color to menu colors here ...
  91.   
  92.   @ PROMPT_ROW - 1, 0 CLEAR TO PROMPT_ROW + 1, MaxCol()
  93.   @ PROMPT_ROW - 1, 0 TO PROMPT_ROW + 1, MaxCol()
  94.  
  95.   // Create one TBColumn for each prompt, and calculate
  96.   // combined widths of all prompts
  97.   FOR i := 1 TO nTBColumns
  98.     oTbc := TBColumnNew(, Ablock(aMenuPrompts, i))
  99.     oTbr:addColumn(oTbc)
  100.     nPromptWidths += Len(aMenuPrompts[i, 1])
  101.   NEXT
  102.  
  103.   // Prompts are separated by PROMPT_SPACING characters
  104.   oTbr:colSep  := Space(PROMPT_SPACING)
  105.   nPromptWidths += (PROMPT_SPACING * (nTBColumns - 1))
  106.  
  107.   oTbr:nTop    := PROMPT_ROW
  108.   oTbr:nLeft   := LEFT_PROMPT_START
  109.   oTbr:nBottom := PROMPT_ROW
  110.  
  111.   // We want to left align prompts.
  112.   IF nPromptWidths < (MaxCol() - 1) - LEFT_PROMPT_START
  113.     oTbr:nRight := LEFT_PROMPT_START + nPromptWidths - 1
  114.   ELSE
  115.     oTbr:nRight  := MaxCol() - LEFT_PROMPT_START
  116.   ENDIF
  117.  
  118.   // To eliminate the highlight bar
  119. //  oTbr:autoLite := .F.
  120.  
  121.   lExitRequested := .F.
  122.   DO WHILE !lExitRequested
  123.     DrawHorizPrompts(oTbr, aMenuPrompts)
  124.     // Evaluate before block
  125.     IF Len(aMenuPrompts[oTbr:colPos]) > 4 .AND. ;
  126.        ValType(aMenuPrompts[oTbr:colPos, 5]) == "B"
  127.       Eval(aMenuPrompts[oTbr:colPos, 5])
  128.     ENDIF
  129.     nKey := Inkey(0)
  130.     // Evaluate after block
  131.     IF Len(aMenuPrompts[oTbr:colPos]) > 5 .AND. ;
  132.        ValType(aMenuPrompts[oTbr:colPos, 6]) == "B"
  133.       Eval(aMenuPrompts[oTbr:colPos, 6])
  134.     ENDIF
  135.  
  136.     IF !StdMeth(nKey, oTbr)
  137.       IF (nPrompt := Ascan(aMenuPrompts, ;
  138.                         {|aPrompt| aPrompt[3] == nKey})) > 0
  139.         oTbr:deHilite()
  140.  
  141.         oTbr:colPos := nPrompt
  142.         DrawHorizPrompts(oTbr, aMenuPrompts)
  143.         KEYBOARD Chr(K_ENTER)
  144.       ELSE
  145.         DO CASE
  146.           CASE nKey == K_ESC
  147.             lExitRequested := .T.
  148.  
  149.           CASE nKey == K_ENTER
  150.             IF ValType(aMenuPrompts[oTbr:colPos, 4]) == "B"
  151.               Eval(aMenuPrompts[oTbr:ColPos, 4])
  152.             ELSE
  153.               DoPullDown(PROMPT_ROW + 2, Col(), ;
  154.                          aMenuPrompts[oTbr:colPos, 4])
  155.             ENDIF
  156.         ENDCASE
  157.       ENDIF
  158.     ENDIF
  159.   ENDDO
  160.   SetCursor(nSaveCursor)
  161.   RestScreen(0, 0, 3, MaxCol())
  162.  
  163. RETURN NIL
  164.  
  165.  
  166. FUNCTION Ablock(aMenu, i)
  167.  
  168. RETURN {|| aMenu[i, 1] }
  169.  
  170.  
  171. FUNCTION DrawHorizPrompts(oTbr, aMenuPrompts)
  172.  
  173. LOCAL aColors := ColorSplit(SetColor())
  174. LOCAL cSaveColor, nSaveRow, nSaveCol, nHotCharOffset, i, aCols
  175.  
  176.   DispBegin()
  177.   FullStabilize(oTbr)
  178.  
  179.   // Get column positions of each visible column
  180.   aCols := TbcColPos(oTbr)
  181.  
  182.   // Redisplay HOT character in selected color
  183.   cSaveColor := SetColor(aColors[2])
  184.   nSaveRow := Row()
  185.   nSaveCol := Col()
  186.   FOR i := oTbr:leftVisible TO oTbr:rightVisible
  187.     nHotCharOffset := At(aMenuPrompts[i, 2], aMenuPrompts[i, 1])
  188.     IF nHotCharOffset > 0
  189.       @ PROMPT_ROW, aCols[i] + nHotCharOffset - 1 SAY aMenuPrompts[i, 2]
  190.     ENDIF
  191.   NEXT
  192.   @ nSaveRow, nSaveCol SAY ""
  193.   SetColor(cSaveColor)
  194.   DispEnd()
  195.  
  196. RETURN NIL
  197.  
  198.  
  199. #define MAX_PULL_DOWN_HEIGHT  6
  200.  
  201. FUNCTION DoPullDown(nRow, nCol, aMenuPrompts)
  202.  
  203. LOCAL nPrompts
  204. LOCAL oTbr := TBrowseNew()
  205. LOCAL oTbc
  206. LOCAL nPromptsWidth := 0
  207. LOCAL nMenuHeight
  208. LOCAL cSaveScr
  209. LOCAL nSaveRow := Row()
  210. LOCAL nSaveCol := Col()
  211. LOCAL lExitRequested
  212. LOCAL nKey
  213. LOCAL aFirstLast := Array(2)
  214. LOCAL nPrompt
  215.  
  216.   nPrompts := Len(aMenuPrompts)
  217.  
  218.   // Find widest prompt
  219.   Aeval(aMenuPrompts, ;
  220.         {|aPrompt| nPromptsWidth := Max(nPromptsWidth, Len(aPrompt[1])) })
  221.  
  222.   oTbr:nTop    := nRow + 1
  223.   oTbr:nLeft   := nCol + 1
  224.  
  225.   nMenuHeight := Min(nPrompts, MAX_PULL_DOWN_HEIGHT)
  226.   oTbr:nBottom := nRow + 1 + nMenuHeight - 1
  227.  
  228.   oTbr:nRight  := nCol + 1 + nPromptsWidth - 1
  229.  
  230.   oTbr:cargo := 1
  231.   oTbr:goTopBlock    := {|| oTbr:cargo := 1 }
  232.   oTbr:goBottomBlock := {|| oTbr:cargo := Len(aMenuPrompts) }
  233.   oTbr:skipBlock     := ARRAY_SKIPPER(oTbr:cargo, aMenuPrompts)
  234.  
  235.   // Adjust in case nBottom > MaxRow() - 1
  236.   IF oTbr:nBottom > MaxRow() - 1
  237.     oTbr:nBottom := MaxRow() - 1
  238.     oTbr:nTop := oTbr:nBottom - nMenuHeight + 1
  239.   ENDIF
  240.  
  241.   // Adjust in case nRight > MaxCol() - 1
  242.   IF oTbr:nRight > MaxCol() - 1
  243.     oTbr:nRight := MaxCol() - 1
  244.     oTbr:nLeft  := oTbr:nRight - nPromptsWidth + 1
  245.   ENDIF
  246.  
  247.   oTbc := TBColumnNew(, {|| aMenuPrompts[oTbr:cargo, 1]} )
  248.   oTbc:width := oTbr:nRight - oTbr:nLeft + 1
  249.   oTbr:addColumn(oTbc)
  250.  
  251.   cSaveScr := SaveScreen(oTbr:nTop - 1, oTbr:nLeft - 1, ;
  252.                          oTbr:nBottom + 1, oTbr:nRight + 1)
  253.   @ oTbr:nTop - 1, oTbr:nLeft - 1 CLEAR TO oTbr:nBottom + 1, oTbr:nRight + 1
  254.   @ oTbr:nTop - 1, oTbr:nLeft - 1 TO oTbr:nBottom + 1, oTbr:nRight + 1
  255.   lExitRequested := .F.
  256.   DO WHILE !lExitRequested
  257.     DrawVertPrompts(oTbr, aMenuPrompts)
  258.     // Evaluate before block
  259.     IF Len(aMenuPrompts[oTbr:cargo]) > 4 .AND. ;
  260.        ValType(aMenuPrompts[oTbr:cargo, 5]) == "B"
  261.       Eval(aMenuPrompts[oTbr:cargo, 5])
  262.     ENDIF
  263.     nKey := Inkey(0)
  264.     // Evaluate after block
  265.     IF Len(aMenuPrompts[oTbr:cargo]) > 5 .AND. ;
  266.        ValType(aMenuPrompts[oTbr:cargo, 6]) == "B"
  267.       Eval(aMenuPrompts[oTbr:cargo, 6])
  268.     ENDIF
  269.     IF nKey == K_LEFT
  270.       KEYBOARD Chr(K_ESC) + Chr(K_LEFT)  + Chr(K_ENTER)
  271.     ELSEIF nKey == K_RIGHT
  272.       KEYBOARD Chr(K_ESC) + Chr(K_RIGHT) + Chr(K_ENTER)
  273.     ELSEIF !StdMeth(nKey, oTbr)
  274.       aFirstLast = GetFirstLast(oTbr)
  275.       IF (nPrompt := Ascan(aMenuPrompts, ;
  276.                         {|aPrompt| aPrompt[3] == nKey})) > 0
  277.         IF nPrompt >= aFirstLast[1] .OR. nPrompt <= aFirstLast[2]
  278.           oTbr:deHilite()
  279.           oTbr:rowPos := nPrompt - aFirstLast[1] + 1
  280.         ELSE
  281.           oTbr:cargo := nPrompt
  282.           oTbr:refreshAll()
  283.         ENDIF
  284.         DrawVertPrompts(oTbr, aMenuPrompts)
  285.         KEYBOARD Chr(K_ENTER)
  286.       ELSE
  287.         DO CASE
  288.           CASE nKey == K_ESC
  289.             lExitRequested := .T.
  290.  
  291.           CASE nKey == K_ENTER
  292.             IF ValType(aMenuPrompts[oTbr:cargo, 4]) == "B"
  293.               Eval(aMenuPrompts[oTbr:cargo, 4])
  294.             ELSE
  295.               DoPullDown(Row() + 1, ;
  296.                          Col() + Int(2 * (nPromptsWidth / 3)), ;
  297.                          aMenuPrompts[oTbr:cargo, 4])
  298.             ENDIF
  299.         ENDCASE
  300.       ENDIF
  301.     ENDIF
  302.   ENDDO
  303.  
  304.   RestScreen(oTbr:nTop - 1, oTbr:nLeft - 1, ;
  305.              oTbr:nBottom + 1, oTbr:nRight + 1, cSaveScr)
  306.   @ nSaveRow, nSaveCol SAY ""
  307.  
  308. RETURN NIL
  309.  
  310.  
  311. FUNCTION DrawVertPrompts(oTbr, aMenuPrompts)
  312.  
  313. LOCAL aColors := ColorSplit(SetColor())
  314. LOCAL nHotCharOffset
  315. LOCAL cSaveColor
  316. LOCAL nSaveRow, nSaveCol
  317. LOCAL i
  318. LOCAL aFirstLast := Array(2)
  319.  
  320.   nSaveRow := Row()
  321.   nSaveCol := Col()
  322.  
  323.   FullStabilize(oTbr)
  324.   aFirstLast := GetFirstLast(oTbr)
  325.  
  326.   DispBegin()
  327.   cSaveColor := SetColor(aColors[2])
  328.  
  329.   FOR i := 1 TO aFirstLast[2] - aFirstLast[1] + 1
  330.     nHotCharOffset := At(aMenuPrompts[i + aFirstLast[1] - 1, 2], ;
  331.                          aMenuPrompts[i + aFirstLast[1] - 1, 1])
  332.     IF nHotCharOffset > 0
  333.       @ oTbr:nTop + i - 1, ;
  334.         oTbr:nLeft + nHotCharOffset - 1 ;
  335.         SAY aMenuPrompts[i + aFirstLast[1] - 1, 2]
  336.     ENDIF
  337.  
  338.   NEXT
  339.  
  340.   SetColor(cSaveColor)
  341.   @ nSaveRow, nSaveCol SAY ""
  342.   DispEnd()
  343.  
  344. RETURN NIL
  345.  
  346.  
  347. // Get the array indexes of the first and last prompts
  348.  
  349. FUNCTION GetFirstLast(oTbr)
  350.  
  351. LOCAL aFirstLast := Array(2)
  352. LOCAL nSaveCurrent
  353. LOCAL lSaveAutoLite
  354.  
  355.   nSaveCurrent := oTbr:rowPos
  356.   lSaveAutoLite := oTbr:autoLite
  357.  
  358.   DispBegin()
  359.  
  360.   oTbr:autoLite := .F.
  361.   oTbr:deHilite()
  362.  
  363.   oTbr:rowPos := 1
  364.   FullStabilize(oTbr)
  365.   aFirstLast[1] := oTbr:cargo
  366.  
  367.   oTbr:rowPos := oTbr:rowCount
  368.   FullStabilize(oTbr)
  369.   aFirstLast[2] := oTbr:cargo
  370.  
  371.   oTbr:rowPos := nSaveCurrent
  372.   oTbr:autoLite := lSaveAutoLite
  373.   FullStabilize(oTbr)
  374.  
  375.   DispEnd()
  376.  
  377. RETURN aFirstLast
  378.  
  379.  
  380. FUNCTION ColorSplit(cColorToSplit)
  381.  
  382. LOCAL nColorNum, nNextComma, aColors[5]
  383.  
  384.   FOR nColorNum := 1 TO 4
  385.     nNextComma := At(",", cColorToSplit)
  386.     aColors[nColorNum] := Substr(cColorToSplit, 1, nNextComma - 1)
  387.     cColorToSplit := Substr(cColorToSplit, nNextComma + 1)
  388.   NEXT
  389.  
  390.   aColors[5] = cColorToSplit
  391.  
  392. RETURN aColors
  393.  
  394.  
  395. FUNCTION Msg(cMess)
  396.  
  397. LOCAL cSaveScr := SaveScreen(MaxRow(), 0, MaxRow(), MaxCol())
  398. LOCAL nSaveRow := Row()
  399. LOCAL nSaveCol := Col()
  400.  
  401.   @ MaxRow(), 0
  402.   @ MaxRow(), 0 SAY cMess
  403.   InKey(0)
  404.   RestScreen(MaxRow(), 0, MaxRow(), MaxCol(), cSaveScr)
  405.   @ nSaveRow, nSaveCol SAY ""
  406.  
  407. RETURN NIL
  408.  
  409.  
  410. FUNCTION Msg1(cMess)
  411.  
  412. LOCAL nSaveRow := Row()
  413. LOCAL nSaveCol := Col()
  414.  
  415.   @ MaxRow(), 0
  416.   @ MaxRow(), 0 SAY cMess
  417.   @ nSaveRow, nSaveCol SAY ""
  418.  
  419. RETURN NIL
  420.