illeagal function call i dont know why

[badger]

Hello

This is my entire app at the moment. Please Excuse the rem statements do to a problem i have with my eyes i need to do this to keep the sections of the software from running together.

Problem any time you enter value that is longer then expected it gives an error message (this works) but when i exit the error routine i get an illeagal function call. On the main menu just type in 2 or more chars and hit enter and you will get this error. Please if you would run the code see the message and if you can sort through the code give me a reason why this is going on.

Thanks in advance
Badger

Code: QB64: [Select]

1. REM ***************************************************************************
2. REM **** Program Bridal Store *************************************************
3. REM ***************************************************************************
4. REM ***************************************************************************
5. REM **** Author Philip King  **************************************************
6. REM ***************************************************************************
7. REM ***************************************************************************
8. REM ***************************************************************************
9. REM **** Includes go here *****************************************************
10. REM ***************************************************************************
11.  
12. REM ***************************************************************************
13. REM ***************************************************************************
14. REM **** Sreen statements here ************************************************
15. REM ***************************************************************************
16. $COLOR:32
17. REM ***************************************************************************
18.  
19. REM ***************************************************************************
20. REM **** defines for quick use data types *************************************
21. REM ***************************************************************************
22. _DEFINE I AS INTEGER : _DEFINE S AS STRING : _DEFINE D AS DOUBLE :
23. _DEFINE F AS _FLOAT : _DEFINE L AS LONG : _DEFINE Z AS _INTEGER64
24. REM ***************************************************************************
25.  
26. REM ***************************************************************************
27. REM **** Listing of subs and funtions *****************************************
28. REM ***************************************************************************
29.  
30. REM ***************************************************************************
31.  
32. REM ***************************************************************************
33. REM **** arrays decleared here ************************************************
34. REM ***************************************************************************
35. imenu = 4
36. DIM SHARED smenu(imenu) AS STRING
37. REM ***************************************************************************
38.  
39. REM ***************************************************************************
40. REM **** arrays set to data here **********************************************
41. REM ***************************************************************************
42. smenu(1) = "1) Edit Customer Info": smenu(2) = "3) Edit Inventory Data "
43. smenu(3) = "2) Edit Sales ": smenu(4) = "4) System Maintenance "
44. REM ***************************************************************************
45.  
46. REM ***************************************************************************
47. REM **** variables declares go here *******************************************
48. REM ***************************************************************************
49. DIM SHARED sr AS STRING
50. CONST null = ""
51. DIM SHARED zrecordnum
52. DIM SHARED lrecordlen
53. DIM shomedir AS STRING
54. shomedir = _CWD$
55. REM ***************************************************************************
56.  
57. REM ***************************************************************************
58. REM **** customer info record type ********************************************
59. REM ***************************************************************************
60. TYPE customer
61.     id AS STRING * 10
62.     sfirst_name AS STRING * 25
63.     slast_name AS STRING * 25
64.     saddress AS STRING * 30
65.     scity AS STRING * 25
66.     sstate AS STRING * 2
67.     szip AS STRING * 5
68.     sphone AS STRING * 10
69.     sdesc AS STRING * 10
70.     sfiller AS STRING * 114
71. END TYPE
72. REM ***************************************************************************
73.  
74. REM ***************************************************************************
75. REM **** inventory record type ************************************************
76. REM ***************************************************************************
77. TYPE inventory
78.     id AS STRING * 10
79.     sdesc AS STRING * 10
80.     sdate_bought AS STRING * 8
81.     sdate_sold AS STRING * 8
82.     scost AS STRING * 15
83.     sretail AS STRING * 15
84.     ssize AS STRING * 2
85.     ssold AS STRING * 1
86.     squanity AS STRING * 2
87.     sfiller AS STRING * 57
88. END TYPE
89. REM ***************************************************************************
90.  
91. REM ***************************************************************************
92. REM **** system data file record **********************************************
93. REM ***************************************************************************
94. TYPE systemdat
95.     sdata0 AS STRING * 64 '   data path for customer discription files
96.     sdata1 AS STRING * 64 '   data path for inventory discription files
97.     sdata2 AS STRING * 64 '   data path for pos discription files
98.     sdbpath AS STRING * 64 '  data path for database files
99. END TYPE
100. REM ***************************************************************************
101.  
102. REM ***************************************************************************
103. REM **** point of sale type ***************************************************
104. REM ***************************************************************************
105. TYPE sposlposid
106.     sposid AS STRING * 10
107. END TYPE
108. REM ***************************************************************************
109. DIM SHARED scustinforec AS customer
110. DIM SHARED systemrec AS systemdat
111. DIM SHARED sinventoryrec AS inventory
112. linventorylen = LEN(sinventoryrec)
113. lcustreclen = LEN(scustinforec)
114. lsystemreclen = LEN(systemrec)
115. REM ***************************************************************************
116.  
117. REM ***************************************************************************
118. REM **** metadata commands ****************************************************
119. REM ***************************************************************************
120. $VERSIONINFO:CompanyName=Joyces Bridal
121. $VERSIONINFO:ProductName=Joyce Bridal
122. $VERSIONINFO:ProductVersion=1.0
123. $VERSIONINFO:LegalCopyright=10/8/2020
124. '$VERSIONINFO:
125. REM ***************************************************************************
126.  
127. CLS
128. 'scv = _OS$
129. GOSUB dircheck
130. 'IF isysflag = 0 THEN GOTO sys0
131. GOTO main
132. REM ***************************************************************************
133.  
134. REM ***************************************************************************
135. REM **** main menu loop *******************************************************
136. REM ***************************************************************************
137. menuloop:
138. GOSUB systemheader
139. GOSUB printmain
140. GOSUB mainmenuchoice
141. IF sr = "" OR sr = CHR$(13) THEN GOTO menuloop
142. IF sr = "X" THEN END
143. IF sr = "1" THEN
144.     CLS
145.     GOSUB scustinforec_null
146.     sunit = "Customer Information Maintenance"
147.     GOSUB systemheader
148.     GOSUB s0
149. END IF
150. IF sr = "3" THEN
151.     CLS
152.     GOSUB inventoryrec_null
153.     sunit = "Inventory Information Maintenance"
154.     GOSUB systemheader
155.     GOSUB inv0
156. END IF
157.  
158. IF sr = "4" THEN
159.     GOSUB systemdat_null
160.     sunit = "System Information Maintenance"
161.     GOSUB systemheader
162.     GOSUB sys0
163. END IF
164. RETURN
165. REM ***************************************************************************
166.  
167. REM ***************************************************************************
168. REM **** fix computer svc to show no [] in print ******************************
169. REM ***************************************************************************
170. svcfix:
171. svc = _OS$
172. itemp = LEN(svc)
173. FOR ix = 1 TO itemp
174.     IF MID$(svc, ix, 1) = "[" THEN
175.         MID$(svc, ix, 1) = " "
176.     END IF
177.     IF MID$(svc, ix, 1) = "]" THEN
178.         MID$(svc, ix, 1) = " "
179.     END IF
180. NEXT ix
181. stemp = LTRIM$(LEFT$(svc, 2)) + LCASE$(MID$(svc, 3, 7)) + LTRIM$(MID$(svc, 9, 4)) + " " + MID$(svc, 13, 1)
182. stemp = stemp + RTRIM$(LCASE$(RIGHT$(svc, 3)))
183. svc = stemp
184. RETURN
185. REM ***************************************************************************
186.  
187. REM ***************************************************************************
188. REM **** Sytem Header *********************************************************
189. REM ***************************************************************************
190. systemheader:
191. CLS
192. COLOR White, Blue
193. CLS
194. LOCATE 1, 1: PRINT CHR$(201): LOCATE 1, 80: PRINT CHR$(187)
195. LOCATE 1, 2: PRINT STRING$(78, 205):
196. FOR ix = 2 TO 7
197.     LOCATE ix, 1: PRINT CHR$(186)
198.     LOCATE ix, 80: PRINT CHR$(186)
199. NEXT ix
200. LOCATE 7, 2: PRINT STRING$(78, 205)
201. LOCATE 7, 1: PRINT CHR$(200): LOCATE 7, 80: PRINT CHR$(188)
202. LOCATE 4, 30: PRINT "Main System Menu"
203. LOCATE 4, 63: PRINT "Date ": LOCATE 4, 68: PRINT DATE$
204. GOSUB svcfix
205. LOCATE 4, 4: PRINT svc
206. iten = LEN(sunit)
207. LOCATE 6, (40 - (iten \ 2)): PRINT sunit
208.  
209. RETURN
210. REM ***************************************************************************
211.  
212. REM ***************************************************************************
213. REM **** printes in system erros **********************************************
214. REM ***************************************************************************
215. sprintserrors:
216. CLS
217. SCREEN 0
218. IF se = "" THEN se = "INVALID RESPONSE"
219. itemp = LEN(se)
220. itemp1 = 40 - (itemp / 2)
221. BEEP
222. COLOR 16, 7
223. LOCATE 25, itemp1: _BLINK ON: PRINT se;
224. idelay = 1.5
225. CALL Delay(1.5)
226. _BLINK OFF
227. iflag2 = 1
228. RETURN
229. REM ***************************************************************************
230.  
231. REM ***************************************************************************
232. REM **** numeric input sub ****************************************************
233. REM ***************************************************************************
234. snumeric:
235. ftemp = VAL(sr)
236. IF ftemp < ilow OR ftemp > ihigh THEN
237.     se = "INPUT OUT OF BOUNDS"
238.     GOSUB sprintserrors
239. END IF
240. REM ***************************************************************************
241.  
242. REM ***************************************************************************
243. REM **** alpha input sub ******************************************************
244. REM ***************************************************************************
245. salphainput:
246. iflag2 = 0
247. ilength1 = LEN(sr)
248. ilength2 = LEN(saction) + 2
249. LOCATE 23, 1: PRINT saction; '               prints action menu
250. LOCATE 23, ilength2 '                        set prompt one space after action menu print
251. COLOR Yellow, Black: PRINT SPC(ib); '        changes color and prints ib spaces to screen for input lenght
252. LOCATE 23, ilength2 '                        sets curser at the begining of input space from previouse line
253. LINE INPUT sr: sr = UCASE$(sr) '             inputs data from user changes it to upper case
254. IF LEN(sr) > ib THEN
255.     se = "INVALID INPUT LENGTH"
256.     GOSUB sprintserrors
257.     sr = ""
258.     iflag2 = 1
259.     GOTO salphainput
260. END IF
261. IF sr = "X" AND iflag1 = 1 THEN iflag1 = 0
262. IF iflag1 = 1 AND VAL(sr) < ilow AND VAL(sr) > ihigh THEN GOSUB snumeric
263. COLOR White, Blue
264. RETURN
265. REM ***************************************************************************
266.  
267. REM ***************************************************************************
268. REM **** main menu to the screen **********************************************
269. REM ***************************************************************************
270. printmain:
271. COLOR White, Blue
272. FOR ix = 11 TO imenu
273.     READ smenu(ix): LOCATE ix, 20: PRINT smenu(ix)
274. NEXT ix
275. LOCATE 11, 15: PRINT smenu(1)
276. LOCATE 11, 40: PRINT smenu(2)
277. LOCATE 13, 15: PRINT smenu(3)
278. LOCATE 13, 40: PRINT smenu(4)
279. RETURN
280. REM ***************************************************************************
281.  
282. REM ***************************************************************************
283. REM **** menu prompts start here **********************************************
284. REM ***************************************************************************
285. mainmenuchoice:
286. ib = 1
287. ihigh = 99
288. ilow = 1
289. saction = "Choose Menu Option or X to Quit "
290. GOSUB salphainput
291. RETURN
292. REM ***************************************************************************
293.  
294. REM ***************************************************************************
295. REM **** clean up the prompt area *********************************************
296. REM ***************************************************************************
297. clearprompt:
298. LOCATE 23, 1: PRINT STRING$(79, 32)
299. RETURN
300. REM ***************************************************************************
301.  
302. REM ***************************************************************************
303. REM **** set custinforrec variables to zero or null ***************************
304. REM ***************************************************************************
305. scustinforec_null:
306. scustinforec.id = null
307. scustinforec.sfirst_name = null
308. scustinforec.slast_name = null
309. scustinforec.saddress = null
310. scustinforec.scity = null
311. scustinforec.sstate = null
312. scustinforec.szip = null
313. scustinforec.sphone = null
314. RETURN
315. REM ***************************************************************************
316.  
317. REM ***************************************************************************
318. REM **** set inventoryrec variables to zero or null ***************************
319. REM ***************************************************************************
320. inventoryrec_null:
321. sinventory.id = null
322. sinventory.sdesc = null
323. sinventory.sdate_bought = null
324. sinventory.sdate_sold = null
325. sinventory.scost = null
326. sinventory.fretail = null
327. sinventory.ssize = null
328. sinventory.ssold = null
329. RETURN
330. REM ***************************************************************************
331. REM **** set systemrec variagles to zero or null*******************************
332. REM ***************************************************************************
333. systemdat_null:
334. systemdat.sspath = null
335. systemdat.sdata1 = null
336. systemdat.sdata2 = null
337. systemdat.sdata3 = null
338. RETURN
339. REM ***************************************************************************
340.  
341. REM ***************************************************************************
342. REM **** opens random files ***************************************************
343. REM ***************************************************************************
344. randomfiles:
345. sdbpath = shomedir + "\data\db\"
346. OPEN sdbpath + "jbridal.db" FOR RANDOM AS #1 LEN = lcustreclen
347. OPEN sdbpath + "system.db" FOR RANDOM AS #4 LEN = lsystemreclen
348. OPEN sdbpath + "inventory.db" FOR RANDOM AS #3 LEN = linventorylen
349. zsystemrecnum = LOF(4) / lsystemreclen
350. RETURN
351. REM ***************************************************************************
352.  
353. REM ***************************************************************************
354. REM **** inserts record into random file **************************************
355. REM ***************************************************************************
356. insertrec:
357. SELECT CASE ifilenum
358.     CASE 1
359.         PUT #1, zcustrecnum, scustinforec
360.     CASE 3
361.  
362.         PUT #3, zinventorynum, sinventoryrec
363. END SELECT
364. RETURN
365. REM ***************************************************************************
366.  
367. REM ***************************************************************************
368. REM **** get last file index for indexing *************************************
369. REM ***************************************************************************
370.  
371. autoindex:
372. zinventorynum = 0
373. SELECT CASE ifilenum
374.     CASE 1:
375.         zcustrecnum = LOF(1) / lcustreclen
376.         zcustrecnum = zcustrecnum + 1
377.         sindex = LTRIM$(STR$(zcustrecnum))
378.         IF LEN(sindex) < 9 THEN
379.             sindex = STRING$(9 - LEN(sindex), 48) + sindex
380.             scustinforec.id = sindex
381.         END IF
382.     CASE 3:
383.         zinventorynum = LOF(3) / linventorylen
384.         zinventorynum = zinventorynum + 1
385.         sindex = LTRIM$(STR$(zinventorynum))
386.         IF LEN(sindex) < 9 THEN
387.             sindex = STRING$(9 - LEN(sindex), 48) + sindex
388.             sinventoryrec.id = sindex
389.  
390.         END IF
391. END SELECT
392.  
393.  
394. RETURN
395. REM ***************************************************************************
396.  
397. REM ***************************************************************************
398. REM **** shell for notepad for description files by inventory number **********
399. REM ***************************************************************************
400. descinput:
401. sdbtemp = LTRIM$(RTRIM$(sdata)) + LTRIM$(RTRIM$(sdesc)) + ".txt"
402. ifileexists = _FILEEXISTS(sdbtemp)
403. IF ifileexists = -1 THEN
404.     SHELL "wordpad " + CHR$(34) + sdbtemp + CHR$(34)
405. ELSE
406.     OPEN sdbtemp FOR OUTPUT AS #6
407.     PRINT #6, "Type in your stuff. Save the file and exit."
408.     CLOSE #6
409.     SHELL "wordpad " + CHR$(34) + sdbtemp + CHR$(34)
410. END IF
411. RETURN
412. REM ***************************************************************************
413.  
414. REM ***************************************************************************
415. REM **** main modual **********************************************************
416. REM ***************************************************************************
417. main:
418. GOSUB randomfiles
419. SCREEN _NEWIMAGE(640, 400, 32)
420. COLOR LightCyan, MidnightBlue
421. iflag2 = 0
422. iflag3 = 0
423. CLS
424. _FULLSCREEN
425. REM ***************************************************************************
426. mainloop:
427. GOSUB menuloop:
428. SELECT CASE sr
429.     CASE "1":
430.         sdata = shomedir + "\data\custdesc\"
431.         ifilenum = 1
432.         GOSUB scustinforec_null
433.         GOSUB autoindex
434.         GOSUB s1
435.         GOTO mainloop
436.     CASE "2"
437.         sdata = shomedir + "\data\posdesc\"
438.         'IF sr = "2" THEN
439.         'ifilenum = 2
440.         'GOSUB inventoryrec_null
441.         'GOSUB inv1
442.         'GOTO mainloop
443.         'END IF
444.  
445.     CASE "3":
446.         sdata = shomedir + "\data\invdesc\"
447.         ifilenum = 3
448.         GOSUB inventoryrec_null
449.         GOSUB autoindex
450.         sinventoryrec.scost = "0.00"
451.         sinventoryrec.sretail = "0.00"
452.         GOSUB inv1
453.         GOTO mainloop
454.  
455.     CASE "4":
456.         'sdb =  shomedir + "\data\custdesc"
457.         'ifilenum = 4
458.         ' GOSUB systemdat_null
459.         ' GOSUB sys1
460.         ' GOTO mainloop
461.  
462. END SELECT
463. RETURN
464. REM ***************************************************************************
465.  
466. REM ***************************************************************************
467. REM **** check for statup directories *****************************************
468. REM ***************************************************************************
469. dircheck:
470. SELECT CASE _DIREXISTS(shomedir)
471.     CASE -1:
472.         GOTO dirchk1
473.     CASE 0:
474.         BEEP
475.         CLS
476.         LOCATE 12, 27
477.         PRINT "Home Director Does not Exists"
478.         LOCATE 13, 23: PRINT "Please Create Jbridal in Your Home dir"
479.         LOCATE 14, 30: PRINT "And Rerun The program"
480.         LOCATE 16, 32: PRINT "Enter to continue"
481.         LINE INPUT st
482.         CLOSE
483.         END
484. END SELECT
485.  
486. dirchk1:
487.  
488. iflag = _DIREXISTS(shomedir + "\data")
489. IF iflag = 0 THEN MKDIR shomedir + "\data"
490.  
491. iflag = _DIREXISTS(shomedir + "\data\db")
492. IF iflag = 0 THEN MKDIR shomedir + "\data\db"
493.  
494. iflag = _DIREXISTS(shomedir + "\data\custdesc")
495. IF iflag = 0 THEN MKDIR shomedir + "\data\custdesc"
496.  
497. iflag = _DIREXISTS(shomedir + "\data\invdesc")
498. IF iflag = 0 THEN MKDIR shomedir + "\data\invdesc"
499.  
500. iflag = _DIREXISTS(shomedir + "\data\posdesc")
501. IF iflag = 0 THEN MKDIR shomedir + "\data\posdesc"
502. RETURN
503. REM ***************************************************************************
504. REM ***************************************************************************
505. REM **** system utilities data entry ******************************************
506. REM ***************************************************************************
507. sys0:
508. LOCATE 10, 1: PRINT "Customer Discription File Path  ";: PRINT systemdat.sdata0 = _CWD$
509. LOCATE 11, 1: PRINT "Inventory Discription File Path ";: PRINT systemdat.sdata1
510. LOCATE 12, 1: PRINT "Pos Discription File Path       ";: PRINT systemdat.sdata2
511. LOCATE 13, 1: PRINT "Enter Path For Databases        ";: PRINT systemdat.sdbpath
512. RETURN
513. REM ***************************************************************************
514. sys1:
515. saction = "Customer Disc File Path "
516. ib = 64
517. ilow = 1
518. ihigh = 1
519. iflag1 = 0
520. GOSUB clearprompt
521. GOSUB salphainput
522. IF sr = "" THEN GOTO sys1
523. IF sr = CHR$(88) THEN RETURN 'X
524. systemdat.sdata0 = sr
525. GOSUB sys0
526. GOTO sys2
527. REM ***************************************************************************
528.  
529. sys2:
530. saction = "Inventory Disc File Path "
531. ib = 64
532. ilow = 1
533. ihigh = 1
534. iflag1 = 0
535. GOSUB clearprompt
536. GOSUB salphainput
537. IF sr = "" THEN GOTO sys2
538. IF sr = CHR$(88) THEN RETURN 'X
539. systemdat.sdata1 = sr
540. GOSUB sys0
541. GOTO sys2
542. REM ***************************************************************************
543. sys3:
544. saction = "POS Disc File Path "
545. ib = 64
546. ilow = 1
547. ihigh = 1
548. iflag1 = 0
549. GOSUB clearprompt
550. GOSUB salphainput
551. IF sr = "" THEN GOTO sys3
552. IF sr = CHR$(88) THEN RETURN 'X
553. systemdat.sdata2 = sr
554. GOSUB sys0
555. GOTO sys4
556. REM ***************************************************************************
557. sys4:
558. saction = "Enter Database File Path "
559. ib = 64
560. ilow = 1
561. ihigh = 1
562. iflag1 = 0
563. GOSUB clearprompt
564. GOSUB salphainput
565. IF sr = "" THEN GOTO sys3
566. IF sr = CHR$(88) THEN RETURN 'X
567. systemdat.sdbpath = sr
568. GOSUB sys0
569. GOTO sys4
570. REM ***************************************************************************
571.  
572. REM ***************************************************************************
573. REM ***************************************************************************
574. REM **** inventory input modual ***********************************************
575. REM ***************************************************************************
576. inv0:
577. LOCATE 10, 1: PRINT "Inventory Number         ";: PRINT sinventoryrec.id
578. LOCATE 11, 1: PRINT "Description File Name    ";: PRINT sinventoryrec.sdesc
579. LOCATE 12, 1: PRINT "Date Purchased           ";
580. PRINT LEFT$(sinventoryrec.sdate_bought, 2) + "/";
581. PRINT MID$(sinventoryrec.sdate_bought, 3, 2) + "/";
582. PRINT RIGHT$(sinventoryrec.sdate_bought, 4)
583. LOCATE 13, 1: PRINT "Date Sold                ";
584. PRINT LEFT$(sinventoryrec.sdate_sold, 2) + "/";
585. PRINT MID$(sinventoryrec.sdate_sold, 3, 2) + "/";
586. PRINT RIGHT$(sinventoryrec.sdate_sold, 4)
587.  
588. LOCATE 14, 1: PRINT "Coste of Item            ";: PRINT sinventoryrec.scost
589. LOCATE 15, 1: PRINT "Retail Price             ";: PRINT sinventoryrec.sretail
590. LOCATE 16, 1: PRINT "Size Of Item             ";: PRINT sinventoryrec.ssize
591. LOCATE 17, 1: PRINT "Remove for Inventory Y/N ";: PRINT sinventoryrec.ssold
592. LOCATE 18, 1: PRINT "Enter Quanity of Item    ";: PRINT sinventoryrec.squanity
593. RETURN
594. REM ***************************************************************************
595. inv1:
596. GOSUB inv0
597. GOTO inv2
598. REM ***************************************************************************
599. inv2:
600. saction = "Enter D for Default, Type Name, X to Exit - To Backup "
601. ib = 8
602. ilow = 1
603. ihigh = 999999999
604. iflag1 = 0
605. GOSUB clearprompt
606. GOSUB salphainput
607. SELECT CASE sr
608.     CASE CHR$(88): RETURN 'X
609.         'CASE CHR$(45): GOTO inv2 '-
610.     CASE "":
611.         sinventoryrec.sdesc = sinventoryrec.id
612.         sdesc = sinventoryrec.id
613.         GOSUB descinput
614.         GOSUB inv0
615.         GOTO inv3
616.  
617.     CASE CHR$(68): 'D for using the sinventoryrec.id as the file name
618.         sinventoryrec.sdesc = sinventoryrec.id
619.         sdesc = sinventoryrec.id
620.         GOSUB descinput
621.         GOSUB inv0
622.         GOTO inv3
623.     CASE ELSE
624.         sinventoryrec.sdesc = sr
625.         sdesc = sr
626.         GOSUB descinput
627.         GOSUB inv0
628.         GOTO inv3
629. END SELECT
630. REM ***************************************************************************
631. inv3:
632. saction = "Enter Date Bought X to Exit - To Backup "
633. ib = 8
634. ilow = 1
635. ihigh = 999999999
636. iflag1 = 0
637. GOSUB clearprompt
638. GOSUB salphainput
639. SELECT CASE sr
640.     CASE CHR$(88): RETURN 'X
641.     CASE CHR$(45): GOTO inv2 '-
642.     CASE "": GOTO inv4 ' key or ""
643.     CASE ELSE
644.         sinventoryrec.sdate_bought = sr
645.         GOSUB inv0
646.         GOTO inv4
647. END SELECT
648.  
649. REM ***************************************************************************
650. inv4:
651. saction = "Enter Date Sold X to Exit - To Backup "
652. ib = 8
653. ilow = 1
654. ihigh = 999999999
655. iflag1 = 0
656. GOSUB clearprompt
657. GOSUB salphainput
658. SELECT CASE sr
659.     CASE CHR$(88): RETURN 'X
660.     CASE CHR$(45): GOTO inv2 '-
661.     CASE "": GOTO inv5 ' ""
662.     CASE ELSE
663.         GOSUB inventoryrec_null
664.         sinventoryrec.sdate_sold = sr
665.         GOSUB inv0
666.         GOTO inv5
667. END SELECT
668.  
669. REM ***************************************************************************
670. inv5:
671. saction = "Enter Cost X to Exit - To Backup "
672. ib = 15
673. ilow = 1
674. ihigh = 999999999
675. iflag1 = 0
676.  
677. GOSUB clearprompt
678. GOSUB salphainput
679. SELECT CASE sr
680.     CASE CHR$(88): RETURN 'X
681.     CASE CHR$(45): GOTO inv4 '-
682.     CASE "": GOTO inv6 '  ""
683.     CASE ELSE
684.         GOSUB inventoryrec_null
685.         sinventoryrec.scost = sr
686.         GOSUB inv0
687.         GOTO inv6
688. END SELECT
689. REM ***************************************************************************
690. inv6:
691. saction = "Enter Retail Price X to Exit - To Backup "
692. ib = 15
693. ilow = 1
694. ihigh = 999999999
695. iflag1 = 0
696. GOSUB clearprompt
697. GOSUB salphainput
698. SELECT CASE sr
699.     CASE CHR$(88): RETURN 'X
700.     CASE CHR$(45): GOTO inv5 '-
701.     CASE "": GOTO inv7 '  ""
702.     CASE ELSE
703.         GOSUB inventoryrec_null
704.         sinventoryrec.sretail = sr
705.         GOSUB inv0
706.         GOTO inv7
707. END SELECT
708.  
709. REM ***************************************************************************
710. inv7:
711. saction = "Enter Dress Size X to Exit - To Backup "
712. ib = 2
713. ilow = 1
714. ihigh = 999999999
715. iflag1 = 0
716. GOSUB clearprompt
717. GOSUB salphainput
718. SELECT CASE sr
719.     CASE CHR$(88): RETURN 'X
720.     CASE CHR$(45): GOTO inv6 '-
721.     CASE "": GOTO inv8 ' ""
722.     CASE ELSE
723.         GOSUB inventoryrec_null
724.         sinventoryrec.ssize = sr
725.         GOSUB inv0
726.         GOTO inv8
727. END SELECT
728. REM ***************************************************************************
729. inv8:
730. saction = "Did Dress Sale Y/N X to Exit - To Backup "
731. ib = 1
732. ilow = 1
733. ihigh = 999999999
734. iflag1 = 0
735. GOSUB clearprompt
736. GOSUB salphainput
737. SELECT CASE sr
738.     CASE CHR$(88): RETURN 'X
739.     CASE CHR$(45): GOTO inv7 '-
740.     CASE "": GOTO inv8
741.     CASE ELSE
742.         GOSUB inventoryrec_null
743.         sinventoryrec.ssold = sr
744.         GOSUB inv0
745.         GOTO inv9
746. END SELECT
747. REM ***************************************************************************
748. inv9:
749. saction = "Enter Quanity of Inventory X to Exit - To Backup "
750. ib = 4
751. ilow = 1
752. ihigh = 999999999
753. iflag1 = 0
754. GOSUB clearprompt
755. GOSUB salphainput
756. SELECT CASE sr
757.     CASE CHR$(88): RETURN 'X
758.     CASE CHR$(45): GOTO inv8 '-
759.     CASE "": GOTO puttorecord ' ""
760.     CASE ELSE
761.         GOSUB inventoryrec_null
762.         sinventoryrec.squanity = sr
763.         GOSUB inv0
764.         GOTO puttorecord
765. END SELECT
766. REM ***************************************************************************
767. REM ***************************************************************************
768. REM ***************************************************************************
769. REM **** customer input modual ************************************************
770. REM ***************************************************************************
771. s0:
772. LOCATE 10, 1: PRINT "Customer ID           ";: PRINT scustinforec.id
773. LOCATE 11, 1: PRINT "Customer First Name   ";: PRINT scustinforec.sfirst_name
774. LOCATE 12, 1: PRINT "customer Last Name    ";: PRINT scustinforec.slast_name
775. LOCATE 13, 1: PRINT "Customer Address      ";: PRINT scustinforec.saddress
776. LOCATE 14, 1: PRINT "Customer City         ";: PRINT scustinforec.scity
777. LOCATE 15, 1: PRINT "customer State        ";: PRINT scustinforec.sstate
778. LOCATE 16, 1: PRINT "customer Zip          ";: PRINT scustinforec.szip
779. LOCATE 17, 1: PRINT "Customer Phone Number ";
780. PRINT "(" + LEFT$(scustinforec.sphone, 3) + ")-"; MID$(scustinforec.sphone, 4, 3) + "-"; RIGHT$(scustinforec.sphone, 4)
781. LOCATE 18, 1: PRINT "Description File Name ";: PRINT scustinforec.sdesc
782. RETURN
783. REM ***************************************************************************
784.  
785. s1:
786. scustinforec.sdesc = scustinforec.id
787. GOSUB s0
788. GOTO s2
789. REM ***************************************************************************
790.  
791. s2:
792. saction = "Enter First Name X to Exit - To Backup "
793. ib = 25
794. ilow = 99
795. ihigh = 99
796. iflag1 = 0
797. GOSUB clearprompt
798. GOSUB salphainput
799. SELECT CASE sr
800.     CASE "": GOTO s4
801.     CASE CHR$(88): RETURN 'X
802.     CASE CHR$(45): GOTO s2 '-
803.     CASE ELSE
804.         scustinforec.sfirst_name = sr
805.         GOSUB s0
806.         GOTO s3
807. END SELECT
808.  
809.  
810.  
811. REM ***************************************************************************
812. s3:
813. saction = "Enter Last Name X to Exit - To Back up "
814. ib = 25
815. ilow = 99
816. ihigh = 99
817. iflag1 = 0
818. GOSUB clearprompt
819. GOSUB salphainput
820. SELECT CASE sr
821.     CASE "": GOTO s4
822.     CASE CHR$(88): RETURN 'X
823.     CASE CHR$(45): GOTO s2 '-
824.     CASE ELSE
825.         scustinforec.slast_name = sr
826.         GOSUB s0
827.         GOTO s4
828. END SELECT
829. REM ***************************************************************************
830.  
831. s4:
832. saction = "Enter Address X to Exit - To Back up "
833. ib = 30
834. ilow = 99
835. ihigh = 99
836. iflag1 = 0
837. GOSUB clearprompt
838. GOSUB salphainput
839. SELECT CASE sr
840.     CASE "": GOTO s5
841.     CASE CHR$(88): RETURN 'X
842.     CASE CHR$(45): GOTO s3 '-
843.     CASE ELSE
844.         scustinforec.saddress = sr
845.         GOSUB s0
846.         GOTO s5
847. END SELECT
848. REM ***************************************************************************
849.  
850. s5:
851. saction = "Enter City Name X to Exit - To Back up "
852. ib = 25
853. ilow = 99
854. ihigh = 99
855. iflag1 = 0
856. GOSUB clearprompt
857. GOSUB salphainput
858. SELECT CASE sr
859.     CASE "": GOTO s6
860.     CASE CHR$(88): RETURN 'X
861.     CASE CHR$(45): GOTO s4 '-
862.     CASE ELSE
863.         scustinforec.scity = sr
864.         GOSUB s0
865.         GOTO s6
866. END SELECT
867. REM ***************************************************************************
868. s6:
869. saction = "Enter State X to Exit - To Back up "
870. ib = 2
871. ilow = 99
872. ihigh = 99
873. iflag1 = 0
874. GOSUB clearprompt
875. GOSUB salphainput
876. SELECT CASE sr
877.     CASE "": GOTO s7
878.     CASE CHR$(88): RETURN 'X
879.     CASE CHR$(45): GOTO s5 '-
880.     CASE ELSE
881.         scustinforec.sstate = sr
882.         GOSUB s0
883.         GOTO s7
884. END SELECT
885. REM ***************************************************************************
886.  
887. s7:
888. saction = "Enter Zip Code Name X to Exit - To Back up "
889. ib = 5
890. ilow = 99
891. ihigh = 99
892. iflag1 = 0
893. GOSUB clearprompt
894. GOSUB salphainput
895. SELECT CASE sr
896.     CASE "": GOTO s8
897.     CASE CHR$(88): RETURN 'X
898.     CASE CHR$(45): GOTO s6 '-
899.     CASE ELSE
900.         scustinforec.szip = sr
901.         GOSUB s0
902.         GOTO s8
903. END SELECT
904. REM ***************************************************************************
905. s8:
906. saction = "Enter Phone Number X to Exit - To Back up "
907. ib = 10
908. ilow = 99
909. ihigh = 99
910. iflag1 = 0
911. GOSUB clearprompt
912. GOSUB salphainput
913. SELECT CASE sr
914.     CASE CHR$(88): RETURN 'X
915.     CASE CHR$(45): GOTO s7 '-
916.     CASE CHR$(68): GOTO s9
917.     CASE CHR$(0): GOTO s0
918.     CASE ELSE
919.         scustinforec.sphone = sr
920.         GOSUB s0
921.         GOTO s9
922. END SELECT
923. REM ***************************************************************************
924. REM ***************************************************************************
925. s9:
926. saction = "Enter Description File Name D or Enter - To Back up "
927. ib = 10
928. ilow = 99
929. ihigh = 99
930. iflag1 = 0
931. GOSUB clearprompt
932. GOSUB salphainput
933. SELECT CASE sr
934.     CASE CHR$(88): RETURN 'X
935.     CASE CHR$(45): GOTO inv1 '-
936.     CASE "":
937.         scustinforec.sdesc = scustinforec.id
938.         sdesc = scustinforec.id
939.         GOSUB descinput
940.         GOSUB s0
941.         GOTO puttorecord
942.  
943.     CASE CHR$(68): 'D for using the sinventoryrec.id as the file name
944.         scustinforec.sdesc = scustinforec.id
945.         sdesc = scustinforec.id
946.         GOSUB descinput
947.         GOSUB s0
948.         GOTO puttorecord
949.  
950.     CASE ELSE
951.         scustinforec.sdesc = sr
952.         sdesc = sr
953.         GOSUB descinput
954.         GOSUB s0
955.         GOTO puttorecord
956. END SELECT
957.  
958. REM ***************************************************************************
959. REM **** ask if you want to put data to record ********************************
960. REM ***************************************************************************
961. puttorecord:
962. saction = "Commit Data to File Y/N"
963. ib = 1
964. ilow = 99
965. ihigh = 99
966. iflag1 = 0
967. GOSUB clearprompt
968. GOSUB salphainput
969. SELECT CASE sr
970.     CASE "Y":
971.         GOSUB insertrec
972.  
973.     CASE "N":
974.         RETURN
975. END SELECT
976. RETURN
977. REM ***************************************************************************
978.  
979. REM ***************************************************************************
980. REM **** delay loop ***********************************************************
981. REM ***************************************************************************
982. SUB Delay (dlay!)
983.     start! = TIMER
984.     DO WHILE start! + dlay! >= TIMER
985.         IF start! > TIMER THEN start! = start! - 86400
986.     LOOP
987. END SUB
988.  
989.  

