Qbasicnews.com

Qbasicnews.com > QBasic > QB Discussion & Programming Help > Randome Access Trouble
Full Version: Randome Access Trouble
You're currently viewing a stripped down version of our content. View the full version with proper formatting.
Pages: 1 2 3

Kofman

03-28-2003, 05:22 AM
I'm having problems running an Open "R" command. Here is my extensive program. Try running it and you'll see where I get an error. the program works so debugging should only be concetrated on in the AddContact sub. Please let me know what I'm doing wrong.

Code:
DECLARE SUB GUI ()
DECLARE SUB Calandar ()
DECLARE SUB Contacts ()
DECLARE SUB AddContact ()
DECLARE SUB ViewContact ()
DECLARE SUB DelContact ()
DECLARE SUB LoadContact ()
DECLARE FUNCTION dayofweek! (day!, month!, year!)
DECLARE FUNCTION gregday! (jd!, choice!)
DECLARE FUNCTION julianday! (d!, m!, y!)
DECLARE SUB lText (text$, x%, y%, col%, scale%)
      
CLS
          
GUI             ' Calls up the User Interface
DO
press$ = LCASE$(INKEY$)
SELECT CASE press$
CASE CHR$(99)
    Calandar
CASE CHR$(111)
    Contacts
END SELECT
LOOP UNTIL press$ = CHR$(27)

END

' ################ END MAIN ##################

SUB AddContact

GUI
CALL lText("Adding Contact", 30, 50, 0, 1)

' Open Up File

TYPE ContactDescription
    ctcName AS STRING * 30
    phonenum AS INTEGER
    email AS STRING * 30
    address AS STRING * 20
    city AS STRING * 15
    state AS STRING * 2
    zip AS INTEGER
    about AS STRING * 60
END TYPE

DIM ContactRecord AS ContactDescription

Lengh = LEN(ContactRecord)

OPEN "R", #1, "Contacts.txt", Lengh

INPUT "", ctcName$
DO

    INPUT "", phonenum%
    INPUT "", email$
    INPUT "", address$
    INPUT "", city$
    INPUT "", state$
    INPUT "", zip%
    INPUT "", about$
          
    GET #1, 1, name$
    GET #1, 2, phonenum%
    GET #1, 3, email$
    GET #1, 4, address$
    GET #1, 5, city$
    GET #1, 6, state$
    GET #1, 7, zip%
    GET #1, 8, about$
      
    INPUT "", ctcName$
LOOP UNTIL LCASE$(name$) = "exit"
CLOSE #1
END SUB

SUB Calandar
    CDay = VAL(MID$(DATE$, 4, 2))   'Current Day
    CMonth = VAL(LEFT$(DATE$, 2))   'Current Month
    CYear = VAL(RIGHT$(DATE$, 4))   'Current Year

    CHr = VAL(LEFT$(TIME$, 2))      'Current Hour
    CMin = VAL(MID$(TIME$, 4, 2))   'Current Minute
    CSec = VAL(RIGHT$(TIME$, 2))    'Current Second

    LINE (20 + 2, 33 + 2)-(380 + 2, 163 + 2), 8, BF
    LINE (20, 33)-(381, 163), 1, BF
      
    LINE (30, 53)-(360, 65), 9, BF

    FOR y = 1 TO 5
        FOR x = 1 TO 7
            LINE (30 + xa, 68 + ya)-(60 + xa, 78 + ya), 9, BF
            xa = xa + 50
        NEXT x
        xa = 0
        ya = ya + 15
    NEXT y
    xa = 0
    ya = 0

    SELECT CASE CMonth
    CASE 1:
        CALL lText("January", 30, 50, 7, 1)
    CASE 2:
        CALL lText("February", 30, 50, 7, 1)
    CASE 3:
        CALL lText("March", 30, 50, 7, 1)
    CASE 4:
        CALL lText("April", 30, 50, 7, 1)
    CASE 5:
        CALL lText("May", 30, 50, 7, 1)
    CASE 6:
        CALL lText("June", 30, 50, 7, 1)
    CASE 7:
        CALL lText("July", 30, 50, 7, 1)
    CASE 8:
        CALL lText("August", 30, 50, 7, 1)
    CASE 9:
        CALL lText("September", 30, 50, 7, 1)
    CASE 10:
        CALL lText("October", 30, 50, 7, 1)
    CASE 11:
        CALL lText("November", 30, 50, 7, 1)
    CASE 12:
        CALL lText("December", 30, 50, 7, 1)
    END SELECT
      
    CALL lText("SUN     MON    TUE    WED    THU     FRI   SAT", 30, 62, 7, 1)
      
    DIM chart(1 TO 7, 1 TO 5)
      
    jd = julianday(1, CMonth, CYear)

    jd = jd - dayofweek(1, CMonth, CYear)

    FOR y = 1 TO 5
        FOR x = 1 TO 7
            chart(x, y) = INT(gregday(jd, 0))
            jd = jd + 1
        NEXT x
    NEXT y
      
    FOR y = 1 TO 5
        FOR x = 1 TO 7
            number$ = STR$(chart(x, y))
            IF chart(x, y) = CDay THEN
            CALL lText(number$, 30 + xa, 75 + ya, 4, 1)
            ELSE
            CALL lText(number$, 30 + xa, 75 + ya, 0, 1)
            END IF
            xa = xa + 50
        NEXT x
        xa = 0
        ya = ya + 15
    NEXT y

