home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a065 / 1.img / TBPRGS.EXE / TB26.PRG < prev    next >
Encoding:
Text File  |  1992-03-05  |  12.0 KB  |  384 lines
  1.     // Tb26.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 Tb26
  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")}  }, ;
  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 }, ;
  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.     
  125.         nKey := Inkey(0)
  126.         IF !StdMeth(nKey, oTbr)
  127.           IF (nPrompt := Ascan(aMenuPrompts, ;
  128.                             {|aPrompt| aPrompt[3] == nKey})) > 0
  129.             oTbr:deHilite()
  130.     
  131.             oTbr:colPos := nPrompt
  132.             DrawHorizPrompts(oTbr, aMenuPrompts)
  133.             KEYBOARD Chr(K_ENTER)
  134.           ELSE
  135.             DO CASE
  136.               CASE nKey == K_ESC
  137.                 lExitRequested := .T.
  138.     
  139.               CASE nKey == K_ENTER
  140.                 IF ValType(aMenuPrompts[oTbr:colPos, 4]) == "B"
  141.                   Eval(aMenuPrompts[oTbr:ColPos, 4])
  142.                 ELSE
  143.                   DoPullDown(PROMPT_ROW + 2, Col(), ;
  144.                              aMenuPrompts[oTbr:colPos, 4])
  145.                 ENDIF
  146.             ENDCASE
  147.           ENDIF
  148.         ENDIF
  149.       ENDDO
  150.       SetCursor(nSaveCursor)
  151.       RestScreen(0, 0, 3, MaxCol())
  152.     
  153.     RETURN NIL
  154.     
  155.     
  156.     FUNCTION Ablock(aMenu, i)
  157.     
  158.     RETURN {|| aMenu[i, 1] }
  159.     
  160.     
  161.     FUNCTION DrawHorizPrompts(oTbr, aMenuPrompts)
  162.     
  163.     LOCAL aColors := ColorSplit(SetColor())
  164.     LOCAL cSaveColor, nSaveRow, nSaveCol, nHotCharOffset, i, aCols
  165.     
  166.       DispBegin()
  167.       FullStabilize(oTbr)
  168.     
  169.       // Get column positions of each visible column
  170.       aCols := TbcColPos(oTbr)
  171.     
  172.       // Redisplay HOT character in selected color
  173.       cSaveColor := SetColor(aColors[2])
  174.       nSaveRow := Row()
  175.       nSaveCol := Col()
  176.       FOR i := oTbr:leftVisible TO oTbr:rightVisible
  177.         nHotCharOffset := At(aMenuPrompts[i, 2], aMenuPrompts[i, 1])
  178.         IF nHotCharOffset > 0
  179.           @ PROMPT_ROW, aCols[i] + nHotCharOffset - 1 SAY aMenuPrompts[i, 2]
  180.         ENDIF
  181.       NEXT
  182.       @ nSaveRow, nSaveCol SAY ""
  183.       SetColor(cSaveColor)
  184.       DispEnd()
  185.     
  186.     RETURN NIL
  187.     
  188.     
  189.     #define MAX_PULL_DOWN_HEIGHT  6
  190.     
  191.     FUNCTION DoPullDown(nRow, nCol, aMenuPrompts)
  192.     
  193.     LOCAL nPrompts
  194.     LOCAL oTbr := TBrowseNew()
  195.     LOCAL oTbc
  196.     LOCAL nPromptsWidth := 0
  197.     LOCAL nMenuHeight
  198.     LOCAL cSaveScr
  199.     LOCAL nSaveRow := Row()
  200.     LOCAL nSaveCol := Col()
  201.     LOCAL lExitRequested
  202.     LOCAL nKey
  203.     LOCAL aFirstLast := Array(2)
  204.     LOCAL nPrompt
  205.     
  206.       nPrompts := Len(aMenuPrompts)
  207.     
  208.       // Find widest prompt
  209.       Aeval(aMenuPrompts, ;
  210.             {|aPrompt| nPromptsWidth := Max(nPromptsWidth, Len(aPrompt[1])) })
  211.     
  212.       oTbr:nTop    := nRow + 1
  213.       oTbr:nLeft   := nCol + 1
  214.     
  215.       nMenuHeight := Min(nPrompts, MAX_PULL_DOWN_HEIGHT)
  216.       oTbr:nBottom := nRow + 1 + nMenuHeight - 1
  217.     
  218.       oTbr:nRight  := nCol + 1 + nPromptsWidth - 1
  219.     
  220.       oTbr:cargo := 1
  221.       oTbr:goTopBlock    := {|| oTbr:cargo := 1 }
  222.       oTbr:goBottomBlock := {|| oTbr:cargo := Len(aMenuPrompts) }
  223.       oTbr:skipBlock     := ARRAY_SKIPPER(oTbr:cargo, aMenuPrompts)
  224.     
  225.       // Adjust in case nBottom > MaxRow() - 1
  226.       IF oTbr:nBottom > MaxRow() - 1
  227.         oTbr:nBottom := MaxRow() - 1
  228.         oTbr:nTop := oTbr:nBottom - nMenuHeight + 1
  229.       ENDIF
  230.     
  231.       // Adjust in case nRight > MaxCol() - 1
  232.       IF oTbr:nRight > MaxCol() - 1
  233.         oTbr:nRight := MaxCol() - 1
  234.         oTbr:nLeft  := oTbr:nRight - nPromptsWidth + 1
  235.       ENDIF
  236.     
  237.       oTbc := TBColumnNew(, {|| aMenuPrompts[oTbr:cargo, 1]} )
  238.       oTbc:width := oTbr:nRight - oTbr:nLeft + 1
  239.       oTbr:addColumn(oTbc)
  240.     
  241.       cSaveScr := SaveScreen(oTbr:nTop - 1, oTbr:nLeft - 1, ;
  242.                              oTbr:nBottom + 1, oTbr:nRight + 1)
  243.       @ oTbr:nTop - 1, oTbr:nLeft - 1 CLEAR TO oTbr:nBottom + 1, oTbr:nRight + 1
  244.       @ oTbr:nTop - 1, oTbr:nLeft - 1 TO oTbr:nBottom + 1, oTbr:nRight + 1
  245.       lExitRequested := .F.
  246.       DO WHILE !lExitRequested
  247.         DrawVertPrompts(oTbr, aMenuPrompts)
  248.         nKey := Inkey(0)
  249.         IF !StdMeth(nKey, oTbr)
  250.           aFirstLast = GetFirstLast(oTbr)
  251.           IF (nPrompt := Ascan(aMenuPrompts, ;
  252.                             {|aPrompt| aPrompt[3] == nKey})) > 0
  253.             IF nPrompt >= aFirstLast[1] .OR. nPrompt <= aFirstLast[2]
  254.               oTbr:deHilite()
  255.               oTbr:rowPos := nPrompt - aFirstLast[1] + 1
  256.             ELSE
  257.               oTbr:cargo := nPrompt
  258.               oTbr:refreshAll()
  259.             ENDIF
  260.             DrawVertPrompts(oTbr, aMenuPrompts)
  261.             KEYBOARD Chr(K_ENTER)
  262.           ELSE
  263.             DO CASE
  264.               CASE nKey == K_ESC
  265.                 lExitRequested := .T.
  266.     
  267.               CASE nKey == K_ENTER
  268.                 IF ValType(aMenuPrompts[oTbr:cargo, 4]) == "B"
  269.                   Eval(aMenuPrompts[oTbr:cargo, 4])
  270.                 ELSE
  271.                   DoPullDown(Row() + 1, ;
  272.                              Col() + Int(2 * (nPromptsWidth / 3)), ;
  273.                              aMenuPrompts[oTbr:cargo, 4])
  274.                 ENDIF
  275.             ENDCASE
  276.           ENDIF
  277.         ENDIF
  278.       ENDDO
  279.     
  280.       RestScreen(oTbr:nTop - 1, oTbr:nLeft - 1, ;
  281.                  oTbr:nBottom + 1, oTbr:nRight + 1, cSaveScr)
  282.       @ nSaveRow, nSaveCol SAY ""
  283.     
  284.     RETURN NIL
  285.     
  286.     
  287.     FUNCTION DrawVertPrompts(oTbr, aMenuPrompts)
  288.     
  289.     LOCAL aColors := ColorSplit(SetColor())
  290.     LOCAL nHotCharOffset
  291.     LOCAL cSaveColor
  292.     LOCAL nSaveRow, nSaveCol
  293.     LOCAL i
  294.     LOCAL aFirstLast := Array(2)
  295.     
  296.       nSaveRow := Row()
  297.       nSaveCol := Col()
  298.     
  299.       FullStabilize(oTbr)
  300.       aFirstLast := GetFirstLast(oTbr)
  301.     
  302.       DispBegin()
  303.       cSaveColor := SetColor(aColors[2])
  304.     
  305.       FOR i := 1 TO aFirstLast[2] - aFirstLast[1] + 1
  306.         nHotCharOffset := At(aMenuPrompts[i + aFirstLast[1] - 1, 2], ;
  307.                              aMenuPrompts[i + aFirstLast[1] - 1, 1])
  308.         IF nHotCharOffset > 0
  309.           @ oTbr:nTop + i - 1, ;
  310.             oTbr:nLeft + nHotCharOffset - 1 ;
  311.             SAY aMenuPrompts[i + aFirstLast[1] - 1, 2]
  312.         ENDIF
  313.     
  314.       NEXT
  315.     
  316.       SetColor(cSaveColor)
  317.       @ nSaveRow, nSaveCol SAY ""
  318.       DispEnd()
  319.     
  320.     RETURN NIL
  321.     
  322.     
  323.     // Get the array indexes of the first and last prompts
  324.     
  325.     FUNCTION GetFirstLast(oTbr)
  326.     
  327.     LOCAL aFirstLast := Array(2)
  328.     LOCAL nSaveCurrent
  329.     LOCAL lSaveAutoLite
  330.     
  331.       nSaveCurrent := oTbr:rowPos
  332.       lSaveAutoLite := oTbr:autoLite
  333.     
  334.       DispBegin()
  335.     
  336.       oTbr:autoLite := .F.
  337.       oTbr:deHilite()
  338.     
  339.       oTbr:rowPos := 1
  340.       FullStabilize(oTbr)
  341.       aFirstLast[1] := oTbr:cargo
  342.     
  343.       oTbr:rowPos := oTbr:rowCount
  344.       FullStabilize(oTbr)
  345.       aFirstLast[2] := oTbr:cargo
  346.     
  347.       oTbr:rowPos := nSaveCurrent
  348.       oTbr:autoLite := lSaveAutoLite
  349.       FullStabilize(oTbr)
  350.     
  351.       DispEnd()
  352.     
  353.     RETURN aFirstLast
  354.     
  355.     
  356.     FUNCTION ColorSplit(cColorToSplit)
  357.     
  358.     LOCAL nColorNum, nNextComma, aColors[5]
  359.     
  360.       FOR nColorNum := 1 TO 4
  361.         nNextComma := At(",", cColorToSplit)
  362.         aColors[nColorNum] := Substr(cColorToSplit, 1, nNextComma - 1)
  363.         cColorToSplit := Substr(cColorToSplit, nNextComma + 1)
  364.       NEXT
  365.     
  366.       aColors[5] = cColorToSplit
  367.     
  368.     RETURN aColors
  369.  
  370.     
  371.     FUNCTION Msg(cMess)
  372.     
  373.     LOCAL cSaveScr := SaveScreen(MaxRow(), 0, MaxRow(), MaxCol())
  374.     LOCAL nSaveRow := Row()
  375.     LOCAL nSaveCol := Col()
  376.     
  377.       @ MaxRow(), 0
  378.       @ MAxRow(), 0 SAY cMess
  379.       InKey(0)
  380.       RestScreen(MaxRow(), 0, MaxRow(), MaxCol(), cSaveScr)
  381.       @ nSaveRow, nSaveCol SAY ""
  382.     
  383.     RETURN NIL
  384.