0010  // Kartoteksprogram
0020  
0030 USE DATABASE 
0040 USE EDITTEXT 
0050  
0060 GLOBAL person@,work'rec@,id#,postnr#,fundet 
0065 GLOBAL input'field(,),tast$(),efter(,),udskriv'post(,),find'post 
0070  
0080 RECORD person@ 
0090   FIELD efternavn$ OF 20 
0100   FIELD fornavn$ OF 30 
0110   FIELD gade$ OF 20 
0120   FIELD by$ OF 20 
0130   FIELD telf$ OF 15 
0140 ENDRECORD person@ 
0150  
0160 DIM work'rec@ OF person@ 
0170 DIM job$ OF 1, id#, postnr#, fundet 
0180  
0190 filnavn$:="ram:kartotek.dat" 
0200 open'old(filnavn$,person@,id#) 
0210 IF id#=0 THEN open'new(filnavn$,person@,id#,20) 
0220  
0230 REPEAT  
0240   page 
0250   PRINT AT 5,10: "Afslutte" 
0260   PRINT AT 7,10: "Oprette" 
0270   PRINT AT 9,10: "Rette" 
0280   PRINT AT 11,10: "Slette" 
0290   PRINT AT 13,10: "Udskrive" 
0300   PRINT AT 17,10: "Vælg job: ", 
0310   job$:=tast$("AaOoRrSsUu") 
0320   CASE job$ OF  
0330   WHEN "O","o" 
0340     opret 
0350   WHEN "R","r" 
0360     ret 
0370   WHEN "S","s" 
0380     slet 
0390   WHEN "U","u" 
0400     udskriv 
0410   WHEN "A","a" 
0420     afslut 
0430   ENDCASE  
0440 UNTIL job$ IN "Aa" 
0450  
0460  // Slut på hovedprogram
0470  
0480 PROC afslut CLOSED 
0490   close'db(id#) 
0500 ENDPROC afslut 
0510  
0520 PROC opret CLOSED 
0530   DIM sv$ OF 1 
0540   page 
0550   PRINT AT 3,10: "Indtast ny post:" 
0560   work'rec@:=person@ 
0570   FOR linje:=1 TO 5 DO input'field(work'rec@,linje) 
0580   REPEAT  
0590     PRINT AT 17,10: "Oprette (j/n eller nummer, der skal rettes) ", 
0600     sv$:=tast$("jJnN12345") 
0610     PRINT sv$ 
0620     IF sv$ IN "12345" THEN input'field(work'rec@,ord(sv$)-ord("0")) 
0630   UNTIL sv$ IN "jJnN" 
0640   IF sv$ IN "jJ" THEN  
0650     add'post(id#,work'rec@,efter(,),post'id#) 
0660     IF post'id#=0 THEN  
0670       page 
0680       PRINT AT 10,10: "Ikke plads til posten!" 
0690       PRINT AT 13,10: "Tryk på mellemrumstasten" 
0700       sv$:=tast$(" ") 
0710     ENDIF  
0720   ENDIF  
0730 ENDPROC opret 
0740  
0750 PROC find'post CLOSED 
0760   PROC søg(person@,postid#,REF fortsæt#) CLOSED 
0770     IF postid#=postnr# THEN  
0780       page 
0790       PRINT  
0800       PRINT  
0810       udskriv'post(person@,postid#) 
0820       PRINT AT 10,10: "Er det denne post (j/n) ? ", 
0830       sv$:=tast$("jJnN") 
0840       PRINT sv$ 
0850       IF sv$ IN "jJ" THEN  
0860         work'rec@:=person@ 
0870         fundet:=true 
0875         postnr#:=postid# 
0880       ENDIF  
0890       fortsæt#:=false 
0900     ELSE  
0910       fortsæt#:=true 
0920     ENDIF  
0930   ENDPROC søg 
0940    
0950   TRAP  
0960     page 
0970     INPUT AT 10,10: "Indtast nummer på post: ": postnr# 
0980   HANDLER  
0990     RETRY  
1000   ENDTRAP  
1010   fundet:=false 
1020   list'all(id#,person@,søg(,,)) // Find den ønskede post
1030 ENDPROC find'post 
1040  
1050 PROC ret CLOSED 
1060   find'post 
1070   IF fundet THEN  
1080     page 
1090     PRINT AT 3,10: "Ret posten:" 
1100     FOR linje:=1 TO 5 DO input'field(work'rec@,linje) 
1110     REPEAT  
1120       PRINT AT 17,10: "Korrekt (j/n, eller nummer at rette) ", 
1130       sv$:=tast$("jJnN12345") 
1140       PRINT sv$ 
1150       IF sv$ IN "12345" THEN input'field(work'rec@,ord(sv$)-ord("0")) 
1160     UNTIL sv$ IN "jJnN" 
1170     IF sv$ IN "jJ" THEN  
1180       rem'post(id#,postnr#) 
1190       add'post(id#,work'rec@,efter(,),postid#) 
1200     ENDIF  
1210   ENDIF  
1220 ENDPROC ret 
1230  
1240 PROC slet CLOSED 
1250   find'post 
1260   IF fundet THEN rem'post(id#,postnr#) 
1270 ENDPROC slet 
1280  
1290 PROC udskriv CLOSED 
1300   PROC list'post(person@,nr#,fortsæt#) CLOSED 
1310     udskriv'post(person@,nr#) 
1320     PRINT  
1330     PRINT  
1340     IF currow>18 THEN  
1350       PRINT AT 22,10: "Tryk på mellemrumstasten", 
1360       WHILE inkey$<>" " DO NULL 
1370       page 
1380       PRINT  
1390       PRINT  
1400     ENDIF  
1410     fortsæt:=true 
1420   ENDPROC list'post 
1430    
1440   page 
1450   PRINT  
1460   PRINT  
1470   list'all(id#,person@,list'post(,,)) 
1480   IF currow<>2 THEN  
1490     PRINT AT 22,10: "Tryk på mellemrumstasten", 
1500     WHILE inkey$<>" " DO NULL 
1510   ENDIF  
1520 ENDPROC udskriv 
1530  
1540 PROC input'field(REF person@,linje) CLOSED 
1550   CASE linje OF  
1560   WHEN 1 
1570     PRINT AT 6,10: "1. Efternavn:           ", 
1580     edittext(person@.efternavn$) 
1590   WHEN 2 
1600     PRINT AT 8,10: "2. Fornavn(e):          ", 
1610     edittext(person@.fornavn$) 
1620   WHEN 3 
1630     PRINT AT 10,10: "3. Gade/vej:            ", 
1640     edittext(person@.gade$) 
1650   WHEN 4 
1660     PRINT AT 12,10: "4. Postnummer og by:    ", 
1670     edittext(person@.by$) 
1680   WHEN 5 
1690     PRINT AT 14,10: "5. Telefonnummer:       ", 
1700     edittext(person@.telf$) 
1710   OTHERWISE  
1720      // Burde ikke ske
1730   ENDCASE  
1740 ENDPROC input'field 
1750  
1760 FUNC tast$(lovlige'tegn$) CLOSED 
1770   REPEAT  
1780     c$:=inkey$ 
1790   UNTIL c$ IN lovlige'tegn$ 
1800   RETURN c$ 
1810 ENDFUNC tast$ 
1820  
1830 FUNC efter(post1@,post2@) CLOSED 
1840   RETURN post1@.efternavn$>post2@.efternavn$ 
1850 ENDFUNC efter 
1860  
1870 PROC udskriv'post(person@,nr#) CLOSED 
1880   PRINT AT 0,10: person@.efternavn$,", ",person@.fornavn$, 
1890   PRINT AT 0,40: "Nr.: ",nr# 
1900   PRINT AT 0,10: person@.gade$ 
1910   PRINT AT 0,10: person@.by$, 
1920   PRINT AT 0,40: "Telefon: ",person@.telf$ 
1930 ENDPROC udskriv'post 