END SUB

SUB Contacts

GUI
CALL lText("CONTACTS", 10, 45, 1, 2)
CALL lText("Pick one of the following options:", 10, 63, 0, 1)
LINE (95, 90)-(310, 130), 1, BF
CALL lText("1     View   Contacts", 100, 103, 0, 1)
CALL lText("2     Add    Contacts", 100, 113, 0, 1)
CALL lText("3     Delete Contacts", 100, 123, 0, 1)
DO
press$ = LCASE$(INKEY$)
SELECT CASE press$
CASE CHR$(49)
    ViewContact
CASE CHR$(50)
    AddContact
CASE CHR$(51)
    DelContact
END SELECT
LOOP UNTIL press$ = CHR$(27)

END SUB

FUNCTION dayofweek (day, month, year)
jd = julianday(day, month, year)
dayofweek = (jd + 1) MOD 7
END FUNCTION

SUB DelContact

GUI
CALL lText("Deleting Contacts", 30, 50, 0, 1)
END SUB

FUNCTION gregday (jd, choice)
L = jd + 68569
n = (4 * L) \ 146097
L = L - (146097 * n + 3) \ 4
i = (4000 * (L + 1)) \ 1461001
L = L - (1461 * i) \ 4 + 31
j = (80 * L) \ 2447
d = L - (2447 * j) \ 80
L = j \ 11
m = j + 2 - (12 * L)
y = 100 * (n - 49) + i + L

SELECT CASE choice
CASE 0
gregday = d
CASE 1
gregday = m
CASE 2
gregday = y
END SELECT
END FUNCTION

SUB GUI

SCREEN 12
PAINT (0, 0), 15

LINE (1, 0)-(640, 21), 0, BF 'Background
LINE (0, 0)-(640, 20), 9, BF 'Foreground

LINE (540, 3)-(638, 19), 0, BF
LINE (539, 2)-(637, 18), 1, BF

LINE (438, 3)-(536, 19), 0, BF
LINE (437, 2)-(535, 18), 1, BF

LINE (336, 3)-(434, 19), 0, BF
LINE (335, 2)-(433, 18), 1, BF

LINE (234, 3)-(332, 19), 0, BF
LINE (233, 2)-(331, 18), 1, BF

LINE (7, 27)-(637, 462), 8, BF
LINE (4, 24)-(634, 459), 7, BF

CALL lText("Linear Planner", 6, 18, 15, 2)
CALL lText("Calendar", 240, 13, 15, 1)
CALL lText("Contacts", 350, 13, 15, 1)
CALL lText("Journal", 452, 13, 15, 1)
CALL lText("Help", 554, 13, 15, 1)
END SUB

FUNCTION julianday (d, m, y)
julianday = (1461 * (y + 4800 + (m - 14) \ 12)) \ 4 + (367 * (m - 2 - 12 * ((m - 14) \ 12))) \ 12 - (3 * ((y + 4900 + (m - 14) \ 12) \ 100)) \ 4 + d - 32075
END FUNCTION

SUB lText (text$, x%, y%, col%, scale%)

'Porportion
w% = 5 * .75 * scale%
h% = 8 * .75 * scale%

'Porportion Formula
'Coloring the Shadow
shadow% = 8

