DP Tool Club 8/CDASC08.ISO/VRAC/SLD201.ZIP/OUTPUT.PRG

Text File | 1993-05-06 | 10.1 KB | 451 lines

*
*   File  : output.PRG
*   Author:
*   Date  : 05/05/1993
*



 PROCEDURE SCREEN1

  LOCAL WinStr,iRow

    SETMODE(25,80)

      WinStr=""
      SETCOLOR("B+/B")
      FOR iRow = 0 TO 25
        @ iRow,0 SAY PADC(WinStr,80,"░")
      NEXT


      SETCOLOR("W+/BG")
      @ 0,0,24,79 BOX "┌─┐│┘─└│"

        SETCOLOR("GR+/R,W/R,,,N/W")

      @ 2,25 SAY "    ACME Sales Database   "

      SETCOLOR("GR+/RB,W/R,,,N/W")

      @ 4,8 SAY "Short Name "
      @ 6,11 SAY "Company "
      @ 8,11 SAY "Address "
      @ 11,14 SAY "City "
      @ 13,5 SAY "Zip/Post Code "
      @ 15,15 SAY "Tel "
      @ 16,15 SAY "Fax "
      @ 18,9 SAY "Sales Area "
      @ 20,9 SAY "Sales Rep. "
      @ 18,44 SAY "Credit Limit "
      @ 14,43 SAY "Business Type "
      @ 4,39 SAY "Account No. "
      @ 16,48 SAY "Turnover "
      @ 20,46 SAY "Last Order "
      SETCOLOR("N/W,W/R,,,GR+/RB")
     DO SHOGET1
      SETCOLOR("GR+/RB,W/R,,,N/W")
     DO MENU1

 RETURN


 PROCEDURE SCREEN2

  LOCAL WinStr,iRow

    SETMODE(25,80)

      WinStr=""
      SETCOLOR("B+/B")
      FOR iRow = 0 TO 25
        @ iRow,0 SAY PADC(WinStr,80,"░")
      NEXT


      SETCOLOR("W+/BG")
      @ 0,0,24,79 BOX "┌─┐│┘─└│"

        SETCOLOR("GR+/R,W/R,,,N/W")

      @ 2,25 SAY "    Customer Contacts    "
      @ 16,8 SAY "Received: "

      SETCOLOR("GR+/RB,W/R,,,N/W")

      @ 9,49 SAY "Importance "
      @ 5,15 SAY "Short ID "
      @ 7,14 SAY "Firstname "
      @ 8,16 SAY "Surname "
      @ 10,18 SAY "Title "
      @ 12,14 SAY "Call Rate "
      @ 14,14 SAY "Interests "
      @ 16,21 SAY "Xmas Card? "
      @ 16,37 SAY "XMas Gift? "
      @ 16,53 SAY "Golf Day Invite? "
      @ 19,12 SAY "Note: "
      SETCOLOR("N/W,W/R,,,GR+/RB")
     DO SHOGET2
      SETCOLOR("GR+/RB,W/R,,,N/W")
     DO MENU2

 RETURN


 PROCEDURE SHOGET1

      @ 4,20 SAY aSHORTNAM
      @ 6,20 SAY aCOMPANY
      @ 8,20 SAY aADDRESS1
      @ 9,20 SAY aADDRESS2
      @ 10,20 SAY aADDRESS3
      @ 11,20 SAY aADDRESS4
      @ 13,20 SAY aPOSTCODE
      @ 15,20 SAY aTELNO
      @ 16,20 SAY aFAXNO
      @ 18,21 SAY aSALEAREA
      @ 20,21 SAY aSALESREP
      @ 18,58 SAY aCREDIT
      @ 14,58 SAY aBUSTYPE
      @ 4,52 SAY aACCNO
      @ 16,58 SAY aTURNTARG
      @ 20,58 SAY aLASTORD

 RETURN


 PROCEDURE SHOGET2

      @ 9,61 SAY aIMPORT
      @ 5,25 SAY bSHORTID
      @ 7,25 SAY bFIRSTNAM
      @ 8,25 SAY bSURNAME
      @ 10,25 SAY bTITLE
      @ 12,25 SAY bCALLRATE
      @ 14,25 SAY bINTEREST
      @ 16,33 SAY bXMASCARD
      @ 16,49 SAY bXMASGIFT
      @ 16,71 SAY bGOLFDAY
      @ 19,20 SAY bNOTE

 RETURN


 PROCEDURE GETSCR1

      @ 4,20 GET aSHORTNAM PICTURE "XXXXXXXXXX"
      @ 6,20 GET aCOMPANY PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
      @ 8,20 GET aADDRESS1 PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
      @ 9,20 GET aADDRESS2 PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
      @ 10,20 GET aADDRESS3 PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
      @ 11,20 GET aADDRESS4 PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
      @ 13,20 GET aPOSTCODE PICTURE "XXXXXXXXXXXXXXX"
      @ 15,20 GET aTELNO PICTURE "XXXXXXXXXXXXXXX"
      @ 16,20 GET aFAXNO PICTURE "XXXXXXXXXXXXXXX"
      @ 18,21 GET aSALEAREA PICTURE "X"
      @ 20,21 GET aSALESREP PICTURE "XXXXXXXXXXXXXXXXXXXX"
      @ 18,58 GET aCREDIT PICTURE "XXXXXXXXX"
      @ 14,58 GET aBUSTYPE PICTURE "XXXXXXXXXXXX"
      @ 4,52 GET aACCNO PICTURE "XXXXXXXXXXXXXXXXXXXX"
      @ 16,58 GET aTURNTARG PICTURE "XXXXXXXXXXX"
      @ 20,58 GET aLASTORD PICTURE "@D"
      READ

 RETURN


 PROCEDURE GETSCR2

      @ 9,61 GET aIMPORT PICTURE "X"
      @ 5,25 GET bSHORTID PICTURE "XXXXXXXXXX"
      @ 7,25 GET bFIRSTNAM PICTURE "XXXXXXXXXXXXXXXXXXXX"
      @ 8,25 GET bSURNAME PICTURE "XXXXXXXXXXXXXXXXXXXX"
      @ 10,25 GET bTITLE PICTURE "XXXXXXXXXXXXXXXXXXXX"
      @ 12,25 GET bCALLRATE PICTURE "XXXXXXXXXX"
      @ 14,25 GET bINTEREST PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
      @ 16,33 GET bXMASCARD PICTURE "X"
      @ 16,49 GET bXMASGIFT PICTURE "X"
      @ 16,71 GET bGOLFDAY PICTURE "X"
      @ 19,20 GET bNOTE PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
      READ

 RETURN


 PROCEDURE DECVARS1
    PUBLIC aSHORTNAM
    PUBLIC aCOMPANY
    PUBLIC aADDRESS1
    PUBLIC aADDRESS2
    PUBLIC aADDRESS3
    PUBLIC aADDRESS4
    PUBLIC aPOSTCODE
    PUBLIC aTELNO
    PUBLIC aFAXNO
    PUBLIC aSALEAREA
    PUBLIC aSALESREP
    PUBLIC aCREDIT
    PUBLIC aBUSTYPE
    PUBLIC aACCNO
    PUBLIC aTURNTARG
    PUBLIC aLASTORD
 RETURN


 PROCEDURE DECVARS2
    PUBLIC aIMPORT
    PUBLIC bSHORTID
    PUBLIC bFIRSTNAM
    PUBLIC bSURNAME
    PUBLIC bTITLE
    PUBLIC bCALLRATE
    PUBLIC bINTEREST
    PUBLIC bXMASCARD
    PUBLIC bXMASGIFT
    PUBLIC bGOLFDAY
    PUBLIC bNOTE
 RETURN


 PROCEDURE INITVARS1
   aSHORTNAM = SPACE(10)
   aCOMPANY = SPACE(30)
   aADDRESS1 = SPACE(30)
   aADDRESS2 = SPACE(30)
   aADDRESS3 = SPACE(30)
   aADDRESS4 = SPACE(30)
   aPOSTCODE = SPACE(15)
   aTELNO = SPACE(15)
   aFAXNO = SPACE(15)
   aSALEAREA = SPACE(1)
   aSALESREP = SPACE(20)
   aCREDIT = SPACE(9)
   aBUSTYPE = SPACE(12)
   aACCNO = SPACE(20)
   aTURNTARG = SPACE(11)
   aLASTORD = DATE()
 RETURN


 PROCEDURE INITVARS2
   aIMPORT = SPACE(1)
   bSHORTID = SPACE(10)
   bFIRSTNAM = SPACE(20)
   bSURNAME = SPACE(20)
   bTITLE = SPACE(20)
   bCALLRATE = SPACE(10)
   bINTEREST = SPACE(40)
   bXMASCARD = SPACE(1)
   bXMASGIFT = SPACE(1)
   bGOLFDAY = SPACE(1)
   bNOTE = SPACE(50)
 RETURN


 PROCEDURE SETVARS1
    aSHORTNAM = a->SHORTNAM
    aCOMPANY = a->COMPANY
    aADDRESS1 = a->ADDRESS1
    aADDRESS2 = a->ADDRESS2
    aADDRESS3 = a->ADDRESS3
    aADDRESS4 = a->ADDRESS4
    aPOSTCODE = a->POSTCODE
    aTELNO = a->TELNO
    aFAXNO = a->FAXNO
    aSALEAREA = a->SALEAREA
    aSALESREP = a->SALESREP
    aCREDIT = a->CREDIT
    aBUSTYPE = a->BUSTYPE
    aACCNO = a->ACCNO
    aTURNTARG = a->TURNTARG
    aLASTORD = a->LASTORD
 RETURN


 PROCEDURE SETVARS2
    aIMPORT = a->IMPORT
    bSHORTID = b->SHORTID
    bFIRSTNAM = b->FIRSTNAM
    bSURNAME = b->SURNAME
    bTITLE = b->TITLE
    bCALLRATE = b->CALLRATE
    bINTEREST = b->INTEREST
    bXMASCARD = b->XMASCARD
    bXMASGIFT = b->XMASGIFT
    bGOLFDAY = b->GOLFDAY
    bNOTE = b->NOTE
 RETURN


 PROCEDURE REPLVARS1
    REPLACE a->SHORTNAM WITH aSHORTNAM
    REPLACE a->COMPANY WITH aCOMPANY
    REPLACE a->ADDRESS1 WITH aADDRESS1
    REPLACE a->ADDRESS2 WITH aADDRESS2
    REPLACE a->ADDRESS3 WITH aADDRESS3
    REPLACE a->ADDRESS4 WITH aADDRESS4
    REPLACE a->POSTCODE WITH aPOSTCODE
    REPLACE a->TELNO WITH aTELNO
    REPLACE a->FAXNO WITH aFAXNO
    REPLACE a->SALEAREA WITH aSALEAREA
    REPLACE a->SALESREP WITH aSALESREP
    REPLACE a->CREDIT WITH aCREDIT
    REPLACE a->BUSTYPE WITH aBUSTYPE
    REPLACE a->ACCNO WITH aACCNO
    REPLACE a->TURNTARG WITH aTURNTARG
    REPLACE a->LASTORD WITH aLASTORD
 RETURN


 PROCEDURE REPLVARS2
    REPLACE a->IMPORT WITH aIMPORT
    REPLACE b->SHORTID WITH bSHORTID
    REPLACE b->FIRSTNAM WITH bFIRSTNAM
    REPLACE b->SURNAME WITH bSURNAME
    REPLACE b->TITLE WITH bTITLE
    REPLACE b->CALLRATE WITH bCALLRATE
    REPLACE b->INTEREST WITH bINTEREST
    REPLACE b->XMASCARD WITH bXMASCARD
    REPLACE b->XMASGIFT WITH bXMASGIFT
    REPLACE b->GOLFDAY WITH bGOLFDAY
    REPLACE b->NOTE WITH bNOTE
 RETURN


 PROCEDURE RELVARS1
    RELEASE aSHORTNAM
    RELEASE aCOMPANY
    RELEASE aADDRESS1
    RELEASE aADDRESS2
    RELEASE aADDRESS3
    RELEASE aADDRESS4
    RELEASE aPOSTCODE
    RELEASE aTELNO
    RELEASE aFAXNO
    RELEASE aSALEAREA
    RELEASE aSALESREP
    RELEASE aCREDIT
    RELEASE aBUSTYPE
    RELEASE aACCNO
    RELEASE aTURNTARG
    RELEASE aLASTORD
 RETURN


 PROCEDURE RELVARS2
    RELEASE aIMPORT
    RELEASE bSHORTID
    RELEASE bFIRSTNAM
    RELEASE bSURNAME
    RELEASE bTITLE
    RELEASE bCALLRATE
    RELEASE bINTEREST
    RELEASE bXMASCARD
    RELEASE bXMASGIFT
    RELEASE bGOLFDAY
    RELEASE bNOTE
 RETURN


 PROCEDURE DUMMY
 RETURN


 PROCEDURE MENU1
  LOCAL MKey

      SET ESCAPE OFF


        SETCOLOR("R/W,W/R,,,N/W")


      @ 22,5 PROMPT " ADD  " MESSAGE " "
      @ 22,14 PROMPT " EDIT " MESSAGE " "
      @ 22,23 PROMPT "DELETE" MESSAGE " "
      @ 22,32 PROMPT " NEXT " MESSAGE " "
      @ 22,41 PROMPT " PREV " MESSAGE " "
      @ 22,50 PROMPT " FIND " MESSAGE " "
      @ 22,69 PROMPT " QUIT " MESSAGE " "
      @ 22,59 PROMPT "CONTACT" MESSAGE " "
       MENU TO MKey
       DO MENUCASE1 WITH MKey
 RETURN


 PROCEDURE MENU2
  LOCAL MKey

      SET ESCAPE OFF


        SETCOLOR("R/W,W/R,,,N/W")


      @ 22,9 PROMPT " ADD  " MESSAGE " "
      @ 22,18 PROMPT " EDIT " MESSAGE " "
      @ 22,27 PROMPT "DELETE" MESSAGE " "
      @ 22,36 PROMPT " NEXT " MESSAGE " "
      @ 22,45 PROMPT " PREV " MESSAGE " "
      @ 22,54 PROMPT " FIND " MESSAGE " "
      @ 22,63 PROMPT "RETURN" MESSAGE " "
       MENU TO MKey
       DO MENUCASE2 WITH MKey
 RETURN


 PROCEDURE MENUCASE1
   PARAMETER MKey
    DO CASE

      CASE MKey = ASC("1")
         DO Dummy
      CASE MKey = ASC("2")
         DO Dummy
      CASE MKey = ASC("3")
         DO Dummy
      CASE MKey = ASC("4")
         DO Dummy
      CASE MKey = ASC("5")
         DO Dummy
      CASE MKey = ASC("6")
         DO Dummy
      CASE MKey = ASC("7")
         DO Dummy
      CASE MKey = ASC("8")
         DO Dummy
      OTHERWISE
*        This line is included for debugging purposes
         Disp_Bar = .F.

     ENDCASE
 RETURN


 PROCEDURE MENUCASE2
   PARAMETER MKey
    DO CASE

      CASE MKey = ASC("1")
         DO Dummy
      CASE MKey = ASC("2")
         DO Dummy
      CASE MKey = ASC("3")
         DO Dummy
      CASE MKey = ASC("4")
         DO Dummy
      CASE MKey = ASC("5")
         DO Dummy
      CASE MKey = ASC("6")
         DO Dummy
      CASE MKey = ASC("7")
         DO Dummy
      OTHERWISE
*        This line is included for debugging purposes
         Disp_Bar = .F.

     ENDCASE
 RETURN