home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / progmisc / sld.zip / DBASE3.PRG < prev    next >
Text File  |  1993-03-31  |  13KB  |  597 lines
  1.  
  2.  PROCEDURE SCREEN1
  3.  
  4.     PRIVATE iRow
  5.        SET COLOR ON
  6.  
  7.       SET COLOR TO B+/B
  8.       iRow = 0
  9.       DO WHILE iRow <25
  10.            @ iRow,0 SAY REPLICATE("░",80)
  11.            iRow = iRow+1
  12.       ENDDO
  13.  
  14.  
  15.       SET COLOR TO W+/BG
  16.       @ 0,0 TO 24,79 
  17.  
  18.       SET COLOR TO GR+/R
  19.  
  20.       @ 2,25 SAY "    ACME Sales Database   "
  21.  
  22.       SET COLOR TO GR+/RB,N/W
  23.  
  24.       @ 4,8 SAY "Short Name "
  25.       @ 6,11 SAY "Company "
  26.       @ 8,11 SAY "Address "
  27.       @ 9,20 SAY aADDRESS2 PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
  28.       @ 10,20 SAY aADDRESS3 PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
  29.       @ 11,14 SAY "City "
  30.       @ 13,5 SAY "Zip/Post Code "
  31.       @ 15,15 SAY "Tel "
  32.       @ 16,15 SAY "Fax "
  33.       @ 18,9 SAY "Sales Area "
  34.       @ 20,9 SAY "Sales Rep. "
  35.       @ 18,44 SAY "Credit Limit "
  36.       @ 14,43 SAY "Business Type "
  37.       @ 4,39 SAY "Account No. "
  38.       @ 16,48 SAY "Turnover "
  39.       @ 20,46 SAY "Last Order "
  40.      DO GETSCR1
  41.      DO MENU1
  42.  
  43.  RETURN
  44.  
  45.  
  46.  PROCEDURE SCREEN2
  47.  
  48.     PRIVATE iRow
  49.        SET COLOR ON
  50.  
  51.       SET COLOR TO B+/B
  52.       iRow = 0
  53.       DO WHILE iRow <25
  54.            @ iRow,0 SAY REPLICATE("░",80)
  55.            iRow = iRow+1
  56.       ENDDO
  57.  
  58.  
  59.       SET COLOR TO W+/BG
  60.       @ 0,0 TO 24,79 
  61.  
  62.       SET COLOR TO GR+/R
  63.  
  64.       @ 2,25 SAY "    Customer Contacts    "
  65.       @ 16,8 SAY "Received: "
  66.  
  67.       SET COLOR TO GR+/RB,N/W
  68.  
  69.       @ 9,49 SAY "Importance "
  70.       @ 5,15 SAY "Short ID "
  71.       @ 7,14 SAY "Firstname "
  72.       @ 8,16 SAY "Surname "
  73.       @ 10,18 SAY "Title "
  74.       @ 12,14 SAY "Call Rate "
  75.       @ 14,14 SAY "Interests "
  76.       @ 16,21 SAY "Xmas Card? "
  77.       @ 16,37 SAY "XMas Gift? "
  78.       @ 16,53 SAY "Golf Day Invite? "
  79.       @ 19,12 SAY "Note: "
  80.      DO GETSCR2
  81.      DO MENU1
  82.  
  83.  RETURN
  84.  
  85.  
  86.  PROCEDURE GETSCR1
  87.  
  88.       @ 4,20 GET aSHORTNAM PICTURE "XXXXXXXXXX"
  89.       @ 6,20 GET aCOMPANY PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
  90.       @ 8,20 GET aADDRESS1 PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
  91.       @ 9,20 GET aADDRESS2 PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
  92.       @ 10,20 GET aADDRESS3 PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
  93.       @ 11,20 GET aADDRESS4 PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
  94.       @ 13,20 GET aPOSTCODE PICTURE "XXXXXXXXXXXXXXX"
  95.       @ 15,20 GET aTELNO PICTURE "XXXXXXXXXXXXXXX"
  96.       @ 16,20 GET aFAXNO PICTURE "XXXXXXXXXXXXXXX"
  97.       @ 18,21 GET aSALEAREA PICTURE "X"
  98.       @ 20,21 GET aSALESREP PICTURE "XXXXXXXXXXXXXXXXXXXX"
  99.       @ 18,58 GET aCREDIT PICTURE "XXXXXXXXX"
  100.       @ 14,58 GET aBUSTYPE PICTURE "XXXXXXXXXXXX"
  101.       @ 4,52 GET aACCNO PICTURE "XXXXXXXXXXXXXXXXXXXX"
  102.       @ 16,58 GET aTURNTARG PICTURE "XXXXXXXXXXX"
  103.       @ 20,58 GET aLASTORD PICTURE "@D"
  104.  
  105.  RETURN
  106.  
  107.  
  108.  PROCEDURE GETSCR2
  109.  
  110.       @ 9,61 GET aIMPORT PICTURE "X"
  111.       @ 5,25 GET bSHORTID PICTURE "XXXXXXXXXX"
  112.       @ 7,25 GET bFIRSTNAM PICTURE "XXXXXXXXXXXXXXXXXXXX"
  113.       @ 8,25 GET bSURNAME PICTURE "XXXXXXXXXXXXXXXXXXXX"
  114.       @ 10,25 GET bTITLE PICTURE "XXXXXXXXXXXXXXXXXXXX"
  115.       @ 12,25 GET bCALLRATE PICTURE "XXXXXXXXXX"
  116.       @ 14,25 GET bINTEREST PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
  117.       @ 16,33 GET bXMASCARD PICTURE "X"
  118.       @ 16,49 GET bXMASGIFT PICTURE "X"
  119.       @ 16,71 GET bGOLFDAY PICTURE "X"
  120.       @ 19,20 GET bNOTE PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
  121.  
  122.  RETURN
  123.  
  124.  
  125.  PROCEDURE DECVARS1
  126.     PUBLIC aSHORTNAM
  127.     PUBLIC aCOMPANY
  128.     PUBLIC aADDRESS1
  129.     PUBLIC aADDRESS2
  130.     PUBLIC aADDRESS3
  131.     PUBLIC aADDRESS4
  132.     PUBLIC aPOSTCODE
  133.     PUBLIC aTELNO
  134.     PUBLIC aFAXNO
  135.     PUBLIC aSALEAREA
  136.     PUBLIC aSALESREP
  137.     PUBLIC aCREDIT
  138.     PUBLIC aBUSTYPE
  139.     PUBLIC aACCNO
  140.     PUBLIC aTURNTARG
  141.     PUBLIC aLASTORD
  142.  RETURN
  143.  
  144.  
  145.  PROCEDURE DECVARS2
  146.     PUBLIC aIMPORT
  147.     PUBLIC bSHORTID
  148.     PUBLIC bFIRSTNAM
  149.     PUBLIC bSURNAME
  150.     PUBLIC bTITLE
  151.     PUBLIC bCALLRATE
  152.     PUBLIC bINTEREST
  153.     PUBLIC bXMASCARD
  154.     PUBLIC bXMASGIFT
  155.     PUBLIC bGOLFDAY
  156.     PUBLIC bNOTE
  157.  RETURN
  158.  
  159.  
  160.  PROCEDURE INITVARS1
  161.    aSHORTNAM = SPACE(10)
  162.    aCOMPANY = SPACE(30)
  163.    aADDRESS1 = SPACE(30)
  164.    aADDRESS2 = SPACE(30)
  165.    aADDRESS3 = SPACE(30)
  166.    aADDRESS4 = SPACE(30)
  167.    aPOSTCODE = SPACE(15)
  168.    aTELNO = SPACE(15)
  169.    aFAXNO = SPACE(15)
  170.    aSALEAREA = SPACE(1)
  171.    aSALESREP = SPACE(20)
  172.    aCREDIT = SPACE(9)
  173.    aBUSTYPE = SPACE(12)
  174.    aACCNO = SPACE(20)
  175.    aTURNTARG = SPACE(11)
  176.    aLASTORD = DATE()
  177.  RETURN
  178.  
  179.  
  180.  PROCEDURE INITVARS2
  181.    aIMPORT = SPACE(1)
  182.    bSHORTID = SPACE(10)
  183.    bFIRSTNAM = SPACE(20)
  184.    bSURNAME = SPACE(20)
  185.    bTITLE = SPACE(20)
  186.    bCALLRATE = SPACE(10)
  187.    bINTEREST = SPACE(40)
  188.    bXMASCARD = SPACE(1)
  189.    bXMASGIFT = SPACE(1)
  190.    bGOLFDAY = SPACE(1)
  191.    bNOTE = SPACE(50)
  192.  RETURN
  193.  
  194.  
  195.  PROCEDURE SETVARS1
  196.     aSHORTNAM = a->SHORTNAM
  197.     aCOMPANY = a->COMPANY
  198.     aADDRESS1 = a->ADDRESS1
  199.     aADDRESS2 = a->ADDRESS2
  200.     aADDRESS3 = a->ADDRESS3
  201.     aADDRESS4 = a->ADDRESS4
  202.     aPOSTCODE = a->POSTCODE
  203.     aTELNO = a->TELNO
  204.     aFAXNO = a->FAXNO
  205.     aSALEAREA = a->SALEAREA
  206.     aSALESREP = a->SALESREP
  207.     aCREDIT = a->CREDIT
  208.     aBUSTYPE = a->BUSTYPE
  209.     aACCNO = a->ACCNO
  210.     aTURNTARG = a->TURNTARG
  211.     aLASTORD = a->LASTORD
  212.  RETURN
  213.  
  214.  
  215.  PROCEDURE SETVARS2
  216.     aIMPORT = a->IMPORT
  217.     bSHORTID = b->SHORTID
  218.     bFIRSTNAM = b->FIRSTNAM
  219.     bSURNAME = b->SURNAME
  220.     bTITLE = b->TITLE
  221.     bCALLRATE = b->CALLRATE
  222.     bINTEREST = b->INTEREST
  223.     bXMASCARD = b->XMASCARD
  224.     bXMASGIFT = b->XMASGIFT
  225.     bGOLFDAY = b->GOLFDAY
  226.     bNOTE = b->NOTE
  227.  RETURN
  228.  
  229.  
  230.  PROCEDURE REPLVARS1
  231.     REPLACE a->SHORTNAM WITH aSHORTNAM
  232.     REPLACE a->COMPANY WITH aCOMPANY
  233.     REPLACE a->ADDRESS1 WITH aADDRESS1
  234.     REPLACE a->ADDRESS2 WITH aADDRESS2
  235.     REPLACE a->ADDRESS3 WITH aADDRESS3
  236.     REPLACE a->ADDRESS4 WITH aADDRESS4
  237.     REPLACE a->POSTCODE WITH aPOSTCODE
  238.     REPLACE a->TELNO WITH aTELNO
  239.     REPLACE a->FAXNO WITH aFAXNO
  240.     REPLACE a->SALEAREA WITH aSALEAREA
  241.     REPLACE a->SALESREP WITH aSALESREP
  242.     REPLACE a->CREDIT WITH aCREDIT
  243.     REPLACE a->BUSTYPE WITH aBUSTYPE
  244.     REPLACE a->ACCNO WITH aACCNO
  245.     REPLACE a->TURNTARG WITH aTURNTARG
  246.     REPLACE a->LASTORD WITH aLASTORD
  247.  RETURN
  248.  
  249.  
  250.  PROCEDURE REPLVARS2
  251.     REPLACE a->IMPORT WITH aIMPORT
  252.     REPLACE b->SHORTID WITH bSHORTID
  253.     REPLACE b->FIRSTNAM WITH bFIRSTNAM
  254.     REPLACE b->SURNAME WITH bSURNAME
  255.     REPLACE b->TITLE WITH bTITLE
  256.     REPLACE b->CALLRATE WITH bCALLRATE
  257.     REPLACE b->INTEREST WITH bINTEREST
  258.     REPLACE b->XMASCARD WITH bXMASCARD
  259.     REPLACE b->XMASGIFT WITH bXMASGIFT
  260.     REPLACE b->GOLFDAY WITH bGOLFDAY
  261.     REPLACE b->NOTE WITH bNOTE
  262.  RETURN
  263.  
  264.  
  265.  PROCEDURE RELVARS1
  266.     RELEASE aSHORTNAM
  267.     RELEASE aCOMPANY
  268.     RELEASE aADDRESS1
  269.     RELEASE aADDRESS2
  270.     RELEASE aADDRESS3
  271.     RELEASE aADDRESS4
  272.     RELEASE aPOSTCODE
  273.     RELEASE aTELNO
  274.     RELEASE aFAXNO
  275.     RELEASE aSALEAREA
  276.     RELEASE aSALESREP
  277.     RELEASE aCREDIT
  278.     RELEASE aBUSTYPE
  279.     RELEASE aACCNO
  280.     RELEASE aTURNTARG
  281.     RELEASE aLASTORD
  282.  RETURN
  283.  
  284.  
  285.  PROCEDURE RELVARS2
  286.     RELEASE aIMPORT
  287.     RELEASE bSHORTID
  288.     RELEASE bFIRSTNAM
  289.     RELEASE bSURNAME
  290.     RELEASE bTITLE
  291.     RELEASE bCALLRATE
  292.     RELEASE bINTEREST
  293.     RELEASE bXMASCARD
  294.     RELEASE bXMASGIFT
  295.     RELEASE bGOLFDAY
  296.     RELEASE bNOTE
  297.  RETURN
  298.  
  299.  
  300.  PROCEDURE DUMMY
  301.  RETURN
  302.  
  303.  
  304.  PROCEDURE MENU1
  305.   PRIVATE MKey
  306.   PRIVATE Disp_Bar, C, Choice, PosRow,PosCol
  307.    PRIVATE Choice1, Msg1
  308.    PRIVATE Choice2, Msg2
  309.    PRIVATE Choice3, Msg3
  310.    PRIVATE Choice4, Msg4
  311.    PRIVATE Choice5, Msg5
  312.    PRIVATE Choice6, Msg6
  313.    PRIVATE Choice7, Msg7
  314.    PRIVATE Choice8, Msg8
  315.  
  316.       SET ESCAPE OFF
  317.  
  318.  
  319.       SET COLOR TO R/W
  320.  
  321.  
  322.       Choice1 = " ADD  "
  323.       Msg1 = " "
  324.       @ 22,5 SAY Choice1
  325.       Choice2 = " EDIT "
  326.       Msg2 = " "
  327.       @ 22,14 SAY Choice2
  328.       Choice3 = "DELETE"
  329.       Msg3 = " "
  330.       @ 22,23 SAY Choice3
  331.       Choice4 = " NEXT "
  332.       Msg4 = " "
  333.       @ 22,32 SAY Choice4
  334.       Choice5 = " PREV "
  335.       Msg5 = " "
  336.       @ 22,41 SAY Choice5
  337.       Choice6 = " FIND "
  338.       Msg6 = " "
  339.       @ 22,50 SAY Choice6
  340.       Choice7 = " QUIT "
  341.       Msg7 = " "
  342.       @ 22,69 SAY Choice7
  343.       Choice8 = "CONTACT"
  344.       Msg8 = " "
  345.       @ 22,59 SAY Choice8
  346.  
  347.        MKey = 1
  348.        PosRow = 22
  349.        PosCol = 5
  350.        Disp_Bar = .T.
  351.        C = 0
  352.        DO WHILE Disp_Bar
  353.           Choice = "Choice" + LTRIM(STR(MKey))
  354.  
  355.       SET COLOR TO W/R
  356.  
  357.           @ PosRow,PosCol SAY &Choice
  358.           @ PosRow,PosCol SAY LEFT(&Choice,1)
  359.  
  360.       SET COLOR TO R/W
  361.  
  362.           IF C <> 13
  363.             C = 0
  364.             DO WHILE C = 0
  365.               C = INKEY()
  366.             ENDDO
  367.           ENDIF
  368.  
  369.           @ PosRow,PosCol SAY &Choice
  370.           DO CASE
  371.             CASE C = 5
  372.               IF MKey>1 
  373.                 MKey = MKey-1
  374.               ENDIF
  375.             CASE C = 9 .OR. C = 24
  376.               IF MKey<8
  377.                 MKey = MKey+1
  378.               ELSE
  379.                 MKey = 1
  380.               ENDIF
  381.             CASE C = 13
  382.               DO MENUCASE1 WITH MKey
  383.               C = 0
  384.             CASE C = 27
  385.               EXIT
  386.           ENDCASE
  387.           DO NEWPOS1 WITH MKey
  388.        ENDDO
  389.  RETURN
  390.  
  391.  
  392.  PROCEDURE MENU2
  393.   PRIVATE MKey
  394.   PRIVATE Disp_Bar, C, Choice, PosRow,PosCol
  395.    PRIVATE Choice1, Msg1
  396.    PRIVATE Choice2, Msg2
  397.    PRIVATE Choice3, Msg3
  398.    PRIVATE Choice4, Msg4
  399.    PRIVATE Choice5, Msg5
  400.    PRIVATE Choice6, Msg6
  401.    PRIVATE Choice7, Msg7
  402.  
  403.       SET ESCAPE OFF
  404.  
  405.  
  406.       SET COLOR TO R/W
  407.  
  408.  
  409.       Choice1 = " ADD  "
  410.       Msg1 = " "
  411.       @ 22,9 SAY Choice1
  412.       Choice2 = " EDIT "
  413.       Msg2 = " "
  414.       @ 22,18 SAY Choice2
  415.       Choice3 = "DELETE"
  416.       Msg3 = " "
  417.       @ 22,27 SAY Choice3
  418.       Choice4 = " NEXT "
  419.       Msg4 = " "
  420.       @ 22,36 SAY Choice4
  421.       Choice5 = " PREV "
  422.       Msg5 = " "
  423.       @ 22,45 SAY Choice5
  424.       Choice6 = " FIND "
  425.       Msg6 = " "
  426.       @ 22,54 SAY Choice6
  427.       Choice7 = "RETURN"
  428.       Msg7 = " "
  429.       @ 22,63 SAY Choice7
  430.  
  431.        MKey = 1
  432.        PosRow = 22
  433.        PosCol = 5
  434.        Disp_Bar = .T.
  435.        C = 0
  436.        DO WHILE Disp_Bar
  437.           Choice = "Choice" + LTRIM(STR(MKey))
  438.  
  439.       SET COLOR TO W/R
  440.  
  441.           @ PosRow,PosCol SAY &Choice
  442.           @ PosRow,PosCol SAY LEFT(&Choice,1)
  443.  
  444.       SET COLOR TO R/W
  445.  
  446.           IF C <> 13
  447.             C = 0
  448.             DO WHILE C = 0
  449.               C = INKEY()
  450.             ENDDO
  451.           ENDIF
  452.  
  453.           @ PosRow,PosCol SAY &Choice
  454.           DO CASE
  455.             CASE C = 5
  456.               IF MKey>1 
  457.                 MKey = MKey-1
  458.               ENDIF
  459.             CASE C = 9 .OR. C = 24
  460.               IF MKey<7
  461.                 MKey = MKey+1
  462.               ELSE
  463.                 MKey = 1
  464.               ENDIF
  465.             CASE C = 13
  466.               DO MENUCASE2 WITH MKey
  467.               C = 0
  468.             CASE C = 27
  469.               EXIT
  470.           ENDCASE
  471.           DO NEWPOS2 WITH MKey
  472.        ENDDO
  473.  RETURN
  474.  
  475.  
  476.  PROCEDURE MENUCASE1
  477.    PARAMETER MKey
  478.  
  479.       SET COLOR TO R/W
  480.  
  481.     DO CASE
  482.  
  483.       CASE MKey = 1
  484.          DO Dummy
  485.       CASE MKey = 2
  486.          DO Dummy
  487.       CASE MKey = 3
  488.          DO Dummy
  489.       CASE MKey = 4
  490.          DO Dummy
  491.       CASE MKey = 5
  492.          DO Dummy
  493.       CASE MKey = 6
  494.          DO Dummy
  495.       CASE MKey = 7
  496.          DO Dummy
  497.       CASE MKey = 8
  498.          DO Dummy
  499.  
  500.      ENDCASE
  501.  RETURN
  502.  
  503.  
  504.  PROCEDURE MENUCASE2
  505.    PARAMETER MKey
  506.  
  507.       SET COLOR TO R/W
  508.  
  509.     DO CASE
  510.  
  511.       CASE MKey = 1
  512.          DO Dummy
  513.       CASE MKey = 2
  514.          DO Dummy
  515.       CASE MKey = 3
  516.          DO Dummy
  517.       CASE MKey = 4
  518.          DO Dummy
  519.       CASE MKey = 5
  520.          DO Dummy
  521.       CASE MKey = 6
  522.          DO Dummy
  523.       CASE MKey = 7
  524.          DO Dummy
  525.  
  526.      ENDCASE
  527.  RETURN
  528.  
  529.  
  530.  PROCEDURE NEWPOS1
  531.   PARAMETER MKey
  532.  
  533.     DO CASE
  534.  
  535.       CASE MKey = 1
  536.          PosRow = 22
  537.          PosCol = 5
  538.       CASE MKey = 2
  539.          PosRow = 22
  540.          PosCol = 14
  541.       CASE MKey = 3
  542.          PosRow = 22
  543.          PosCol = 23
  544.       CASE MKey = 4
  545.          PosRow = 22
  546.          PosCol = 32
  547.       CASE MKey = 5
  548.          PosRow = 22
  549.          PosCol = 41
  550.       CASE MKey = 6
  551.          PosRow = 22
  552.          PosCol = 50
  553.       CASE MKey = 7
  554.          PosRow = 22
  555.          PosCol = 69
  556.       CASE MKey = 8
  557.          PosRow = 22
  558.          PosCol = 59
  559.  
  560.  
  561.      ENDCASE
  562.  RETURN
  563.  
  564.  
  565.  PROCEDURE NEWPOS2
  566.   PARAMETER MKey
  567.  
  568.     DO CASE
  569.  
  570.       CASE MKey = 1
  571.          PosRow = 22
  572.          PosCol = 9
  573.       CASE MKey = 2
  574.          PosRow = 22
  575.          PosCol = 18
  576.       CASE MKey = 3
  577.          PosRow = 22
  578.          PosCol = 27
  579.       CASE MKey = 4
  580.          PosRow = 22
  581.          PosCol = 36
  582.       CASE MKey = 5
  583.          PosRow = 22
  584.          PosCol = 45
  585.       CASE MKey = 6
  586.          PosRow = 22
  587.          PosCol = 54
  588.       CASE MKey = 7
  589.          PosRow = 22
  590.          PosCol = 63
  591.  
  592.  
  593.      ENDCASE
  594.  RETURN
  595.  
  596.  
  597.