'Generating the Font
FOR i% = 1 TO LEN(text$)
    L$ = MID$(UCASE$(text$), i%, 1)
    x1% = x%
    x2% = x1% + (1 / 4) * w%
    x3% = x1% + (1 / 2) * w%
    x4% = x1% + (3 / 4) * w%
    x5% = x1% + w%

    y1% = y%
    y2% = y1% - (1 / 2) * h%
    y3% = y1% - h%
      
    SELECT CASE L$
    CASE " ":
        x% = x% + w
    CASE "A":
        LINE (x1% + 1, y1%)-(x3% + 1, y3%), shadow%
        LINE (x3% + 1, y3%)-(x5% + 1, y1%), shadow%
        LINE (x2%, y2% + 1)-(x4%, y2% + 1), shadow%
        LINE (x1%, y1%)-(x3%, y3%), col%
        LINE (x3%, y3%)-(x5%, y1%), col%
        LINE (x2%, y2%)-(x4%, y2%), col%
    CASE "B":
        mid1% = (y3% + y2%) / 2  'y-cord for the first circle
        mid2% = (y2% + y1%) / 2  'y-cord for the second circle
          
        rad1% = y2% - mid1%      'radius
        rad2% = y1% - mid2%
          
        LINE (x1%, y3% + 1)-(x3%, y3% + 1), shadow%
        LINE (x1%, y2% + 1)-(x3%, y2% + 1), shadow%
        LINE (x1%, y1% + 1)-(x3%, y1% + 1), shadow%
        LINE (x1% + 1, y3%)-(x1% + 1, y1%), shadow%
          
        CIRCLE (x3% + 1, mid1% + 1), rad1%, shadow%, 4.71, 1.57
        CIRCLE (x3% + 1, mid2% + 1), rad1%, shadow%, 4.71, 1.57
          
        LINE (x1%, y3%)-(x3%, y3%), col%
        LINE (x1%, y2%)-(x3%, y2%), col%
        LINE (x1%, y1%)-(x3%, y1%), col%
        LINE (x1%, y3%)-(x1%, y1%), col%
        
        CIRCLE (x3%, mid1%), rad1%, col%, 4.71, 1.57
        CIRCLE (x3%, mid2%), rad1%, col%, 4.71, 1.57
    CASE "C":
        mid1% = (x1% + x5%) / 2  'x-cord for the first circle
        mid2% = (y3% + y1%) / 2  'y-cord for the second circle
        
        rad1% = y2% - y3%    'radius
          
        LINE (x3%, y3% + 1)-(x5%, y3% + 1), shadow%
        LINE (x3%, y1% + 1)-(x5%, y1% + 1), shadow%
        CIRCLE (mid1% + 1, mid2% + 1), rad1%, shadow%, 1.57, 4.71, 1.5
          
        LINE (x3%, y3%)-(x5%, y3%), col%
        LINE (x3%, y1%)-(x5%, y1%), col%
        CIRCLE (mid1%, mid2%), rad1%, col%, 1.57, 4.71, 1.5
    CASE "D":
        mid1% = (x1% + x5%) / 2  'x-cord for the first circle
        mid2% = (y3% + y1%) / 2  'y-cord for the second circle
        
        rad1% = y2% - y3%    'radius
          
        LINE (x1% + 1, y3%)-(x1% + 1, y1%), shadow%
        LINE (x1%, y3% + 1)-(x3%, y3% + 1), shadow%
        LINE (x1%, y1% + 1)-(x3%, y1% + 1), shadow%
        CIRCLE (mid1% + 1, mid2% + 1), rad1%, shadow%, 4.71, 1.57, 1.5
          
        LINE (x1%, y3%)-(x1%, y1%), col%
        LINE (x1%, y3%)-(x3%, y3%), col%
        LINE (x1%, y1%)-(x3%, y1%), col%
        CIRCLE (mid1%, mid2%), rad1%, col%, 4.71, 1.57, 1.5
    CASE "E":
        LINE (x1%, y3% + 1)-(x5%, y3% + 1), shadow%
        LINE (x1%, y2% + 1)-(x3%, y2% + 1), shadow%
        LINE (x1%, y1% + 1)-(x5%, y1% + 1), shadow%
        LINE (x1% + 1, y3%)-(x1% + 1, y1%), shadow%
                
        LINE (x1%, y3%)-(x5%, y3%), col%
        LINE (x1%, y2%)-(x3%, y2%), col%
        LINE (x1%, y1%)-(x5%, y1%), col%
        LINE (x1%, y3%)-(x1%, y1%), col%
    CASE "F":
        LINE (x1%, y3% + 1)-(x5%, y3% + 1), shadow%
        LINE (x1%, y2% + 1)-(x3%, y2% + 1), shadow%
        LINE (x1% + 1, y3%)-(x1% + 1, y1%), shadow%
              
        LINE (x1%, y3%)-(x5%, y3%), col%
        LINE (x1%, y2%)-(x3%, y2%), col%
        LINE (x1%, y3%)-(x1%, y1%), col%
    CASE "G":
        mid1% = (x1% + x5%) / 2
        mid2% = (y3% + y1%) / 2
      
        rad1% = y2% - y3%    'radius
          
        LINE (x3%, y2% + 1)-(x5%, y2% + 1), shadow%
        CIRCLE (mid1% + 1, mid2% + 1), rad1%, shadow%, 1.1, 0, 1.4
        
        LINE (x3%, y2%)-(x5%, y2%), col%
        CIRCLE (mid1%, mid2%), rad1%, col%, 1.1, 0, 1.4
    CASE "H":
        LINE (x1% + 1, y3%)-(x1% + 1, y1%), shadow%
        LINE (x5% + 1, y3%)-(x5% + 1, y1%), shadow%
        LINE (x1%, y2% + 1)-(x5%, y2% + 1), shadow%
          
        LINE (x1%, y3%)-(x1%, y1%), col%
        LINE (x5%, y3%)-(x5%, y1%), col%
        LINE (x1%, y2%)-(x5%, y2%), col%
    CASE "I":
        LINE (x1%, y3% + 1)-(x5%, y3% + 1), shadow%
        LINE (x1%, y1% + 1)-(x5%, y1% + 1), shadow%
        LINE (x3% + 1, y3%)-(x3% + 1, y1%), shadow%
          
        LINE (x1%, y3%)-(x5%, y3%), col%
        LINE (x1%, y1%)-(x5%, y1%), col%
        LINE (x3%, y3%)-(x3%, y1%), col%
    CASE "J":
        mid1% = (x1% + x5%) / 2
        mid2% = (y3% + y1%) / 2
    
        rad1% = y2% - y3%    'radius
        
        LINE (x4%, y3% + 1)-(x5%, y3% + 1), shadow%
        LINE (x5% + 1, y3%)-(x5% + 1, y2%), shadow%
        LINE (x1%, y1% + 1)-(x3%, y1% + 1), shadow%
        CIRCLE (mid1% + 1, mid2% + 1), rad1%, shadow%, 4.71, 0, 1.4
      
        LINE (x4%, y3%)-(x5%, y3%), col%
        LINE (x5%, y3%)-(x5%, y2%), col%
        LINE (x1%, y1%)-(x3%, y1%), col%
        CIRCLE (mid1%, mid2%), rad1%, col%, 4.71, 0, 1.4
    CASE "K":
        LINE (x1% + 1, y3%)-(x1% + 1, y1%), shadow%
        LINE (x1%, y2% + 1)-(x3%, y2% + 1), shadow%
        LINE (x3% + 1, y2% + 1)-(x5% + 1, y3% + 1), shadow%
        LINE (x3% + 1, y2% + 1)-(x5% + 1, y1% + 1), shadow%
        
        LINE (x1%, y3%)-(x1%, y1%), col%
        LINE (x1%, y2%)-(x3%, y2%), col%
        LINE (x3%, y2%)-(x5%, y3%), col%
        LINE (x3%, y2%)-(x5%, y1%), col%
    CASE "L":
        LINE (x1% + 1, y3%)-(x1% + 1, y1%), shadow%
        LINE (x1%, y1% + 1)-(x5%, y1% + 1), shadow%

        LINE (x1%, y3%)-(x1%, y1%), col%
        LINE (x1%, y1%)-(x5%, y1%), col%
    CASE "M":
        LINE (x1% + 1, y3%)-(x1% + 1, y1%), shadow%
        LINE (x5% + 1, y3%)-(x5% + 1, y1%), shadow%
        LINE (x1% + 1, y3% + 1)-(x3% + 1, y2% + 1), shadow%
        LINE (x3% + 1, y2% + 1)-(x5% + 1, y3% + 1), shadow%
          
        LINE (x1%, y3%)-(x1%, y1%), col%
        LINE (x5%, y3%)-(x5%, y1%), col%
        LINE (x1%, y3%)-(x3%, y2%), col%
        LINE (x3%, y2%)-(x5%, y3%), col%
    CASE "N":
        LINE (x1% + 1, y3%)-(x1% + 1, y1%), shadow%
        LINE (x5% + 1, y3%)-(x5% + 1, y1%), shadow%
        LINE (x1% + 1, y3% + 1)-(x5% + 1, y1% + 1), shadow%
          
        LINE (x1%, y3%)-(x1%, y1%), col%
        LINE (x5%, y3%)-(x5%, y1%), col%
        LINE (x1%, y3%)-(x5%, y1%), col%
    CASE "O":
        mid1% = (x1% + x5%) / 2
        mid2% = (y3% + y1%) / 2
      
        rad1% = y2% - y3%    'radius
          
        CIRCLE (mid1% + 1, mid2% + 1), rad1%, shadow%, , , 1.4
        
        CIRCLE (mid1%, mid2%), rad1%, col%, , , 1.4
    CASE "P":
        mid1% = (y3% + y2%) / 2  'y-cord for the first circle
          
        rad1% = y2% - mid1%      'radius
          
        LINE (x1%, y3% + 1)-(x3%, y3% + 1), shadow%
        LINE (x1%, y2% + 1)-(x3%, y2% + 1), shadow%
        LINE (x1% + 1, y3%)-(x1% + 1, y1%), shadow%
        CIRCLE (x3% + 1, mid1% + 1), rad1%, shadow%, 4.71, 1.57
          
        LINE (x1%, y3%)-(x3%, y3%), col%
        LINE (x1%, y2%)-(x3%, y2%), col%
        LINE (x1%, y3%)-(x1%, y1%), col%
        CIRCLE (x3%, mid1%), rad1%, col%, 4.71, 1.57
    CASE "Q":
        mid1% = (x1% + x5%) / 2
        mid2% = (y3% + y1%) / 2
    
        rad1% = y2% - y3%    'radius
        
        LINE (x3% + 1, y2% + 1)-(x5% + 1, y1% + 1), shadow%
        CIRCLE (mid1% + 1, mid2% + 1), rad1%, shadow%, , , 1.4
      
        LINE (x3%, y2%)-(x5%, y1%), col%
        CIRCLE (mid1%, mid2%), rad1%, col%, , , 1.4
    CASE "R":
        mid1% = (y3% + y2%) / 2  'y-cord for the first circle
          
        rad1% = y2% - mid1%      'radius
          
        LINE (x1%, y3% + 1)-(x3%, y3% + 1), shadow%
        LINE (x1%, y2% + 1)-(x3%, y2% + 1), shadow%
        LINE (x1% + 1, y3%)-(x1% + 1, y1%), shadow%
        LINE (x3% + 1, y2% + 1)-(x5% + 1, y1% + 1), shadow%
        CIRCLE (x3% + 1, mid1% + 1), rad1%, shadow%, 4.71, 1.57
          
        LINE (x1%, y3%)-(x3%, y3%), col%
        LINE (x1%, y2%)-(x3%, y2%), col%
        LINE (x1%, y3%)-(x1%, y1%), col%
        LINE (x3%, y2%)-(x5%, y1%), col%
        CIRCLE (x3%, mid1%), rad1%, col%, 4.71, 1.57
    CASE "S":
        mid1% = (y3% + y2%) / 2
        mid2% = (y2% + y1%) / 2
        
        rad1% = y2% - mid1%
        rad2% = y1% - mid2%
          
        CIRCLE (x3% + 1, mid1% + 1), rad1%, shadow%, .4, 4.71
        CIRCLE (x3% + 1, mid2% + 1), rad1%, shadow%, 2.8, 1.57
          
        CIRCLE (x3%, mid1%), rad1%, col%, .4, 4.71
        CIRCLE (x3%, mid2%), rad1%, col%, 2.8, 1.57
    CASE "T":
        LINE (x1%, y3% + 1)-(x5%, y3% + 1), shadow%
        LINE (x3% + 1, y3%)-(x3% + 1, y1%), shadow%

        LINE (x1%, y3%)-(x5%, y3%), col%
        LINE (x3%, y3%)-(x3%, y1%), col%
    CASE "U":
        mid1% = (x1% + x5%) / 2
        mid2% = (y3% + y1%) / 2
    
        rad1% = y2% - y3%    'radius
          
        LINE (x1% + 1, y3%)-(x1% + 1, y2%), shadow%
        LINE (x5% + 1, y3%)-(x5% + 1, y2%), shadow%
        CIRCLE (mid1% + 1, mid2% + 1), rad1%, shadow%, 3.14, 0, 1.4
          
        LINE (x1%, y3%)-(x1%, y2%), col%
        LINE (x5%, y3%)-(x5%, y2%), col%
        CIRCLE (mid1%, mid2%), rad1%, col%, 3.14, 0, 1.4
    CASE "V":
        LINE (x1% + 1, y3%)-(x1% + 1, y2%), shadow%
        LINE (x5% + 1, y3%)-(x5% + 1, y2%), shadow%
        LINE (x1% + 1, y2% + 1)-(x3% + 1, y1% + 1), shadow%
        LINE (x3% + 1, y1% + 1)-(x5% + 1, y2% + 1), shadow%
          
        LINE (x1%, y3%)-(x1%, y2%), col%
        LINE (x5%, y3%)-(x5%, y2%), col%
        LINE (x1%, y2%)-(x3%, y1%), col%
        LINE (x3%, y1%)-(x5%, y2%), col%
    CASE "W":
        LINE (x1% + 1, y3%)-(x1% + 1, y1%), shadow%
        LINE (x5% + 1, y3%)-(x5% + 1, y1%), shadow%
        LINE (x1% + 1, y1% + 1)-(x3% + 1, y2% + 1), shadow%
        LINE (x3% + 1, y2% + 1)-(x5% + 1, y1% + 1), shadow%
        
        LINE (x1%, y3%)-(x1%, y1%), col%
        LINE (x5%, y3%)-(x5%, y1%), col%
        LINE (x1%, y1%)-(x3%, y2%), col%
        LINE (x3%, y2%)-(x5%, y1%), col%

    CASE "X":
        LINE (x1% + 1, y3% + 1)-(x5% + 1, y1% + 1), shadow%
        LINE (x5% + 1, y3% + 1)-(x1% + 1, y1% + 1), shadow%
          
        LINE (x1%, y3%)-(x5%, y1%), col%
        LINE (x5%, y3%)-(x1%, y1%), col%
    CASE "Y":
        LINE (x1% + 1, y3% + 1)-(x3% + 1, y2% + 1), shadow%
        LINE (x5% + 1, y3% + 1)-(x3% + 1, y2% + 1), shadow%
        LINE (x3% + 1, y2%)-(x3% + 1, y1%), shadow%
          
        LINE (x1%, y3%)-(x3%, y2%), col%
        LINE (x5%, y3%)-(x3%, y2%), col%
        LINE (x3%, y2%)-(x3%, y1%), col%
    CASE "Z":
        LINE (x1%, y3% + 1)-(x5%, y3% + 1), shadow%
        LINE (x1%, y1% + 1)-(x5%, y1% + 1), shadow%
        LINE (x5% + 1, y3% + 1)-(x1% + 1, y1% + 1), shadow%

        LINE (x1%, y3%)-(x5%, y3%), col%
        LINE (x1%, y1%)-(x5%, y1%), col%
        LINE (x5%, y3%)-(x1%, y1%), col%
    CASE "1":
        LINE (x3% + 1, y3%)-(x3% + 1, y1%), shadow%
        LINE (x2%, y1% + 1)-(x4%, y1% + 1), shadow%
                
        LINE (x3%, y3%)-(x3%, y1%), col%
        LINE (x2%, y1%)-(x4%, y1%), col%
    CASE "2":
        LINE (x1%, y3% + 1)-(x5%, y3% + 1), shadow%
        LINE (x5%, y3%)-(x5%, y2%), shadow%
        LINE (x3%, y2%)-(x5%, y2%), shadow%
        LINE (x5% + 1, y3% + 1)-(x1% + 1, y1% + 1), shadow%
        LINE (x1%, y1% + 1)-(x5%, y1% + 1), shadow%

        LINE (x1%, y3%)-(x5%, y3%), col%
        LINE (x5%, y3%)-(x5%, y2%), col%
        LINE (x3%, y2%)-(x5%, y2%), col%
        LINE (x5%, y3%)-(x1%, y1%), col%
        LINE (x1%, y1%)-(x5%, y1%), col%
    CASE "3":
        LINE (x1%, y3% + 1)-(x5%, y3% + 1), shadow%
        LINE (x1%, y2% + 1)-(x5%, y2% + 1), shadow%
        LINE (x1%, y1% + 1)-(x5%, y1% + 1), shadow%
        LINE (x5% + 1, y3%)-(x5% + 1, y1%), shadow%

        LINE (x1%, y3%)-(x5%, y3%), col%
        LINE (x1%, y2%)-(x5%, y2%), col%
        LINE (x1%, y1%)-(x5%, y1%), col%
        LINE (x5%, y3%)-(x5%, y1%), col%
    CASE "4":
        LINE (x5% + 1, y3%)-(x5% + 1, y1%), shadow%
        LINE (x5% + 1, y3% + 1)-(x1% + 1, y2% + 1), shadow%
        LINE (x1%, y2% + 1)-(x5%, y2% + 1), shadow%

        LINE (x5%, y3%)-(x5%, y1%), col%
        LINE (x5%, y3%)-(x1%, y2%), col%
        LINE (x1%, y2%)-(x5%, y2%), col%
    CASE "5":
        LINE (x1%, y3% + 1)-(x5%, y3% + 1), shadow%
        LINE (x1% + 1, y3%)-(x1% + 1, y2%), shadow%
        LINE (x1%, y2% + 1)-(x5%, y2% + 1), shadow%
        LINE (x5% + 1, y2%)-(x5% + 1, y1%), shadow%
        LINE (x1%, y1% + 1)-(x5%, y1% + 1), shadow%

        LINE (x1%, y3%)-(x5%, y3%), col%
        LINE (x1%, y3%)-(x1%, y2%), col%
        LINE (x1%, y2%)-(x5%, y2%), col%
        LINE (x5%, y2%)-(x5%, y1%), col%
        LINE (x1%, y1%)-(x5%, y1%), col%
    CASE "6":
        LINE (x1%, y3% + 1)-(x5%, y3% + 1), shadow%
        LINE (x1% + 1, y3%)-(x1% + 1, y2%), shadow%
        LINE (x1%, y2% + 1)-(x5%, y2% + 1), shadow%
        LINE (x5% + 1, y2%)-(x5% + 1, y1%), shadow%
        LINE (x1% + 1, y2%)-(x1% + 1, y1%), shadow%
        LINE (x1%, y1% + 1)-(x5%, y1% + 1), shadow%

        LINE (x1%, y3%)-(x5%, y3%), col%
        LINE (x1%, y3%)-(x1%, y2%), col%
        LINE (x1%, y2%)-(x5%, y2%), col%
        LINE (x5%, y2%)-(x5%, y1%), col%
        LINE (x1%, y2%)-(x1%, y1%), col%
        LINE (x1%, y1%)-(x5%, y1%), col%
    CASE "7":
        LINE (x1%, y3% + 1)-(x5%, y3% + 1), shadow%
        LINE (x5% + 1, y3% + 1)-(x3% + 1, y2% + 1), shadow%
        LINE (x3% + 1, y2%)-(x3% + 1, y1%), shadow%
          
        LINE (x1%, y3%)-(x5%, y3%), col%
        LINE (x5%, y3%)-(x3%, y2%), col%
        LINE (x3%, y2%)-(x3%, y1%), col%
    CASE "8":
        LINE (x1%, y3% + 1)-(x5%, y3% + 1), shadow%
        LINE (x1%, y2% + 1)-(x5%, y2% + 1), shadow%
        LINE (x1%, y1% + 1)-(x5%, y1% + 1), shadow%
        LINE (x1% + 1, y3%)-(x1% + 1, y1%), shadow%
        LINE (x5% + 1, y3%)-(x5% + 1, y1%), shadow%

        LINE (x1%, y3%)-(x5%, y3%), col%
        LINE (x1%, y2%)-(x5%, y2%), col%
        LINE (x1%, y1%)-(x5%, y1%), col%
        LINE (x1%, y3%)-(x1%, y1%), col%
        LINE (x5%, y3%)-(x5%, y1%), col%
    CASE "9":
        LINE (x1%, y3% + 1)-(x5%, y3% + 1), shadow%
        LINE (x1%, y2% + 1)-(x5%, y2% + 1), shadow%
        LINE (x1%, y1% + 1)-(x5%, y1% + 1), shadow%
        LINE (x1% + 1, y3%)-(x1% + 1, y2%), shadow%
        LINE (x5% + 1, y3%)-(x5% + 1, y1%), shadow%
          
        LINE (x1%, y3%)-(x5%, y3%), col%
        LINE (x1%, y2%)-(x5%, y2%), col%
        LINE (x1%, y1%)-(x5%, y1%), col%
        LINE (x1%, y3%)-(x1%, y2%), col%
        LINE (x5%, y3%)-(x5%, y1%), col%
    CASE "0":
        LINE (x1% + 1, y3% + 1)-(x5% + 1, y1% + 1), shadow%, B
        LINE (x5% + 1, y3% + 1)-(x1% + 1, y1% + 1), shadow%

        LINE (x1%, y3%)-(x5%, y1%), col%, B
        LINE (x5%, y3%)-(x1%, y1%), col%
    END SELECT
    x% = x% + w% + 3