[badger]

Hello

I forgot to tell that you need to have this in your home directory with a dir called jbridal it will create all the other directories for you .. sorry

Badger

[Richard Frost]

Line 463 should be GOTO mainloop, not RETURN.

It wasn't called as a subroutine with GOSUB, so the RETURN is invalid/illegal/full of chicken feathers.

[badger]

Hey

Thanks i will look into this

Badger

[badger]

Hello

That gosub's return is in the bottom of the s prompts if you want to put the record to file or not. The illeagal function call is in line 251 this line here

COLOR Yellow, Black: PRINT SPC(ib); '        changes color and prints ib spaces to screen for input length

the return for that gosub is in 1 of 2 lines depends on user choice lines 974 and 976 in the section puttorecord:

Badger

[SMcNeill]

$COLOR:32
SCREEN 0

The issue is in the conflicts above.  You can’t use 32-bit graphical color values in a text screen.

[badger]

Hello

thanks very much


i will try some things

Badger

[badger]

Hello SMcNeil

when this routine is call upon how would it be written to do what i am trying to do with $color:32 being used.

Badger

Code: QB64: [Select]

1. sprintserrors:
2. CLS
3. SCREEN 0
4. IF se = "" THEN se = "INVALID RESPONSE"
5. itemp = LEN(se)
6. itemp1 = 40 - (itemp / 2)
7. BEEP
8. COLOR 16, 7
9. LOCATE 25, itemp1: _BLINK ON: PRINT se;
10. CALL Delay(1.5)
11. _BLINK OFF
12. iflag2 = 1
13. RETURN
14.  

