home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
progmisc
/
sld.zip
/
OUTPUT.PRG
< prev
next >
Wrap
Text File
|
1993-05-06
|
10KB
|
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