NEXT i%
END SUB

SUB ViewContact

GUI
CALL lText("View Contact", 30, 50, 0, 1)
END SUB

PS: If you guys recall theirs the calendar script you helped me with.

someone42

03-29-2003, 10:54 AM
First, you have to move the ContactDescription structure into the main module.

Here is what AddContact should look like:
Code:
SUB AddContact

GUI
CALL lText("Adding Contact", 30, 50, 0, 1)

' Open Up File

DIM ContactRecord AS ContactDescription

Lengh = LEN(ContactRecord)

OPEN "Contacts.txt" FOR RANDOM AS #1 LEN = Lengh

INPUT "", InName$
DO
   position% = 1
   ContactRecord.ctcName = InName$
   INPUT "", ContactRecord.phonenum
   INPUT "", ContactRecord.email
   INPUT "", ContactRecord.address
   INPUT "", ContactRecord.city
   INPUT "", ContactRecord.state
   INPUT "", ContactRecord.zip
   INPUT "", ContactRecord.about

   PUT #1, position%, ContactRecord
        
   INPUT "", InName$
LOOP UNTIL LCASE$(InName$) = "exit"
CLOSE #1
END SUB

position% is the record number to place the contact into. You will have to determine where that is. For now I just used position%=1. I assume you want to add the record to the file (or if the contact exists, update it), so you could use instead of position%=1:
Code:
position% = 1
DO
   GET #1, position%, ContactRecord
   IF ContactRecord.ctcName = InName$ THEN EXIT DO
   position% = position% + 1