[Richard Frost]

I commented out the $COLOR thing, here and in the other problem, because I'm a Neanderthal with version 1.3.

[SMcNeill]

If you’re using SCREEN 0, use $COLOR:0 as well.

SCREEN 0
$COLOR:0
COLOR Yellow, Red
PRINT “Hello World”

[badger]

Hello

if you try to change it back to $color:0 you get an error name already in use so not sure how to switch back and forth..

Badger

[SMcNeill]

Hello

if you try to change it back to $color:0 you get an error name already in use so not sure how to switch back and forth..

Badger

You can’t change back and forth.  $COLOR sets a series of CONST values for the various color names you can use.  You have to choose one, or the other. 

The only way you can do what you’re apparently wanting to do, is to DIM SHARED your variables and then toggle them via some sort of definition method.

For example:


DIM SHARED Red AS _UNSIGNED LONG, Black AS _UNSIGNED LONG, White AS _UNSIGNED LONG

SCREEN _NEWIMAGE(640,400,32)
ColorNames32
COLOR Red, White
PRINT “HELLO WORLD”
SLEEP

SCREEN 0
ColoNames0
Color Red, White
PRINT “Names in screen 0!”

SUB ColorNames0
    Red = 4
    Black = 0
    White = 15
END SUB

SUB ColorNames32
    Red = &HFFFF0000
    Black = &HFF000000
    White = &HFFFFFFFF
END SUB

[badger]

SMcNeil

Thanks i have a few other bugs to work out i will get to this soon. It has been raining here i have degentertive arthritis really bad so when this type of weather hits i am not a very fast person LOL

I am working on it as i go. Just bought a big dry erase board 71 inches long that is going to help as soon as i get it hung lol.

Thanks again.

You all amaze me with your grasp on the basic language it is very nice to have your help

Badger