home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 17 / CD_ASCQ_17_101194.iso / vrac / sampdb1.zip / SAMPLEDB.BAS < prev    next >
BASIC Source File  |  1994-08-30  |  20KB  |  708 lines
  1. 'written By Bill Slamer
  2.  DEFLNG A-Z
  3.  DECLARE SUB CLOSEALL ()
  4.  DECLARE SUB BINARYSEARCH ()
  5.  DECLARE SUB READFILE ()
  6.  DECLARE SUB CLEARRECORD ()
  7.  DECLARE SUB UPDATEINDEX ()
  8.  DECLARE SUB LOADDATAFIELDS ()
  9.  DECLARE SUB PRINTRECORDS ()
  10.  DECLARE SUB SHOWMENU ()
  11.  DECLARE SUB LOADEDITFIELD ()
  12.  DECLARE SUB UPDATEREC ()
  13.  DECLARE SUB EDITCUSTOMER ()
  14.  DECLARE SUB OPENFILES ()
  15.  DECLARE SUB SORTINDEX ()
  16.  DECLARE SUB SHOWCUSTOMERS ()
  17.  DECLARE SUB DELETERECORD ()
  18.  DECLARE SUB CHECKFORDUPS ()
  19. $INCLUDE "Arrowkey.Inc"
  20.  COLOR 15, 1: CLS
  21.  DIM Fielddesc$(10), Fieldlen(10), Deleted(50)
  22.  DIM Editfield$(10), Menu$(10)
  23.  DIM Index$(2000), Index(2000)
  24. SHARED Fielddesc$(), Fieldlen(), Deleted()
  25. SHARED Editfield$(), Menu$(),Index$(),Index()
  26. SHARED Mrow, Currec, Y$, Deleted, D$, Dup,Lof1,Lof2
  27. SHARED Maxrows, Row, Currtop, Extnd, Arraylocation
  28. SHARED Add, Set
  29.  CLS
  30.  Type Customerrecord
  31.  F1Name     AS String * 15
  32.  Lname     AS String * 15
  33.  Address   AS String * 30
  34.  City      AS String * 20
  35.  State     AS String * 2
  36.  Zip       AS String * 5
  37.  Date      AS String * 10
  38.  END Type
  39.  DIM Custrec AS Customerrecord
  40.  Type Indexrecord
  41.  Newrec AS String * 30
  42.  Recno  AS Long
  43.  END Type
  44.  DIM Ir AS Indexrecord
  45. SHARED Ir,Custrec
  46. '*** load Menu Selections
  47. DATA View all customers, Edit a customer record
  48. DATA Add a customer record,Print all customer records,Read data from file,Quit
  49.  FOR X = 1 TO 6
  50.    READ Menu$(X)
  51.    Menu$(X) = LEFT$("     " + Menu$(X) + SPACE$(50), 50)
  52.  NEXT
  53. '*** load Array With Record Fields
  54.  FOR X = 1 TO 7: READ Fielddesc$(X), Fieldlen(X): NEXT
  55. DATA First Name,15,Last Name,15,Address,30,City,20,State,2,Zip,5,Date,10
  56.  Openfiles  'open Any Files That Need To Be Opened
  57.  Showmenu  'display Menu
  58.  
  59. '------------------------------------------------------------------------------
  60. SUB BINARYSEARCH
  61. SHARED N$,Lof2,Dup,Mid,Ir
  62.  Low = 1: High = Lof2
  63.  DO
  64.    Mid = INT((Low + High) / 2)
  65.    IF Low > High THEN
  66.      LOCATE 15, 35: PRINT "Saved"
  67.      Dup = 0
  68.      EXIT DO
  69.    END IF
  70.    GET #2, Mid, Ir
  71.    IF Ir.Newrec = LEFT$(N$,30) THEN
  72.      LOCATE 15, 26: PRINT "Duplicate First & Last name"
  73.      Dup = 1
  74.      EXIT DO
  75.    END IF
  76.    IF Ir.Newrec < N$ THEN Low = Mid + 1 ELSE High = Mid - 1
  77.  LOOP
  78. END SUB
  79.  
  80. '------------------------------------------------------------------------------
  81. SUB BINARYSEARCH1
  82. SHARED N$,Lof2,Dup,Mid,Ir,Nf
  83.  Low = 1: High = Lof2
  84.  DO
  85.    COLOR 15,1:CLS
  86.    Mid = INT((Low + High) / 2)
  87.    IF Low > High THEN
  88.      LOCATE 15, 15: PRINT "No records starting with the letter ";N$
  89.      X$=INPUT$(1)
  90.      Nf=1
  91.      EXIT DO
  92.    END IF
  93.    GET #2, Mid, Ir
  94.    IF LEFT$(Ir.Newrec,1) = N$ THEN
  95.      EXIT DO
  96.    END IF
  97.    IF Ir.Newrec < N$ THEN Low = Mid + 1 ELSE High = Mid - 1
  98.  LOOP
  99. END SUB
  100.  
  101. '------------------------------------------------------------------------------
  102. SUB CHECKFORDUPS
  103. SHARED Dup, Index$(), Maxrows, Editfield$()
  104.  Binarysearch
  105. END SUB
  106.  
  107. '------------------------------------------------------------------------------
  108. SUB CLEARRECORD
  109. SHARED Fielddesc(),Editfield
  110.  FOR X = 1 TO 7
  111.    COLOR 15, 1: LOCATE X + 4, 11: PRINT Fielddesc$(X)
  112.    Editfield$(X) = SPACE$(Fieldlen(X))
  113.    Editfield$(7) = DATE$
  114.    COLOR , 0: LOCATE X + 4, 22: PRINT Editfield$(X)
  115.  NEXT
  116. END SUB
  117.  
  118. '------------------------------------------------------------------------------
  119. SUB CLOSEALL
  120.  Close
  121.  OPEN "deleted" FOR OUTPUT AS 3
  122.  FOR X = 1 TO Deleted
  123.    PRINT #3, Deleted(X)
  124.  NEXT
  125.  CLOSE#3
  126. END SUB
  127.  
  128. '------------------------------------------------------------------------------
  129. SUB DELETERECORD
  130. SHARED  Deleted(), Deleted, D$, Mid,Ir,N1$,N$
  131.  N$=N1$    '=Index$(Row+Extnd)
  132.  BinarySearch
  133.  COLOR 15, 4
  134.  R=0
  135.  LOCATE 16, 14: PRINT "Are you sure you want to delete this record (Y or N)";
  136.  D$ = INPUT$(1): D$ = UCASE$(D$)
  137.  COLOR 15, 1
  138.  IF D$ = "N" THEN
  139.    LOCATE 16, 14: PRINT SPACE$(55);
  140.    EXIT SUB
  141.  END IF
  142.    LOCATE 16, 14: PRINT SPACE$(55);
  143.    COLOR 31,1:LOCATE 16, 14: PRINT "Updating Index":COLOR 15,1
  144.  OPEN "TEMP.ndx" FOR RANDOM AS 3 LEN = LEN(Ir)
  145.  Lof2 = LOF(2) / LEN(Ir)
  146.  FOR X = 1 TO Lof2
  147.    Get#2,X,Ir
  148.    if x<>MID then
  149.       incr R
  150.       PUT#3,R,Ir
  151.    End If
  152.  NEXT
  153.  Deleted = Deleted + 1
  154.  Deleted(Deleted) = MID
  155.  CloseAll
  156.  kill"Names.ndx"
  157.  name"Temp.ndx" as "Names.ndx"
  158.  OpenFiles
  159. END SUB
  160.  
  161. '------------------------------------------------------------------------------
  162. SUB EDITCUSTOMER
  163. 'this Routine Is Used For Editing And Adding Records
  164. SHARED Maxrows, Currec, Index(), Index$(), Deleted(), Deleted, D$, Dup, Mrow
  165. SHARED Add,N$
  166.  COLOR 15, 1: CLS
  167.  Lof1 = LOF(1) / LEN(Custrec)
  168.  Lof2 = LOF(2) / LEN(Ir)
  169.  Add = 0: Dup = 0
  170.  LOCATE 1, 60: PRINT "] Insert OFF ["
  171.  FOR X = 1 TO 10
  172.    COLOR 15, 1: LOCATE X + 4, 11: PRINT Fielddesc$(X)
  173.    IF Mrow = 3 THEN
  174.      Editfield$(X) = SPACE$(Fieldlen(X))
  175.    END IF
  176.    IF Mrow = 3 THEN Editfield$(7) = DATE$
  177.    COLOR , 0: LOCATE X + 4, 22: PRINT Editfield$(X)
  178.  NEXT
  179.  IF Mrow = 2 THEN
  180.    LOCATE 18, 13: PRINT CHR$(24) + CHR$(25) + " " + CHR$(26) + CHR$(27) + " <Alt U>pdate  <ESC> quit  <Ins>  <Alt D>elete"
  181.  ELSE
  182.    LOCATE 18, 20: PRINT CHR$(24) + CHR$(25) + " " + CHR$(26) + CHR$(27) + " <Alt S>ave  <ESC> quit  <Ins>"
  183.  END IF
  184.  
  185.  Row = 1: Col = 1: Nooffields = 7
  186.  DO
  187.    COLOR 0, 7: LOCATE Row + 4, Col + 21
  188.    PRINT MID$(Editfield$(Row), Col, 1)
  189.    X$ = "": WHILE X$ = "": X$ = Inkey$: Wend: X$ = UCASE$(X$)
  190.    COLOR 15, 0: LOCATE Row + 4, Col + 21
  191.    PRINT MID$(Editfield$(Row), Col, 1)
  192.    SELECT CASE X$
  193.      CASE CHR$(0) + CHR$(32)
  194.        Deleterecord
  195.        IF D$ = "Y" THEN
  196.          EXIT SUB
  197.        END IF
  198.      CASE Esc$
  199.        IF Added = 1 THEN
  200.          Added = 0
  201.          COLOR 31, 1
  202.          LOCATE 15, 25: PRINT "Updating index"
  203.          COLOR 15, 1
  204.          Sortindex
  205.          Lof2 = Lof2 + 1
  206.          Updateindex
  207.          Row = 1: Col = 1
  208.          GOSUB LOADINDEX
  209.        END IF
  210.        COLOR 15, 1: CLS
  211.        EXIT SUB
  212.      CASE CHR$(0) + CHR$(22)  'alt U (update Record)
  213.        IF Mrow = 2 THEN    'make Sure Programe Is In Edit Mode
  214.        COLOR 15, 1: CLS  'before Allowing Update.
  215.        Loaddatafields
  216.        Updaterec
  217.        EXIT SUB
  218.      END IF
  219.    CASE CHR$(0) + CHR$(31)  'alt S (save New Record)
  220. '*** everything Entered Is Stored In Editfield$() array.
  221.      IF Mrow = 3 THEN     'make Sure Program Is In Add Mode
  222.      N$=Editfield$(2)+", "+EditField$(1)  'before allowing SAVE.
  223.      Checkfordups
  224.      IF Dup = 0 THEN
  225.        COLOR 15, 1: CLS
  226.        Lof1 = Lof1 + 1
  227.        Added = 1
  228.        Loaddatafields
  229.        Add = Add + 1
  230.        IF Deleted > 0 THEN
  231.          Currec = Deleted(Deleted)
  232.          Deleted = Deleted - 1
  233.        ELSE
  234.          Currec = Lof1
  235.        END IF
  236.        Index$(Add) = Custrec.Lname + ", " + Custrec.F1Name
  237.        Index(Add) = Currec
  238.        Updaterec
  239.        Clearrecord
  240.        Row = 1: Col = 1
  241.      END IF
  242.    END IF
  243.  CASE Uparrow$
  244.    Col = 1: Row = Row - 1: IF Row < 1 THEN Row = Nooffields
  245.  CASE Dnarrow$, Enter$
  246.    Col = 1: Row = Row + 1: IF Row > Nooffields THEN Row = 1
  247.  CASE Larrow$
  248.    Col = Col - 1: IF Col < 1 THEN Col = Fieldlen(Row)
  249.  CASE Rarrow$
  250.    Col = Col + 1: IF Col > Fieldlen(Row) THEN Col = 1
  251.  CASE Pgup$
  252.    Col = 1: Row = 1
  253.  CASE Pgdn$
  254.    Col = 1: Row = Nooffields
  255.  CASE Ins$
  256.    COLOR , 1
  257.    IF Inc = 1 THEN
  258.      Inc = 0: LOCATE 1, 60: PRINT "] Insert OFF ["
  259.    ELSE
  260.      Inc = 1: LOCATE 1, 60: PRINT "] Insert ON  ["
  261.    END IF
  262.    COLOR , 0
  263.  CASE Del$
  264.    F$ = MID$(Editfield$(Row), Col + 1, Fieldlen(Row))
  265.    F1$ = LEFT$(Editfield$(Row), Col - 1) + F$ + " "
  266.    Editfield$(Row) = F1$
  267.    LOCATE Row + 4, 22: PRINT Editfield$(Row)
  268.  CASE Homek$
  269.    Col = 1: IF Row = 5 OR Row = 6 THEN Col = 2
  270.  CASE Endk$
  271.    Col = Fieldlen(Row)
  272.  CASE Bs$
  273.    IF Col > 1 THEN
  274.      F$ = MID$(Editfield$(Row), Col, Fieldlen(Row))
  275.      F1$ = LEFT$(Editfield$(Row), Col - 2) + F$ + " "
  276.      Editfield$(Row) = F1$
  277.      Col = Col - 1: IF Col < 1 THEN Col = 1
  278.      LOCATE Row + 4, 22: PRINT Editfield$(Row)
  279.    END IF
  280.  CASE > CHR$(31)
  281.    IF X$ < CHR$(126) THEN
  282.      IF Inc = 1 THEN
  283.        F$ = MID$(Editfield$(Row), Col, Fieldlen(Row))
  284.        F1$ = LEFT$(LEFT$(Editfield$(Row), Col - 1) + X$ + F$, Fieldlen(Row))
  285.        Editfield$(Row) = F1$
  286.        Col = Col + 1: IF Col > Fieldlen(Row) THEN Col = 1
  287.        LOCATE Row + 4, 22: PRINT Editfield$(Row)
  288.      ELSE
  289.        MID$(Editfield$(Row), Col) = X$
  290.        LOCATE Row + 4, 22: PRINT Editfield$(Row)
  291.        Col = Col + 1: IF Col > Fieldlen(Row) THEN Col = 1
  292.      END IF
  293.    END IF
  294.  END SELECT
  295.  LOOP
  296. LOADINDEX:
  297.  Maxrows=0
  298.  Lof2 = LOF(2) / LEN(Ir)
  299.  FOR X = 1 TO Lof2
  300.    GET #2, X, Ir
  301.    Maxrows = Maxrows + 1
  302.    Index$(Maxrows) = Ir.Newrec
  303.    Index(Maxrows) = Ir.Recno
  304.    IF X = 2000 THEN EXIT FOR
  305.  NEXT
  306.  RETURN
  307. END SUB
  308.  
  309. '------------------------------------------------------------------------------
  310. SUB GETFIRSTLETTER
  311. SHARED F1$,N$,Mid,Nf,C
  312.  LOCATE 5,10:INPUT"Enter FIRST letter of names to view ",N$
  313.  N$=UCASE$(N$)
  314.  C=0
  315.  Binarysearch1
  316.  IF Nf=1 THEN EXIT SUB
  317.  DO
  318.    Get#2,Mid-1,Ir
  319.    IF LEFT$(Ir.Newrec,1)<>N$ THEN EXIT DO
  320.    Mid=Mid-1
  321.  LOOP
  322.  DO
  323.    Get#2,Mid,Ir
  324.    IF LEFT$(Ir.Newrec,1)<>N$ THEN EXIT DO
  325.    INCR C
  326.    Index$(C)=Ir.Newrec
  327.    Index(C)=Ir.Recno
  328.    INCR Mid
  329.  LOOP
  330. END SUB
  331.  
  332. '------------------------------------------------------------------------------
  333. SUB LOADDATAFIELDS
  334. SHARED Editfield$(),Custrec,Ir
  335.  Custrec.F1Name = Editfield$(1)
  336.  Custrec.Lname = Editfield$(2)
  337.  Custrec.Address = Editfield$(3)
  338.  Custrec.City = Editfield$(4)
  339.  Custrec.State = Editfield$(5)
  340.  Custrec.Zip = Editfield$(6)
  341.  Custrec.Date = Editfield$(7)
  342. END SUB
  343.  
  344. '------------------------------------------------------------------------------
  345. SUB LOADEDITFIELD
  346. SHARED Maxrows, Currec, Index(), Index$(), N1$
  347.  Currec = Index(Row + Extnd)
  348.  N1$=Index$(Row+Extnd)
  349.  GET #1, Currec, Custrec
  350.  Editfield$(1) = Custrec.F1Name
  351.  Editfield$(2) = Custrec.Lname
  352.  Editfield$(3) = Custrec.Address
  353.  Editfield$(4) = Custrec.City
  354.  Editfield$(5) = Custrec.State
  355.  Editfield$(6) = Custrec.Zip
  356.  Editfield$(7) = Custrec.Date
  357. END SUB
  358.  
  359. '------------------------------------------------------------------------------
  360. SUB OPENFILES
  361.  ON LOCAL ERROR GOTO FILENOTFOUND
  362. SHARED Maxrows, Currec, Index(), Index$(), Deleted(), Deleted,Ir, CustRec
  363. 'kill"Names.Db"  '*** used For Testing Only
  364. 'kill"Names.Ndx"  '*** used For Testing Only
  365.  OPEN "Names.db" FOR RANDOM AS 1 LEN = LEN(Custrec)
  366.  Lof1 = LOF(1) / LEN(Custrec)
  367.  OPEN "Names.ndx" FOR RANDOM AS 2 LEN = LEN(Ir)
  368.  Lof2 = LOF(2) / LEN(Ir)
  369.  MaxRows=LOF(2)/LEN(Ir)
  370.  OPEN "Deleted" FOR INPUT AS 3
  371.  WHILE NOT EOF(3)
  372.    Deleted = Deleted + 1
  373.    INPUT #3, Deleted(Deleted)
  374.  WEND
  375.  CLOSE #3
  376.  EXIT SUB
  377. FILENOTFOUND:
  378.  IF ERR = 53 THEN RESUME NEXT
  379.  PRINT "Error #"; ERR; "just occured": CLOSE : END
  380. END SUB
  381.  
  382. '------------------------------------------------------------------------------
  383. SUB PRINTRECORDS
  384. SHARED Maxrows, Currec, Index(), Index$()
  385.  COLOR 31, 1
  386.  LOCATE 12, 25: PRINT "Printing Records"
  387.  F$ = "\             \  \             \  \                            \  \                  \  \\ \   \"
  388.  LPRINT CHR$(15);
  389.  WIDTH "lpt1:", 132
  390.  FOR X = 1 TO LOF(1) / LEN(Custrec)
  391.    GET #1, X, Custrec
  392.    LPRINT USING F$; Custrec.F1Name; Custrec.Lname; Custrec.Address; Custrec.City; Custrec.State; Custrec.Zip
  393.  NEXT
  394.  COLOR 15, 1
  395. END SUB
  396.  
  397. '------------------------------------------------------------------------------
  398. SUB READFILE
  399. SHARED Currec,Add,Lof1,Index$(),Index(),Lof2,Maxrows
  400.  COLOR 15, 1: CLS
  401.  Add = 0: Set = 0: Lof1 = LOF(1) / LEN(Custrec)
  402.  Currec = LOF(1) / LEN(Custrec)
  403.  LOCATE 5, 5: INPUT "Enter name of file to read data from ", Rf$
  404.  CLS
  405.  IF Rf$ = "" THEN EXIT SUB
  406.  LOCATE 12, 20: PRINT "Processing INPUT record #"
  407.  LOCATE 14, 25: PRINT "Sorting set "
  408.  LOCATE 15, 23: PRINT "Records in Database"
  409.  Df = FREEFILE
  410.  OPEN Rf$ FOR INPUT AS Df
  411.  WHILE NOT EOF(Df)
  412.    INPUT #df, Editfield$(1), Editfield$(2), Editfield$(3), Editfield$(4), Editfield$(5), Editfield$(6)
  413.    Editfield$(7) = DATE$
  414.    Loaddatafields
  415.    Lof1 = Lof1 + 1
  416.    LOCATE 15, 43: PRINT Lof1
  417.    PUT #1, Lof1, Custrec
  418.    Add = Add + 1
  419.    Index$(Add) = Custrec.Lname + ", " + Custrec.F1Name
  420.    Index(Add) = Lof1
  421.    LOCATE 12, 46: PRINT Add
  422.    IF Add = 2000 OR EOF(Df) THEN
  423.      Set = Set + 1
  424.      LOCATE 14, 37: PRINT "Set "; Set
  425.      Sortindex
  426.      Lof2 = LOF(2) / LEN(Ir)
  427.      Updateindex
  428.      Add = 0
  429.    END IF
  430.  WEND
  431.  Lof2 = LOF(2) / LEN(Ir)
  432.  FOR X = 1 TO Lof2
  433.    GET #2, X, Ir
  434.    Index$(X) = Ir.Newrec
  435.    Index(X) = Ir.Recno
  436.    IF X = 2000 THEN EXIT FOR
  437.  NEXT
  438.  Maxrows = LOF(2) / LEN(Ir)
  439.  CLS
  440. END SUB
  441.  
  442. '------------------------------------------------------------------------------
  443. SUB SHOWCUSTOMERS
  444. SHARED Maxrows, Currec, Index(), Index$(), Loaded,C
  445.  COLOR 15, 1: CLS
  446.  IF LOF(2) / LEN(Ir) = 0 THEN EXIT SUB
  447.  COLOR 15, 2
  448.  LOCATE 4, 3: PRINT CHR$(201) + STRING$(72, CHR$(205)) + CHR$(187)
  449.  FOR X = 1 TO 8
  450.    LOCATE X + 4, 3: PRINT CHR$(186) + SPACE$(72) + CHR$(186)
  451.  NEXT
  452.  LOCATE 12, 3: PRINT CHR$(200) + STRING$(72, CHR$(205)) + CHR$(188)
  453.  LOCATE 6, 10: PRINT "The text in the box below will show the"
  454.  LOCATE 7, 10: PRINT "customers you have.  You can scroll through"
  455.  LOCATE 8, 10: PRINT "them by using the ARROW keys."
  456.  IF Mrow = 2 THEN
  457.    LOCATE 10, 10: PRINT "<RETURN> selects record for editing."
  458.  END IF
  459.  COLOR , 4
  460.  LOCATE 14, 3: PRINT CHR$(201) + STRING$(72, CHR$(205)) + CHR$(187)
  461.  FOR X = 1 TO 10
  462.    LOCATE X + 14, 3: PRINT CHR$(186) + SPACE$(72) + CHR$(186);
  463.  NEXT
  464.  LOCATE 24, 3: PRINT CHR$(200) + STRING$(72, CHR$(205)) + CHR$(188);
  465.  FOR X = 1 TO 9
  466.    COLOR 15, 4: LOCATE X + 14, 5: PRINT LEFT$(Index$(X) + SPACE$(70), 70);
  467.    IF X=C THEN EXIT FOR
  468.  NEXT
  469.  COLOR 14, 4
  470.  LOCATE 24, 22: PRINT "{ " + CHR$(24) + CHR$(25) + "  <RETURN> Choose   <ESC> menu" + "}";
  471.  COLOR 15, 1
  472.  Row = 1: Extnd = 0: Currtop = 1:Loaded=9
  473.  DO
  474.    COLOR 0, 7: LOCATE Row + 14, 5
  475.    PRINT LEFT$(Index$(Row + Extnd) + SPACE$(70), 70);
  476.    Y$ = "": WHILE Y$ = "": Y$ = Inkey$: Wend: Y$ = UCASE$(Y$)
  477.    COLOR 15, 4: LOCATE Row + 14, 5
  478.    PRINT LEFT$(Index$(Row + Extnd) + SPACE$(70), 70);
  479.    SELECT CASE Y$
  480.      CASE Esc$
  481.        COLOR 15, 1
  482.        CLS
  483.        EXIT SUB
  484.      CASE Enter$
  485.        COLOR 15, 1
  486.        IF Mrow = 2 THEN Loadeditfield
  487.        CLS : EXIT SUB
  488.      CASE Pgup$
  489.        FOR Y = 1 TO 8
  490.          IF Row - 1 >= 1 THEN
  491.            Row = Row - 1
  492.          ELSE
  493.            IF Row = 1 AND Extnd > 0 THEN
  494.              Currtop = Currtop - 1
  495.              Extnd = Extnd - 1
  496.              GOSUB SCROLLONELINEDOWN
  497.            END IF
  498.          END IF
  499.        NEXT
  500.      CASE Uparrow$
  501.        IF Row - 1 >= 1 THEN
  502.          Row = Row - 1
  503.        ELSE
  504.          IF Row = 1 AND Extnd > 0 THEN
  505.            Currtop = Currtop - 1
  506.            Extnd = Extnd - 1
  507.            GOSUB SCROLLONELINEDOWN
  508.          END IF
  509.        END IF
  510.      CASE Pgdn$
  511.        IF Row+Extnd+8<=C THEN
  512.          FOR Y = 1 TO 8
  513.            IF Row + 1 + Extnd <= C THEN
  514.              Row = Row + 1
  515.              IF Row > 9 THEN
  516.                Currtop = Currtop + 1
  517.                Row = 9: Extnd = Extnd + 1
  518.                GOSUB SCROLLONELINEUP
  519.              END IF
  520.            END IF
  521.          NEXT
  522.        END IF
  523.      CASE Dnarrow$
  524.        IF Row + 1 + Extnd <= C THEN
  525.          Row = Row + 1
  526.          IF Row > 9 THEN
  527.            Currtop = Currtop + 1
  528.            Row = 9: Extnd = Extnd + 1
  529.            GOSUB SCROLLONELINEUP
  530.          END IF
  531.        END IF
  532.    END SELECT
  533.  LOOP
  534.  EXIT SUB
  535. SCROLLONELINEUP:
  536.  Srow = 15
  537.  FOR X = Currtop TO Currtop + 7
  538.    LOCATE Srow, 5: PRINT LEFT$(Index$(X) + SPACE$(70), 70)
  539.    Srow = Srow + 1
  540.  NEXT
  541.  RETURN
  542. SCROLLONELINEDOWN:
  543.  Srow = 22
  544.  FOR X = Currtop + 7 TO Currtop STEP -1
  545.    LOCATE Srow, 5: PRINT LEFT$(Index$(X) + SPACE$(70), 70);
  546.    Srow = Srow - 1
  547.  NEXT
  548.  RETURN
  549. END SUB
  550.  
  551. '------------------------------------------------------------------------------
  552. SUB SHOWMENU
  553. '*** make Menu Box
  554. SHARED Menu$(),Mrow,Nf
  555. MAKEMENU:
  556.  DO
  557.    CLS
  558.    COLOR 15, 4
  559.    LOCATE 4, 15: PRINT CHR$(201) + STRING$(50, CHR$(205)) + CHR$(187)
  560.    LOCATE 4, 30: PRINT "[ Ziggy's Main Menu ]"
  561.    FOR X = 1 TO 8
  562.      LOCATE X + 4, 15: PRINT CHR$(186) + SPACE$(50) + CHR$(186)
  563.    NEXT
  564.  
  565. '*** print Menu Selections
  566.    LOCATE 12, 15: PRINT CHR$(200) + STRING$(50, CHR$(205)) + CHR$(188)
  567.    FOR X = 1 TO 6: LOCATE X + 5, 16: PRINT Menu$(X): NEXT
  568.  
  569.    Mrow = 1: Noofselections = 6
  570.    DO
  571.      COLOR 0, 7: LOCATE Mrow + 5, 16: PRINT Menu$(Mrow)
  572.      X$ = "": WHILE X$ = "": X$ = Inkey$: Wend: X$ = UCASE$(X$)
  573.      COLOR 15, 4: LOCATE Mrow + 5, 16: PRINT Menu$(Mrow)
  574.      SELECT CASE X$
  575.        CASE Esc$
  576.          COLOR 7, 0
  577.          CLS : END
  578.        CASE Enter$
  579.          SELECT CASE Mrow
  580.            CASE 1  'view All Customers
  581.              CLS
  582.              Getfirstletter
  583.              IF Nf=0 THEN
  584.                Showcustomers
  585.              END IF
  586.              Nf=0
  587.              EXIT DO
  588.            CASE 2  'edit A Customer Record
  589.              CLS
  590.              Getfirstletter
  591.              IF Nf=0 THEN
  592.                Showcustomers
  593.                IF Y$ <> Esc$ AND MaxRows <> 0 THEN
  594.                  Editcustomer
  595.                END IF
  596.              END IF
  597.              Nf=0
  598.              EXIT DO
  599.            CASE 3  'add A Customer Record
  600.              CLS
  601.              Editcustomer
  602.              EXIT DO
  603.            CASE 4  'print All Customer Records
  604.              CLS
  605.              Printrecords
  606.              EXIT DO
  607.            CASE 5   'read Records From A File
  608.              CLS
  609.              Readfile
  610.              EXIT DO
  611.            CASE 6  'quit
  612.              COLOR 7, 0
  613.              CLOSE : CLS : END
  614.          END SELECT
  615.        CASE Uparrow$
  616.          Mrow = Mrow - 1
  617.          IF Mrow < 1 THEN Mrow = Noofselections
  618.        CASE Dnarrow$
  619.          Mrow = Mrow + 1
  620.          IF Mrow > Noofselections THEN Mrow = 1
  621.      END SELECT
  622.    LOOP
  623.  LOOP
  624. END SUB
  625.  
  626. '------------------------------------------------------------------------------
  627. SUB SORTINDEX
  628. SHARED Index$(),Index()
  629.  IF Add = 0 THEN EXIT SUB
  630.  Maxstrarray% = Add
  631.  REDIM Stackl%(Maxstrarray%), Stackr%(Maxstrarray%)
  632.  Sx% = 1: Stackl%(1) = 1: Stackr%(1) = Maxstrarray%
  633.  WHILE Sx% <> 0
  634.    Lx% = Stackl%(Sx%): Rx% = Stackr%(Sx%): Sx% = Sx% - 1
  635.    WHILE Lx% < Rx%
  636.      Ix% = Lx%: Jx% = Rx%: X$ = Index$((Lx% + Rx%) \ 2)
  637.      WHILE Ix% <= Jx%
  638.        WHILE Index$(Ix%) < X$: Ix% = Ix% + 1: WEND
  639.        WHILE Index$(Jx%) > X$: Jx% = Jx% - 1: WEND
  640.        X0% = 0
  641.        WHILE (Ix% <= Jx% AND X0% = 0)
  642.          X0% = 1: SWAP Index$(Ix%), Index$(Jx%)
  643.          SWAP Index(Ix%), Index(Jx%)
  644.          Ix% = Ix% + 1: Jx% = Jx% - 1
  645.        WEND
  646.      WEND
  647.      X0% = 0
  648.      WHILE (Ix% <= Rx% AND X0% = 0)
  649.        X0% = 1: Sx% = Sx% + 1
  650.        Stackl%(Sx%) = Ix%: Stackr%(Sx%) = Rx%
  651.      WEND
  652.      Rx% = Jx%
  653.    WEND
  654.  WEND
  655.  ERASE Stackl%, Stackr%
  656. END SUB
  657.  
  658. '------------------------------------------------------------------------------
  659. SUB UPDATEINDEX
  660. SHARED Lof2,Mid,Add,Index$(),Index()
  661.  Low = 1: High = Lof2
  662.  DO
  663.    Mid = INT((Low + High) / 2)
  664.    IF Low > High THEN
  665.      IF Lof2 > 0 THEN
  666.        FOR X = Lof2 TO Mid + 1 STEP -1
  667.          GET #2, X, Ir
  668.          PUT #2, X + Add, Ir
  669.        NEXT
  670.      END IF
  671.      Ir.Newrec = Index$(Add)
  672.      Ir.Recno = Index(Add)
  673.      PUT #2, X + Add, Ir
  674.      Add = Add - 1
  675.      IF Add < 1 THEN EXIT SUB
  676.      IF X = 0 THEN
  677.        FOR X = 1 TO Add
  678.          Ir.Newrec = Index$(X)
  679.          Ir.Recno = Index(X)
  680.          PUT #2, X, Ir
  681.        NEXT
  682.        EXIT SUB
  683.      END IF
  684.      DO
  685.        GET #2, X, Ir
  686.        IF LEFT$(Ir.Newrec, LEN(Index$(Add))) > Index$(Add) THEN
  687.          PUT #2, X + Add, Ir
  688.          X = X - 1
  689.        ELSE
  690.          Ir.Newrec = Index$(Add)
  691.          Ir.Recno = Index(Add)
  692.          PUT #2, X + Add, Ir
  693.          Add = Add - 1
  694.        END IF
  695.      LOOP WHILE Add > 0 AND X > 0
  696.      EXIT SUB
  697.    END IF
  698.    GET #2, Mid, Ir
  699.    IF LEFT$(Ir.Newrec, LEN(Index$(Add))) < Index$(Add) THEN Low = Mid + 1 ELSE High = Mid - 1
  700.  LOOP
  701. END SUB
  702.  
  703. '------------------------------------------------------------------------------
  704. SUB UPDATEREC
  705. SHARED Maxrows, Currec, Index(), Index$()
  706.  PUT #1, Currec, Custrec
  707. END SUB
  708.