LOOP UNTIL EOF(1)

but I'm not sure if that's what you want.

Meg

03-29-2003, 11:54 PM
1. You shouldn't use DIM like that in the subroutine. Every time you call the subroutine, your program is going to set aside that much MORE memory for that variable. Try using REDIM, instead.

2. When you GET and PUT information to a file opened as random, you need to put in and get out segments that are the same size as the record length you specified in the OPEN command.

For example, if you make a TYPE called 'RecordType' then you could do this:

Quote:TYPE RecordType
RName as STRING * 20
Age as INTEGER
SSN as STRING * 9
END TYPE

SUB AddContact()

REDIM PersonalInfo as RecordType

OPEN "contacts.dat" for RANDOM AS #1 LEN = LEN(PersonalInfo)
RecordNum = 0
DO
RecordNum = RecordNum + 1
GET #1, RecordNum, PersonalInfo
LOOP UNTIL EOF(1)
Input "Enter Name: ", PersonalInfo.RName
Input "Enter Age: ", PersonalInfo.Age
Input "Enter SS#: ", PersonalInfo.SSN
Put #1, RecordNum, PersonalInfo
CLOSE #1

END SUB

*peace*

Meg.

Meg

03-29-2003, 11:57 PM
subject reiterated.

*peace*

Meg.

Meg

03-30-2003, 12:08 AM
Code:
SUB AddContact()

  TYPE RecordType
    RName as STRING * 20
    Age as INTEGER
    SSN as STRING * 9
  END TYPE

  REDIM PersonalInfo as RecordType

  OPEN "contacts.dat" for RANDOM AS #1 LEN = LEN(PersonalInfo)
    RecordNum = 0
    DO
      RecordNum = RecordNum + 1
      GET #1, RecordNum, PersonalInfo
    LOOP UNTIL EOF(1)
    Input "Enter Name: ", PersonalInfo.RName
    Input "Enter Age: ", PersonalInfo.Age
    Input "Enter SS#: ", PersonalInfo.SSN
    Put #1, RecordNum, PersonalInfo
  CLOSE #1

END SUB

Kofman

04-04-2003, 09:20 AM
I got quite a bit out of it and solved a few problems but I'm stuck again.

When I add a contact record to the a file called contacts.txt it only saves the last field and saves it in every single field.

Code:
TYPE ContactDescription
       ctcname AS STRING * 30
       phonenum AS STRING * 7
       email AS STRING * 30
       address AS STRING * 20
       city AS STRING * 15
       state AS STRING * 2
       zip AS STRING * 5
       about AS STRING * 60
END TYPE

DIM ContactRecord  AS ContactDescription

Lengh = LEN(ContactRecord)

OPEN "R", #1, "Contacts.txt", Lengh

Adding a Contact
Code:
LOCATE 5, 25
INPUT "", ctcname$
IF ctcname$ <> "exit" THEN
DO
    LOCATE 7, 25
    INPUT "", phonenum$
    LOCATE 9, 25
    INPUT "", email$
    LOCATE 11, 25
    INPUT "", address$
    LOCATE 13, 25
    INPUT "", city$
    LOCATE 15, 25
    INPUT "", state$
    LOCATE 17, 25
    INPUT "", zip$
    LOCATE 19, 25
    INPUT "", about$

    RecNum = LOF(1) / LEN(ContactRecord) + 1
    PUT #1, RecNum, ctcname$
    PUT #1, RecNum, phonenum$
    PUT #1, RecNum, email$
    PUT #1, RecNum, address$
    PUT #1, RecNum, city$
    PUT #1, RecNum, state$
    PUT #1, RecNum, zip$
    PUT #1, RecNum, about$
    
    FOR i = 5 TO 19 STEP 2
        LOCATE i, 25
        PRINT "                                        "
    NEXT i

       LOCATE 5, 25
       INPUT "", ctcname$
       IF ctcname$ <> "exit" THEN ctcname$ = ctcname$

LOOP UNTIL LCASE$(ctcname$) = "exit"
END IF

Viewing Contacts
Code:
LastRec = LOF(1) / LEN(ContactRecord) + 1
DIM cTable$(1 TO LastRec, 1 TO 8)

FOR Entry = 1 TO LastRec
    FOR Fld = 1 TO 8
        GET #1, Entry, ctcname$
        GET #1, Entry, phonenum$
        GET #1, Entry, email$
        GET #1, Entry, address$
        GET #1, Entry, city$
        GET #1, Entry, state$
        GET #1, Entry, zip$
        GET #1, Entry, about$

        cTable$(Entry, Fld) = ctcname$
        cTable$(Entry, Fld) = phonenum$
        cTable$(Entry, Fld) = email$
        cTable$(Entry, Fld) = address$
        cTable$(Entry, Fld) = city$
        cTable$(Entry, Fld) = state$
        cTable$(Entry, Fld) = zip$
        cTable$(Entry, Fld) = about$
    NEXT Fld
NEXT Entry
FOR Entry = 1 TO LastRec
    FOR Fld = 1 TO 8
        PRINT cTable$(Entry, Fld)
        PRINT cTable$(Entry, Fld)
        PRINT cTable$(Entry, Fld)
        PRINT cTable$(Entry, Fld)
        PRINT cTable$(Entry, Fld)
        PRINT cTable$(Entry, Fld)
        PRINT cTable$(Entry, Fld)
        PRINT cTable$(Entry, Fld)
    NEXT Fld
NEXT Entry

And ofcoarse somewhere else in the file I would actually close #1.

That's the general jift of it and I'm confused where I'm making my mistakes

My ultimate goal is to be able to Write, Read, Edit, Delete, and store into an array. If someone here has the patience please cover each of the aspects along with debugging what I currently have. :normal:

relsoft

04-04-2003, 10:41 AM
You mean like this?

http://relsoft.wrq.cjb.net/files/Address.bas

Hexadecimal Disaster

04-04-2003, 11:04 AM
AUUUGH! NOT AGAIN! That goddamned program! [Image: screams.gif]

relsoft

04-04-2003, 11:10 AM
*Looks around fopr Toonski....

Kofman

04-05-2003, 01:35 AM
That program is really nice, and yea I'm trying for somethign simular. I still don't see my error.
Pages: 1 2 3
Qbasicnews.com > QBasic > QB Discussion & Programming Help > Randome Access Trouble