home *** CD-ROM | disk | FTP | other *** search
/ Software 2000 / Software 2000 Volume 1 (Disc 1 of 2).iso / utilities / u303.dms / in.adf / BomBase1_0.AMOS / BomBase1_0.amosSourceCode
Encoding:
AMOS Source Code  |  1990-11-07  |  29.1 KB  |  1,214 lines
  1. Screen Open 0,640,300,16,Hires
  2. Rem ************************** 
  3. Rem *   The Set-Up Routine   * 
  4. Rem ************************** 
  5. Break Off 
  6. Dim FS$(10),FS(10),M$(10),C$(10),N$(10),K$(10),DEL(80)
  7. DELETED=0
  8. For F=1 To 10
  9. FS(F)=1
  10. Next F
  11. Wind Save 
  12. Paper 0
  13. Cls 
  14. CS
  15. VMR=1 : VD=0
  16. WO["Database Editing Window","Inputting Window","File Information","Keyboard Shortcuts"]
  17. MENUS
  18. PTH$="Apd76:"
  19. DBF$="temp"
  20. STATUS=0
  21. Global I$,VZ2,VMR,VD,K$(),N$(),DELETED,DEL(),C$(),X$,Z$,ESC,Q$,PTH$,DBF$,FS$(),FS(),FIE,STATUS,FI$,CD$,LOT,M$()
  22. Window 1
  23. KEY1
  24. 2 AC
  25. Menu On 
  26. Do 
  27. Q$=Inkey$ : Q$=Upper$(Q$) : If Q$="" Then Goto ILO
  28. If Q$="N" Then NEW : Goto 2
  29. If Q$="O" Then OPEN : Goto 2
  30. If Q$="D" Then DELETE : Goto 2
  31. If Q$="U" Then UNLOAD : Goto 2
  32. If Q$="Q" Then QUIT : Goto 2
  33. If Q$="A" Then AREC : Goto 2
  34. If Q$="M" Then MREC : Goto 2
  35. If Q$="E" Then DREC : Goto 2
  36. If Q$="F" Then EFD : Goto 2
  37. If Q$="P" Then PAR : Goto 2
  38. If Q$="V" Then VR : Goto 2
  39. If Q$="S" Then Gosub 5000 : Goto 2
  40. If Q$="C" Then SER : Goto 2
  41. If Q$="L" Then LIF : Goto 2
  42. If Q$="*" Then VID : Goto 2
  43. Rem If Q$="I" Then AII : Goto 2
  44. Rem If Q$="X" Then FLF : Goto 2
  45. Goto 2
  46. ILO:
  47. On Menu Gosub PROJECT,ED,OUT,MAN,UTILS
  48. On Menu On 
  49. Loop 
  50. Rem *********************
  51. Rem * Keyboard shorts 1 *
  52. Rem *********************
  53. Procedure KEY1
  54. Window 4
  55. Clw 
  56. Pen 2
  57. Print "N = New File"
  58. Print "O = Open File"
  59. Print "D = Delete File"
  60. Print "U = UnLoad File"
  61. Print "Q = Quit"
  62. Print "A = Add Records"
  63. Print "M = Amend Records"
  64. Print "E = Delete Records"
  65. Print "F = Edit File Data"
  66. Print "P = Print All Records"
  67. Print "V = View Records"
  68. Print "S = Sort Records"
  69. Print "C = Search Records"
  70. Print "L = List On A Field"
  71. Rem Print "I = Write ASCII file" 
  72. Rem Print "X = Write Fixed len. file"
  73. Print "* = Validate"
  74. Window 1
  75. End Proc
  76. Rem ***********************  
  77. Rem * Write in ASCII form *
  78. Rem ***********************
  79. Procedure AII
  80. Window 1 : Clw : Pen 2
  81. If STATUS=0 Then Print "There is no database file loaded" : PAUSE : Clw : Pop Proc
  82. Print "Are you sure you want to write in ASCII(Y/N)?"
  83. QIN
  84. If Q$<>"Y" Then Clw : Pop Proc
  85. Clw 
  86. Print "Enter name for your ASCII file-"
  87. AII1:
  88. SLI[0,1,20,"",14,13,0,0]
  89. If ESC=1 Then Clw : Pop Proc
  90. If Z$=Space$(20) Then Clw : Pop Proc
  91. For F=20 To 1 Step -1
  92. If Mid$(Z$,F,1)<>" " Then Z$=Mid$(Z$,1,F) : Goto AII6
  93. Next F
  94. AII6:
  95. If Exist(Z$) Then Print : Print "This file already exists" : PAUSE : Locate 0,3 : Cline : Goto AII1
  96. Print 
  97. Pen 2
  98. Print "Are you sure you want to continue(Y/N)?"
  99. QIN
  100. If Q$<>"Y" Then Clw : Pop Proc
  101. Open Out 2,Z$
  102. Clw 
  103. For F=1 To LOT-DELETED
  104. Z2=F
  105. Locate 0,0 : Print "Current Record-";F
  106. For G=1 To LOT
  107. If DELETED=0 Then Goto AII2
  108. For E=1 To 80
  109. If DEL(E)=G and G<=Z2 Then Z2=Z2+1 : Goto AII3
  110. Next E
  111. AII3:
  112. If G>Z2 Then Goto AII2
  113. Next G
  114. AII2:
  115. Get 1,Z2
  116. OUT$="" : J1$=Chr$(34) : J2$=Chr$(34)+","
  117. For I=1 To FIE
  118. If I<FIE Then OUT$=OUT$+J1$+M$(I)+J2$
  119. If I=FIE Then OUT$=OUT$+J1$+M$(I)+J2$
  120. Next I
  121. Print #2,OUT$
  122. Next F
  123. Close 2
  124. PAUSE: Clw 
  125. End Proc
  126. Rem *************************
  127. Rem * Write in Fixed Length *
  128. Rem *************************
  129. Procedure FLF
  130. End Proc
  131. Rem ****************************** 
  132. Rem * Viewing keyboard Shortcuts * 
  133. Rem ****************************** 
  134. Procedure KEY2
  135. Window 4
  136. Clw 
  137. Pen 2
  138. Print "Curs U = Next Record"
  139. Print "Curs D = Previous Record"
  140. Print "     F = First Record"
  141. Print "     L = Last Record"
  142. Print "     P = Print Record"
  143. Print "     Q = Quit to main"
  144. Window 1
  145. End Proc
  146. Rem ****************************** 
  147. Rem * Selecting the Project Menu * 
  148. Rem ****************************** 
  149. PROJECT:
  150. INAC
  151. If Choice(2)=1 Then NEW : Goto 2
  152. If Choice(2)=2 Then OPEN : Goto 2
  153. If Choice(2)=3 Then DELETE : Goto 2
  154. If Choice(2)=4 Then UNLOAD : Goto 2
  155. If Choice(2)=6 Then QUIT : Goto 2
  156. Goto 2
  157. ED:
  158. INAC
  159. If Choice(2)=1 Then AREC : Goto 2
  160. If Choice(2)=2 Then MREC : Goto 2
  161. If Choice(2)=3 Then DREC : Goto 2
  162. If Choice(2)=4 Then EFD : Goto 2
  163. Goto 2
  164. OUT:
  165. INAC
  166. If Choice(2)=1 Then PAR : Goto 2
  167. If Choice(2)=2 Then VR : Goto 2
  168. Goto 2
  169. MAN:
  170. INAC
  171. If Choice(2)=1 Then Gosub 5000 : Goto 2
  172. If Choice(2)=2 Then SER : Goto 2
  173. If Choice(2)=3 Then LIF : Goto 2
  174. Goto 2
  175. UTILS:
  176. INAC
  177. If Choice(2)=1 Then VID : Goto 2
  178. If Choice(2)=2 Then Goto WOT
  179. WOT:
  180. If Choice(3)=1 Then AII : Goto 2
  181. If Choice(3)=2 Then FLF : Goto 2
  182. Rem *******************  
  183. Rem * List on a field *
  184. Rem *******************
  185. Procedure LIF
  186. Window 1
  187. Clw 
  188. Pen 2
  189. If STATUS=0 Then Print "There is no database file loaded" : PAUSE : Clw : Pop Proc
  190. Print "Are you sure you wish to list on a field(Y/N)?"
  191. QIN
  192. If Q$<>"Y" Then Clw : Pop Proc
  193. Clw 
  194. For F=1 To FIE
  195. If F>9 Then Print F;":";FS$(F)
  196. If F<10 Then Print " ";F;":";FS$(F)
  197. Next F
  198. Print 
  199. Print "Which field do you wish to list on-"
  200. LIF1:
  201. SLI[0,FIE+2,2,"",14,13,0,0]
  202. If Val(Z$)>FIE Then Locate 4,FIE+2 : Print "Not Valid" : PAUSE : Locate 4,FIE+2 : Print "         " : Pen 2 : Goto LIF1
  203. If Val(Z$)<1 Then Clw : Pop Proc
  204. CV=Val(Z$)
  205. Clw 
  206. Pen 2
  207. Print "Display to (S)creen or (P)rinter-"
  208. LIF3:
  209. SLI[0,1,1,"",14,13,0,0]
  210. Z$=Upper$(Z$)
  211. If(Z$<>"S") and(Z$<>"P") Then Locate 4,1 : Print "Not Valid" : PAUSE : Locate 4,1 : Print "         " : Pen 2 : Goto LIF3
  212. TP$=Z$
  213. Pen 2
  214. If Z$="P" Then Goto LIF5
  215. Print 
  216. Print "(P)ause or (M)ouse click between records-"
  217. LIF4:
  218. SLI[0,4,1,"",14,13,0,0]
  219. Z$=Upper$(Z$)
  220. If(Z$<>"P") and(Z$<>"M") Then Locate 4,4 : Print "Not Valid" : PAUSE : Locate 4,4 : Print "         " : Pen 2 : Goto LIF4
  221. TP2$=Z$
  222. LIF5:
  223. Print 
  224. Pen 2
  225. Print "Are you sure you want to execute(Y/N)?"
  226. Pen 14 : Print "Press ESCAPE during listing to quit"
  227. Pen 2
  228. QIN
  229. If Q$<>"Y" Then Clw : Pop Proc
  230. If TP$="P" Then Lprint "List on field - ";FS$(CV);" - Field number:";CV : Lprint 
  231. Clw 
  232. For F=1 To LOT-DELETED
  233. Z2=F
  234. For G=1 To LOT
  235. If DELETED=0 Then Goto LIF6
  236. For E=1 To 80
  237. If DEL(E)=G and G<=Z2 Then Z2=Z2+1 : Goto LIF7
  238. Next E
  239. LIF7:
  240. If G>Z2 Then Goto LIF6
  241. Next G
  242. LIF6:
  243. Get 1,Z2
  244. If TP$="S" Then Gosub LIF8
  245. If TP$="P" Then Gosub LIF9
  246. LIF10:
  247. Next F
  248. Pen 14 : Print "The listing is complete - press RETURN" : Pen 2
  249. LIF50:
  250. QIN
  251. If Q$<>Chr$(13) Then Goto LIF50
  252. Clw : Pop Proc
  253. LIF8:
  254. Print Using "#####";F;
  255. Print ":";M$(CV)
  256. Q$=Inkey$
  257. If Q$=Chr$(27) Then Clw : Pop Proc
  258. If TP2$="P" Then PAUSE
  259. If TP2$="M" Then Repeat : Until Mouse Key
  260. Return 
  261. LIF9:
  262. Lprint Using "#####";F;
  263. Lprint ":";M$(CV)
  264. Return 
  265. End Proc
  266. Rem ***********************
  267. Rem * Search The Database *
  268. Rem ***********************
  269. Procedure SER
  270. Clw : Pen 2
  271. If STATUS=0 Then Print "There is no database file loaded" : PAUSE : Clw : Pop Proc
  272. Print "Are you sure you wish to search database(Y/N)?"
  273. QIN
  274. If Q$<>"Y" Then Clw : Pop Proc
  275. Clw 
  276. For F=1 To FIE
  277. If F>9 Then Print F;":";FS$(F)
  278. If F<10 Then Print " ";F;":";FS$(F)
  279. Next F
  280. Print 
  281. Print "Which field do you wish to search on- "
  282. SER1:
  283. SLI[0,FIE+2,2,"",14,13,0,0]
  284. If Val(Z$)>FIE Then Locate 4,FIE+2 : Print "Not Valid" : PAUSE : Locate 4,FIE+2 : Print "         " : Pen 2 : Goto SER1
  285. If Val(Z$)<1 Then Clw : Pop Proc
  286. CV=Val(Z$)
  287. Print 
  288. Clw 
  289. Pen 2
  290. Print "Enter text you wish to search for-"
  291. SLI[0,1,FS(CV),"",14,13,0,0]
  292. CV$=Z$
  293. Print 
  294. Pen 2
  295. Print "Is this a (F)ull or (P)artial search-"
  296. SER2:
  297. SLI[0,4,1,"",14,13,0,0]
  298. Z$=Upper$(Z$)
  299. If(Z$<>"P") and(Z$<>"F") Then Locate 4,4 : Print "Not Valid" : PAUSE : Locate 4,4 : Print "         " : Pen 2 : Goto SER2
  300. TP$=Z$
  301. Print 
  302. Pen 2
  303. Print "View records on (S)creen or (P)rinter-"
  304. SER3:
  305. SLI[0,7,1,"",14,13,0,0]
  306. Z$=Upper$(Z$)
  307. If(Z$<>"S") and(Z$<>"P") Then Locate 4,7 : Print "Not Valid" : PAUSE : Locate 4,7 : Print "         " : Pen 2 : Goto SER3
  308. TP2$=Z$
  309. Print 
  310. Pen 2
  311. Print "Is this a (C)ase sensitive search or (I)gnore-"
  312. SER77:
  313. SLI[0,10,1,"",14,13,0,0]
  314. Z$=Upper$(Z$)
  315. If(Z$<>"C") and(Z$<>"I") Then Locate 4,10 : Print "Not Valid" : PAUSE : Locate 4,10 : Print "         " : Pen 2 : Goto SER77
  316. CS$=Z$
  317. Print 
  318. Pen 2
  319. Print "Do you wish to execute the search(Y/N)?"
  320. QIN
  321. If Q$<>"Y" Then Clw : Pop Proc
  322. Clw 
  323. If TP2$="S" Then Locate 0,(FIE*2)+4 : Print "Please Wait - Searching Database"
  324. CC=0
  325. PL=66
  326. 405 PL=PL-(FIE+4) : If PL>FIE+4 Then CC=CC+1 : Goto 405
  327. PAGE=1 : PP=1
  328. C=1
  329. SER4:
  330. If TP2$="P" Then Lprint "Search for - ";CV$;" - on Field - ";FS$(CV)
  331. For F=1 To LOT-DELETED
  332. Z2=F
  333. For G=1 To LOT
  334. If DELETED=0 Then Goto SER5
  335. For E=1 To 80
  336. If DEL(E)=G and G<=Z2 Then Z2=Z2+1 : Goto SER6
  337. Next E
  338. SER6:
  339. If G>Z2 Then Goto SER5
  340. Next G
  341. SER5:
  342. Get 1,Z2
  343. If TP$="F" Then Gosub SER7
  344. If TP$="P" Then Gosub SER8
  345. SER20:
  346. Next F
  347. Clw 
  348. Print "The search is complete!" : PAUSE : Clw 
  349. Pop Proc
  350. SER7:
  351. If(CS$="C") and(CV$=M$(CV)) Then Goto SER9
  352. If(CS$="I") and(Upper$(CV$)=Upper$(M$(CV))) Then Goto SER9
  353. Return 
  354. SER8:
  355. For I=FS(CV) To 1 Step -1
  356. If Mid$(CV$,I,1)<>" " Then I$=Mid$(CV$,1,I) : Goto SER10
  357. Next I
  358. SER10:
  359. For I=1 To FS(CV)-Len(I$)
  360. If(CS$="C") and(Mid$(M$(CV),I,Len(I$))=I$) Then Goto SER9
  361. If(CS$="I") and(Upper$(Mid$(M$(CV),I,Len(I$)))=Upper$(I$)) Then Goto SER9
  362. Next I
  363. Return 
  364. SER9:
  365. If TP2$="S" Then Goto SER12
  366. If TP2$="P" Then Goto SER11
  367. SER11:
  368. CUSTLIST2:
  369. If C=1 Then Lprint Space$(70);"PAGE: ";PAGE : Lprint String$("-",60)
  370. Lprint "Record Number:";F
  371. Lprint "==================="
  372. For O=1 To FIE
  373. Lprint FS$(O);": ";M$(O)
  374. Next O
  375. Lprint String$("-",60)
  376. If C=CC Then Lprint Chr$(12) : C=1 : PAGE=PAGE+1
  377. C=C+1
  378. Return 
  379. SER12:
  380. Locate 0,0 : Print "Record Number-"; : Pen 14 : Print F : Pen 2
  381. For W=1 To FIE
  382. Locate 0,(W*2) : If W<10 Then Print " ";W;":"; Else Print W;":";
  383. Print FS$(W)
  384. Locate 2,1+(W*2) : Pen 14 : Print M$(W) : Pen 2
  385. Next W
  386. Print 
  387. Locate 0,(FIE*2)+4 : Cline : Print "Press RETURN to continue or ESCAPE to quit"
  388. SER50:
  389. QIN
  390. If Q$=Chr$(27) Then Clw : Pop Proc
  391. If Q$<>Chr$(13) Then Goto SER50
  392. Locate 0,(FIE*2)+4 : Cline : Print "Please Wait - Searching Database"
  393. Return 
  394. End Proc
  395. Rem *********************
  396. Rem * Validate Database *
  397. Rem *********************
  398. Procedure VID
  399. Clw : Pen 2
  400. If STATUS=0 Then Print "There is no database file to be validated" : PAUSE : Clw : Pop Proc
  401. Print "Are you sure you wish to validate this database"
  402. Print "It can take a while depending on no. of records"
  403. Print "(Y/N)?" : QIN
  404. If Q$<>"Y" Then Clw : Pop Proc
  405. Open Random 2,"temp"
  406. F1=FS(1)
  407. F2=FS(2)
  408. F3=FS(3)
  409. F4=FS(4)
  410. F5=FS(5)
  411. F6=FS(6)
  412. F7=FS(7)
  413. F8=FS(8)
  414. F9=FS(9)
  415. F10=FS(10)
  416. Field 2,F1 As N$(1),F2 As N$(2),F3 As N$(3),F4 As N$(4),F5 As N$(5),F6 As N$(6),F7 As N$(7),F8 As N$(8),F9 As N$(9),F10 As N$(10)
  417. Clw 
  418. SS=1
  419. For F=1 To LOT
  420. Locate 0,0 : Print "Current record-";SS
  421. For G=1 To 80
  422. If DEL(G)=F Then Goto VA1
  423. Next G
  424. Get 1,F
  425. For O=1 To 10
  426. N$(O)=M$(O)
  427. Next O
  428. Put 2,SS
  429. SS=SS+1
  430. VA1:
  431. Next F
  432. Pen 2
  433. Close 1
  434. Close 2
  435. Kill DBF$+".DBF"
  436. Rename "temp" To DBF$+".DBF"
  437. Open Random 1,DBF$+".DBF"
  438. F1=FS(1)
  439. F2=FS(2)
  440. F3=FS(3)
  441. F4=FS(4)
  442. F5=FS(5)
  443. F6=FS(6)
  444. F7=FS(7)
  445. F8=FS(8)
  446. F9=FS(9)
  447. F10=FS(10)
  448. Field 1,F1 As M$(1),F2 As M$(2),F3 As M$(3),F4 As M$(4),F5 As M$(5),F6 As M$(6),F7 As M$(7),F8 As M$(8),F9 As M$(9),F10 As M$(10)
  449. DELETED=0
  450. For F=1 To 80
  451. DEL(F)=0
  452. Next F
  453. Open Out 2,DBF$+".IDX"
  454. O$=Mid$(Str$(FIE),2,2)
  455. OUT$=FI$+CD$+O$
  456. For F=1 To FIE
  457. O$=Mid$(Str$(FS(F)),2,2)
  458. O$=O$+Space$(3-Len(O$))
  459. OUT$=OUT$+FS$(F)+O$
  460. Next F
  461. Print #2,OUT$
  462. Print #2,Str$(DELETED)
  463. For F=1 To 80
  464. Print #2,Str$(DEL(F))
  465. Next F
  466. Close 2
  467. PAUSE
  468. Clw 
  469. LOT=SS-1
  470. End Proc
  471. Rem **************** 
  472. Rem * View Records * 
  473. Rem **************** 
  474. Procedure VR
  475. VMR=1
  476. If LOT-DELETED<1 Then Clw : Pop Proc
  477. Window 1 : Clw : Pen 2
  478. If STATUS=0 Then Print "There is no database file loaded" : PAUSE : Clw : Pop Proc
  479. Print "Are you sure you want to view records(Y/N)?"
  480. QIN
  481. If Q$<>"Y" Then Clw : Pop Proc
  482. Clw 
  483. Menu Del 
  484. KEY2
  485. MENUS2
  486. VMR=1
  487. Gosub VR3
  488. VR1:
  489. Menu On 
  490. Q$=Inkey$ : Q$=Upper$(Q$) : If Q$="" Then Goto VD9
  491. If Q$=Chr$(30) Then VMR=VMR+1 : Gosub VR3 : Goto VR1
  492. If Q$=Chr$(31) Then VMR=VMR-1 : Gosub VR3 : Goto VR1
  493. If Q$="F" Then VMR=1 : Gosub VR3 : Goto VR1
  494. If Q$="L" Then VMR=LOT-DELETED : Gosub VR3 : Goto VR1
  495. If Q$="P" Then PRIM=1 : Gosub VR3 : Goto VR1
  496. If Q$="Q" Then Menu Off : MENUS : Clw : Pen 2 : KEY1 : Pop Proc
  497. Goto VR1
  498. VD9:
  499. On Menu Goto VR2
  500. On Menu On 
  501. Goto VR1
  502. VR2:
  503. PRIM=0
  504. If Choice(2)=1 Then VMR=VMR+1 : Gosub VR3 : Goto VR1
  505. If Choice(2)=2 Then VMR=VMR-1 : Gosub VR3 : Goto VR1
  506. If Choice(2)=3 Then VMR=1 : Gosub VR3 : Goto VR1
  507. If Choice(2)=4 Then VMR=LOT-DELETED : Gosub VR3 : Goto VR1
  508. If Choice(2)=5 Then PRIM=1 : Gosub VR3 : Goto VR1
  509. If Choice(2)=6 Then Menu Off : MENUS : Clw : Pen 2 : KEY1 : Pop Proc
  510. Goto VR1
  511. VR3:
  512. If VMR>LOT-DELETED Then VMR=VMR-1
  513. If VMR<1 Then VMR=1
  514. VZ2=VMR
  515. If DELETED=0 Then Goto VR4
  516. For G=1 To LOT
  517. For E=1 To DELETED
  518. If DEL(E)=G and G<=VZ2 Then VZ2=VZ2+1 : Goto VR5
  519. Next E
  520. VR5:
  521. If G>VZ2 Then Goto VR4
  522. Next G
  523. VR4:
  524. If PRIM=1 Then Goto VR7
  525. Locate 0,0 : Pen 2 : Print "Record-"; : Pen 14 : Print VMR;"        " : Pen 2
  526. Get 1,VZ2
  527. For F=1 To FIE
  528. Pen 2 : Locate 0,F*2 : If F<9 Then Print " ";F;":"; Else Print F;":";
  529. Print FS$(F)
  530. Locate 2,(F*2)+1 : Pen 14 : Print M$(F) : Pen 2
  531. Next F
  532. Return 
  533. VR7:
  534. Lprint String$("-",60)
  535. Lprint "Record Number:";VMR
  536. Lprint "==================="
  537. For F=1 To FIE
  538. Lprint FS$(F);": ";M$(F)
  539. Next F
  540. Lprint String$("-",60)
  541. Return 
  542. End Proc
  543. Rem ***********************
  544. Rem * The second menu bar *
  545. Rem ***********************  
  546. Procedure MENUS2
  547. Menu$(1)=A$+"View Records    "+B$
  548. A$="(ss 1)" : B$="(ss 0)"
  549. Menu$(1,1)=" Next Record     "
  550. Menu$(1,2)=" Previous Record "
  551. Menu$(1,3)=" First Record    "
  552. Menu$(1,4)=" Last Record     "
  553. Menu$(1,5)=" Print Record    "
  554. Menu$(1,6)=" Quit to Main    "
  555. End Proc
  556. Rem ****************** 
  557. Rem * Delete Records * 
  558. Rem ****************** 
  559. Procedure DREC
  560. Window 1 : Clw : Pen 2
  561. If STATUS=0 Then Print "There is no database file loaded" : PAUSE : Clw : Pop Proc
  562. If DELETED=80 Then Print "Please validate file before deleting more records" : PAUSE : Clw : Pop Proc
  563. Print "Are you sure you want to delete records(Y/N)?"
  564. QIN
  565. If Q$<>"Y" Then Clw : Pop Proc
  566. 102 Clw 
  567. Pen 2
  568. Print "Please enter record number you wish to delete"
  569. 101 SLI[0,1,6,"",14,13,0,0]
  570. If Val(Z$)>LOT-DELETED Then Locate 10,1 : Print "Not Valid" : PAUSE : Locate 10,1 : Print "         " : Goto 101
  571. If Val(Z$)<1 Then Clw : Pen 2 : Pop Proc
  572. For F=1 To 10
  573. M$(F)=""
  574. Next F
  575. VZ=Val(Z$)
  576. If DELETED=0 Then Goto JMP3
  577. For G=1 To LOT
  578. For F=1 To DELETED
  579. If DEL(F)=G and G<=VZ Then VZ=VZ+1 : Goto JMP4
  580. Next F
  581. JMP4:
  582. If G>VZ Then Goto JMP3
  583. Next G
  584. JMP3:
  585. Get 1,VZ
  586. Print 
  587. For Z=1 To FIE
  588. Pen 2 : Locate 0,(Z*2)+3 : If Z<9 Then Print " ";Z;":"; Else Print Z;":";
  589. Print FS$(Z)
  590. Locate 2,(Z*2)+4 : Pen 14 : Print M$(Z) : Pen 2
  591. Next Z
  592. Print 
  593. Print "Are you sure you wish to delete this(Y/N)?"
  594. QIN
  595. If Q$<>"Y" Then Clw : Pop Proc
  596. For F=1 To FIE
  597. M$(F)=""
  598. Next F
  599. Put 1,VZ
  600. DEL(DELETED+1)=VZ
  601. DELETED=DELETED+1
  602. Z2UP
  603. Goto 102
  604. End Proc
  605. Rem ****************** 
  606. Rem * Edit File Data * 
  607. Rem ****************** 
  608. Procedure EFD
  609. Window 1 : Clw : Pen 2
  610. If STATUS=0 Then Print "There is no database file loaded" : PAUSE : Clw : Pop Proc
  611. Print "Are you sure you wish to edit file data(Y/N)?"
  612. QIN
  613. If Q$<>"Y" Then Clw : Pop Proc
  614. Clw 
  615. Print "Please enter new filenote-"
  616. SLI[0,1,45,FI$,14,13,0,0]
  617. FI$=Z$
  618. Print 
  619. Pen 2
  620. Print "Please enter creation date-"
  621. SLI[0,4,10,CD$,14,13,0,0]
  622. CD$=Z$
  623. Z2UP
  624. Window 1 : Clw 
  625. End Proc
  626. Rem *********************
  627. Rem * Print all records *
  628. Rem *********************
  629. Procedure PAR
  630. Clw : Window 1 : Pen 2
  631. CC=0
  632. PL=66
  633. If STATUS=0 Then Print "There is no database file loaded" : PAUSE : Clw : Pop Proc
  634. Print "Are you sure you wish to print(Y/N)?"
  635. QIN
  636. If Q$<>"Y" Then Clw : Pop Proc
  637. Print 
  638. Print "Press "; : Pen 14 : Print "RETURN "; : Pen 2 : Print "when ready to print"
  639. 41 QIN
  640. If Q$=Chr$(13) Then Goto 40
  641. Goto 41
  642. 40 PL=PL-(FIE+4) : If PL>FIE+4 Then CC=CC+1 : Goto 40
  643. CUSTLIST:
  644. PAGE=1 : PP=1 : Lprint Space$(70);"PAGE: ";PAGE
  645. Lprint String$("-",60)
  646. FF=1
  647. For F=1 To LOT
  648. For G=1 To DELETED
  649. If F=DEL(G) Then Goto 43
  650. Next G
  651. Get 1,F
  652. Lprint "Record Number:";FF
  653. Lprint "==================="
  654. FF=FF+1
  655. For G=1 To FIE
  656. Lprint FS$(G);": ";M$(G)
  657. Next G
  658. Lprint String$("-",60)
  659. If C=CC Then Lprint Chr$(12) : C=1 : PAGE=PAGE+1 : Lprint Space$(70);"PAGE: ";PAGE : Lprint String$("-",60) : Goto 43
  660. C=C+1
  661. 43 Next F
  662. Lprint Chr$(12)
  663. Clw 
  664. End Proc
  665. Rem *****************
  666. Rem * Amend Records *
  667. Rem *****************
  668. Procedure MREC
  669. Window 1 : Pen 2
  670. Clw 
  671. If STATUS=0 Then Print "There is no database file loaded" : PAUSE : Clw : Pop Proc
  672. Print "Are you sure you wish to amend records(Y/N)?"
  673. QIN
  674. If Q$<>"Y" Then Clw : Pop Proc
  675. 30 Clw 
  676. Pen 2
  677. Print "Please enter number of record that you wish"
  678. Print "to amend(press return to quit)- "
  679. SLI[32,1,5,"",14,13,0,0]
  680. If Val(Z$)>LOT-DELETED Then Locate 35,1 : Print "Not Valid" : PAUSE : Locate 35,1 : Print "         " : Pen 2 : Goto 30
  681. If Val(Z$)>0 Then Goto 31
  682. If Val(Z$)<1 Then Clw : Pop Proc
  683. Goto 30
  684. 31 VZ=Val(Z$) : VZ2=VZ
  685. If DELETED=0 Then Goto JMP1
  686. For G=1 To LOT
  687. For F=1 To DELETED
  688. If DEL(F)=G and G<=VZ2 Then VZ2=VZ2+1 : Goto JMP2
  689. Next F
  690. JMP2:
  691. If G>VZ2 Then Goto JMP1
  692. Next G
  693. JMP1:
  694. Clw : Pen 2 : Print "Amending Record-"; : Pen 14 : Print VZ
  695. Print 
  696. Pen 2
  697. Get 1,VZ2
  698. For F=1 To FIE
  699. Pen 2 : Locate 0,F*2 : If F<9 Then Print " ";F;":"; Else Print F;":";
  700. Print FS$(F)
  701. SLI[2,(F*2)+1,FS(F),M$(F),14,13,1,0]
  702. Next F
  703. Print 
  704. 32 Pen 2 : Locate 0,(FIE*2)+3
  705. Print "Enter a field number if you wish to change data"
  706. Print "or press return to continue-"
  707. 33 SLI[29,(FIE*2)+4,2,"",14,13,0,0]
  708. If Val(Z$)>FIE Then Locate 33,(FIE*2)+4 : Print "Not Valid" : PAUSE : Locate 33,(FIE*2)+4 : Print "         " : Goto 33
  709. If Val(Z$)<1 Then Goto 34
  710. F=Val(Z$)
  711. Pen 2
  712. SLI[2,(F*2)+1,FS(F),M$(F),14,13,0,0]
  713. M$(F)=Z$
  714. Goto 32
  715. 34 Put 1,VZ2
  716. Goto 30
  717. End Proc
  718. Rem ***************
  719. Rem * Add Records *
  720. Rem ***************
  721. Procedure AREC
  722. Clw 
  723. Pen 2
  724. Window 1
  725. If STATUS=0 Then Print "There is no database file loaded" : PAUSE : Clw : Pop Proc
  726. Print "Are you sure you wish to edit records(Y/N)?"
  727. QIN
  728. If Q$<>"Y" Then Clw : Pop Proc
  729. 20 Clw 
  730. Pen 2
  731. Print "Adding Record-"; : Pen 14 : Print LOT+1-DELETED
  732. Print 
  733. Pen 2
  734. For F=1 To FIE : C$(F)="" : Next F
  735. For F=1 To FIE
  736. Pen 2 : Locate 0,F*2 : If F<9 Then Print " ";F;":"; Else Print F;":";
  737. Print FS$(F)
  738. SLI[2,(F*2)+1,FS(F),C$(F),14,13,1,0]
  739. Next F
  740. For F=1 To FIE
  741. SLI[2,(F*2)+1,FS(F),C$(F),14,13,0,1]
  742. If ESC=1 Then Clw : Pen 2 : Pop Proc
  743. C$(F)=Z$
  744. Next F
  745. Print 
  746. Pen 2
  747. 18 Locate 0,(FIE*2)+3
  748. Pen 2
  749. Print "Enter a field number if you wish to change data"
  750. Print "or press return to continue-"
  751. 16 SLI[29,(FIE*2)+4,2,"",14,13,0,0]
  752. If Val(Z$)>FIE Then Locate 33,(FIE*2)+4 : Print "Not Valid" : PAUSE : Locate 33,(FIE*2)+4 : Print "         " : Goto 16
  753. If Val(Z$)<1 Then Goto 17
  754. Pen 2
  755. F=Val(Z$)
  756. SLI[2,(F*2)+1,FS(F),C$(F),14,13,0,0]
  757. C$(F)=Z$
  758. Goto 18
  759. 17 For F=1 To FIE
  760. M$(F)=C$(F)
  761. Next F
  762. Put 1,LOT+1
  763. LOT=LOT+1
  764. Z2UP
  765. Goto 20
  766. End Proc
  767. Rem ****************************************   
  768. Rem * The fantastic multi-line input proc! * 
  769. Rem **************************************** 
  770. Rem ********** 
  771. Rem * Delete * 
  772. Rem ********** 
  773. Procedure DELETE
  774. F$=Fsel$("","","Please select a file to","DELETE")
  775. If Mid$(F$,Len(F$),1)=":" Then Print "You can not delete a device!" : PAUSE : Clw : Pop Proc
  776. If F$="" Then Clw : Pop Proc
  777. If Exist(F$) Then Goto 14
  778. Pen 2
  779. Print "That file does not exist" : PAUSE : Clw : Pop Proc
  780. 14 Print "Are you sure you wish to delete this file(Y/N)?"
  781. Pen 14 : Print F$
  782. Pen 2
  783. QIN
  784. If Q$="Y" Then Kill F$
  785. Clw 
  786. Pop Proc
  787. End Proc
  788. Rem ******** 
  789. Rem * Quit * 
  790. Rem ******** 
  791. Procedure QUIT
  792. Window 1
  793. Clw 
  794. Pen 2
  795. If STATUS=1 Then Print "There is a database file loaded - please UnLoad" : PAUSE : Clw : Pop Proc
  796. Print "Are you sure you wish to quit(Y/N)?"
  797. QIN
  798. If Q$="Y" Then Edit 
  799. Clw 
  800. Pop Proc
  801. End Proc
  802. Rem ************************ 
  803. Rem * UnLoad database file * 
  804. Rem ************************ 
  805. Procedure UNLOAD
  806. Clw 
  807. If STATUS=0 Then Print "There is no database to UnLoad" : PAUSE : Clw : Pop Proc
  808. Print "Are you sure you wish to Unload database(Y/N)?"
  809. QIN
  810. If Q$<>"Y" Then Clw : Pop Proc
  811. Close 1
  812. Open Out 1,DBF$+".IDX"
  813. O$=Mid$(Str$(FIE),2,2)
  814. OUT$=FI$+CD$+O$
  815. For F=1 To FIE
  816. O$=Mid$(Str$(FS(F)),2,2)
  817. O$=O$+Space$(3-Len(O$))
  818. OUT$=OUT$+FS$(F)+O$
  819. Next F
  820. Print #1,OUT$
  821. Print #1,Str$(DELETED)
  822. For F=1 To 80
  823. Print #1,Str$(DEL(F))
  824. Next F
  825. Close 1
  826. FI$="" : DBF$="" : LOT=0 : FIE=0 : DEL=0
  827. For F=1 To 80 : DEL(F)=0 : Next F
  828. DELETED=0
  829. For F=1 To 10
  830. FS$(F)="" : FS(F)=1 : M$(F)="" : C$(F)=""
  831. Next F
  832. CD$=""
  833. Clw 
  834. CTT[1,"Database Editing Window"]
  835. STATUS=0
  836. CD$="          "
  837. Z2UP
  838. Window 1
  839. End Proc
  840. Rem ***********************
  841. Rem * Creating A NEW File *
  842. Rem ***********************
  843. Procedure NEW
  844. CTT[1,"Create New Database"]
  845. If STATUS>0 Then Clw : Pen 2 : Print "A file is already loaded - please unload" : PAUSE : Clw : Pop Proc
  846. Pen 2
  847. Clw 
  848. Print "Are you sure you want to create a database"
  849. Print "                                file(Y/N)?"
  850. QIN
  851. If Q$<>"Y" Then Clw : Pop Proc
  852. 3 Clw 
  853. Print "Enter path and name of a new database file."
  854. Print "(.DBF and .IDX will be added to the files)."
  855. Print "Press ESCAPE to exit creation"
  856. Pen 14
  857. Pen 2
  858. SLI[0,4,20,"Temp",14,13,0,1]
  859. If ESC=1 Then Clw : Pop Proc
  860. If Z$=Space$(20) Then Clw : Pop Proc
  861. For F=20 To 1 Step -1
  862. If Mid$(Z$,F,1)<>" " Then Z$=Mid$(Z$,1,F) : Goto 10
  863. Next F
  864. 10 Pen 2
  865. If Exist(Z$+".dbf") Then Print : Print "This file already exists. Please re-enter" : PAUSE : Clw : Goto 3
  866. DBF$=Z$
  867. CTT[1,"Creating File- "+DBF$]
  868. Print 
  869. 4 Pen 2
  870. Locate 0,6
  871. Print "Enter number of fields(max 10)"
  872. SLI[0,7,2,"",14,13,0,0]
  873. If Val(Z$)<1 Then Print : Print "You must have at least 1 field"; : PAUSE : Cline : Goto 4
  874. If Val(Z$)>10 Then Print : Print "You can not have more than 10 fields"; : PAUSE : Cline : Goto 4
  875. FIE=Val(Z$)
  876. Clw 
  877. Pen 2
  878. Print "Please enter field names and lengths"
  879. Print 
  880. Print "         Name              Length"
  881. For F=1 To FIE
  882. Pen 2
  883. Print "Field"; : Print Using " ##";F
  884. SLI[9,F+2,15,"",14,13,0,0] : FS$(F)=Z$
  885. 5 SLI[29,F+2,2,"",14,13,0,0]
  886. If Val(Z$)>99 or Val(Z$)<1 Then Locate 33,F+2 : Print "Not Valid" : PAUSE : Locate 33,F+2 : Print "         " : Goto 5
  887. FS(F)=Val(Z$)
  888. Next F
  889. Print 
  890. Pen 2
  891. 9 Locate 0,FIE+4
  892. Pen 2
  893. Print "Enter field number if you wish to change data"
  894. Print "or press return to continue-"
  895. 6 Pen 2 : SLI[29,FIE+2+3,2,"",14,13,0,0]
  896. If Val(Z$)>10 Then Locate 33,FIE+5 : Print "Not Valid" : PAUSE : Locate 33,FIE+5 : Print "         " : Goto 6
  897. If Val(Z$)<1 Then Goto 8
  898. Pen 2
  899. F=Val(Z$)
  900. SLI[9,F+2,15,FS$(F),14,13,0,0]
  901. FS$(F)=Z$
  902. 7 Pen 2 : SLI[29,F+2,2,Mid$(Str$(FS(F)),2,Len(Str$(FS(F)))-1),14,13,0,0]
  903. If Val(Z$)>99 or Val(Z$)<1 Then Locate 33,F+2 : Print "Not Valid" : PAUSE : Locate 33,F+2 : Print "         " : Goto 7
  904. Goto 9
  905. 8 Pen 2
  906. Clw 
  907. Print "Please enter filenote(if applicable)- "
  908. SLI[0,1,45,"",14,13,0,0]
  909. FI$=Z$
  910. Print 
  911. Pen 2
  912. Print "Please enter creation date-"
  913. SLI[0,4,10,"",14,13,0,0]
  914. CD$=Z$
  915. Print 
  916. Pen 2
  917. Print "Currently creating files......"
  918. Open Out 1,DBF$+".IDX"
  919. O$=Mid$(Str$(FIE),2,2)
  920. OUT$=FI$+CD$+O$
  921. For F=1 To FIE
  922. O$=Mid$(Str$(FS(F)),2,2)
  923. O$=O$+Space$(3-Len(O$))
  924. OUT$=OUT$+FS$(F)+O$
  925. Next F
  926. Print #1,OUT$
  927. Print #1,Str$(DELETED)
  928. For F=1 To 80
  929. Print #1,Str$(DEL(F))
  930. Next F
  931. Close 1
  932. Open Random 1,DBF$+".DBF"
  933. F1=FS(1)
  934. F2=FS(2)
  935. F3=FS(3)
  936. F4=FS(4)
  937. F5=FS(5)
  938. F6=FS(6)
  939. F7=FS(7)
  940. F8=FS(8)
  941. F9=FS(9)
  942. F10=FS(10)
  943. Field 1,F1 As M$(1),F2 As M$(2),F3 As M$(3),F4 As M$(4),F5 As M$(5),F6 As M$(6),F7 As M$(7),F8 As M$(8),F9 As M$(9),F10 As M$(10)
  944. D=0
  945. For F=1 To 10
  946. D=D+FS(F)
  947. Next F
  948. LOT=Lof(1)/D
  949. Pen 2
  950. Print "...Creation complete!" : PAUSE : Clw 
  951. CTT[1,"Database Editing Window"]
  952. Z2UP
  953. STATUS=1
  954. End Proc
  955. Rem *****************************  
  956. Rem * Update Second Window Data *
  957. Rem *****************************
  958. Procedure Z2UP
  959. Window 3
  960. Pen 2
  961. Clw 
  962. Locate 0,0
  963. Print "Current Loaded path+file-"
  964. Pen 15 : Print Mid$(DBF$+".DBF",1,25)
  965. Pen 2
  966. Print "Creation Date- "; : Pen 15 : Print CD$ : Pen 2
  967. Print "Number of fields- "; : Pen 15 : Print FIE : Pen 2
  968. Print "Number of records-"; : Pen 15 : Print LOT-DELETED : Pen 2
  969. Window 1
  970. End Proc
  971. Rem ***********************
  972. Rem * Opening An Old File *
  973. Rem ***********************
  974. Procedure OPEN
  975. Pen 2
  976. Clw 
  977. If STATUS=1 Then Print "A file is already loaded - please UnLoad" : PAUSE : Clw : Pop Proc
  978. Print "Are you sure you wish to open a database(Y/N)?"
  979. QIN
  980. If Q$<>"Y" Then Clw : Pop Proc
  981. F$=Fsel$(PTH$+"*.DBF","","Load a database file","File must end in .DBF")
  982. If F$="" Then Clw : Pop Proc
  983. If Upper$(Mid$(F$,Len(F$)-3,4))<>".DBF" Then Print : Print "Sorry, this is not a database" : PAUSE : Clw : Pop Proc
  984. If Exist(F$) Then Goto 11 Else Print : Print "This file does not exist" : PAUSE : Clw : Pop Proc
  985. 11 Print 
  986. Print "Loading database files..."
  987. DBF$=Mid$(F$,1,Len(F$)-4)
  988. Open In 1,DBF$+".IDX"
  989. CTT[1,"Loaded Database: "+DBF$]
  990. X$=Input$(1,56)
  991. FI$=Mid$(X$,1,45)
  992. CD$=Mid$(X$,46,10)
  993. FIE=Val(Mid$(X$,55,2))
  994. X$=Input$(1,18*FIE)
  995. S=1
  996. For F=1 To 18*FIE Step 18
  997. FS$(S)=Mid$(X$,F,15)
  998. FS(S)=Val(Mid$(X$,F+15,2))
  999. S=S+1
  1000. Next F
  1001. Input #1,DEL$
  1002. DELETED=Val(DEL$)
  1003. Input #1,DEL$
  1004. DELETED=Val(DEL$)
  1005. For F=1 To 80
  1006. Input #1,DEL$
  1007. DEL(F)=Val(DEL$)
  1008. Next F
  1009. Close 1
  1010. Open Random 1,DBF$+".DBF"
  1011. F1=FS(1)
  1012. F2=FS(2)
  1013. F3=FS(3)
  1014. F4=FS(4)
  1015. F5=FS(5)
  1016. F6=FS(6)
  1017. F7=FS(7)
  1018. F8=FS(8)
  1019. F9=FS(9)
  1020. F10=FS(10)
  1021. Field 1,F1 As M$(1),F2 As M$(2),F3 As M$(3),F4 As M$(4),F5 As M$(5),F6 As M$(6),F7 As M$(7),F8 As M$(8),F9 As M$(9),F10 As M$(10)
  1022. D=0
  1023. For F=1 To 10
  1024. D=D+FS(F)
  1025. Next F
  1026. LOT=Lof(1)/D
  1027. Z2UP
  1028. Window 1
  1029. Print "...Loading Complete!"
  1030. PAUSE
  1031. Clw 
  1032. STATUS=1
  1033. End Proc
  1034. Rem ***************************  
  1035. Rem * Opening All The Windows *  
  1036. Rem ***************************
  1037. Procedure WO[A1$,A2$,A3$,A4$]
  1038. Curs Off 
  1039. Colour 15,$222
  1040. Colour 14,$222
  1041. Colour 1,$222
  1042. Colour 2,$222
  1043. Wind Open 1,0,5,50,30,1
  1044. Curs Off 
  1045. Border ,0,14
  1046. Title Top A1$
  1047. Wind Open 3,400,5,28,10,1
  1048. Curs Off 
  1049. Border ,0,14
  1050. Title Top A3$
  1051. Wind Open 4,400,85,28,20,1
  1052. Curs Off 
  1053. Border ,0,14
  1054. Title Top A4$
  1055. Get Disc Fonts 
  1056. Set Font 1
  1057. Colour 15,$F0
  1058. Colour 14,$0
  1059. Colour 2,$555
  1060. End Proc
  1061. Rem ************************ 
  1062. Rem * Setting Up The Menus * 
  1063. Rem ************************ 
  1064. Procedure MENUS
  1065. X=7
  1066. A$="(ss 2)" : B$="(ss 0)"
  1067. Menu$(1)=A$+"Project    "
  1068. Menu$(1,1)=B$+" New     "
  1069. Menu$(1,2)=" Open    "
  1070. Menu$(1,3)=" Delete  "
  1071. Menu$(1,4)=" UnLoad  "
  1072. Menu$(1,5)=" ------- " : Menu Inactive(1,5)
  1073. Menu$(1,7)=" About   "
  1074. Menu$(1,6)=" Quit    "
  1075. Menu$(1,X,1)="(ss 1) BOMBASE version 1.0 " : Menu Inactive(1,X,1)
  1076. Menu$(1,X,2)="(ss 0)                     " : Menu Inactive(1,X,2)
  1077. Menu$(1,X,3)="(ss 2) by Gareth Lancaster(ss 0) " : Menu Inactive(1,X,3)
  1078. Menu$(1,X,4)=" Contact me at;      " : Menu Inactive(1,X,4)
  1079. Menu$(1,X,5)=" 40, Appleby Gardens," : Menu Inactive(1,X,5)
  1080. Menu$(1,X,6)=" Dunstable, Beds," : Menu Inactive(1,X,6)
  1081. Menu$(1,X,7)=" LU6 3DB." : Menu Inactive(1,X,7)
  1082. Menu$(1,X,8)=" TEL:0582 666680" : Menu Inactive(1,X,8)
  1083. Menu$(1,X,9)=" -------------------" : Menu Inactive(1,X,9)
  1084. Menu$(1,X,10)=" Made with: AMOS1.21 " : Menu Inactive(1,X,10)
  1085. Menu$(2)=A$+"Edit    "
  1086. Menu$(2,1)=B$+" Add Records    "
  1087. Menu$(2,2)=" Amend Records  "
  1088. Menu$(2,3)=" Delete Records "
  1089. Menu$(2,4)=" Edit File Data "
  1090. Menu$(3)=A$+"Output    "
  1091. Menu$(3,1)=B$+" Print all records "
  1092. Menu$(3,2)=" View Records      "
  1093. Menu$(4)=A$+"Manipulate    "
  1094. Menu$(4,1)=B$+" Sort records    "
  1095. Menu$(4,2)=" Search database "
  1096. Menu$(4,3)=" List on field   "
  1097. Menu$(5)=A$+"Utilities    "+B$
  1098. Menu$(5,1)=" Validate   "
  1099. Rem Menu$(5,2)=" Write data "
  1100. Rem Menu$(5,2,1)=" Ascii Format "  
  1101. Rem Menu$(5,2,2)=" Fixed Length "
  1102. Menu On 
  1103. End Proc
  1104. Rem ******************************************** 
  1105. Rem * The all important single line input proc * 
  1106. Rem ******************************************** 
  1107. Procedure SLI[XPOS,YPOS,LG,X$,BIRO,CARD,DUMMY,ESCEN]
  1108. If Len(X$)<LG Then X$=X$+Space$(LG-Len(X$))
  1109. If Len(X$)>LG Then X$=Mid$(X$,1,LG)
  1110. Z$=X$
  1111. X=XPOS : Y=YPOS : XX=0 : ESC=0 : Pen BIRO : Paper CARD
  1112. Locate X,Y : Print Z$; : Locate X+XX,Y
  1113. If DUMMY=1 Then Paper 0 : Pen 1 : Print : Pop Proc
  1114. Curs On 
  1115. LOPK:
  1116. Q$=Inkey$ : If Q$="" Then Goto LOPK
  1117. If Q$=Chr$(27) and ESCEN=1 Then ESC=1 : Paper 0 : Ink 1 : Print : Curs Off : Pop Proc
  1118. If Q$=Chr$(27) Then Goto LOPK
  1119. If Q$=Chr$(13) Then Paper 0 : Ink 1 : Print : Curs Off : Pop Proc
  1120. If Q$=Chr$(8) and XX>0 Then XX=XX-1 : Locate X+XX,Y : Print " "; : Locate X+XX,Y : Mid$(Z$,XX+1,1)=" " : Goto LOPK
  1121. If Q$=Chr$(8) Then Goto LOPK
  1122. If Q$=Chr$(29) and XX>0 Then XX=XX-1 : Locate X+XX,Y : Goto LOPK
  1123. If Q$=Chr$(29) Then Goto LOPK
  1124. If Q$=Chr$(28) and XX<LG Then XX=XX+1 : Locate X+XX,Y : If XX=LG Then Locate X+XX-1,Y : Goto LOPK
  1125. If Q$=Chr$(28) Then Goto LOPK
  1126. If XX<LG Then Locate X+XX,Y : Print Q$; : Mid$(Z$,XX+1,1)=Q$ : XX=XX+1 : Locate X+XX,Y : If XX=LG Then Locate X+XX-1,Y : Goto LOPK
  1127. Goto LOPK
  1128. End Proc
  1129. Rem ************************ 
  1130. Rem * Inactivate the menus * 
  1131. Rem ************************ 
  1132. Procedure INAC
  1133. Menu Inactive(1)
  1134. End Proc
  1135. Rem *********************************  
  1136. Rem * Changing a window's top title *
  1137. Rem *********************************
  1138. Procedure CTT[P,S$]
  1139. Curs Off 
  1140. Window P
  1141. Title Top S$
  1142. End Proc
  1143. Rem ***************************  
  1144. Rem * Testing Q$ for an input *
  1145. Rem ***************************
  1146. Procedure QIN
  1147. 1 Q$=Inkey$
  1148. If Q$="" Then Goto 1
  1149. Q$=Upper$(Q$)
  1150. End Proc
  1151. Rem *****************************  
  1152. Rem * Activate The Menu's again *
  1153. Rem *****************************
  1154. Procedure AC
  1155. Menu Active(1)
  1156. End Proc
  1157. Rem ****************************** 
  1158. Rem * Setting up all the colours * 
  1159. Rem ****************************** 
  1160. Procedure CS
  1161. Colour 0,$222
  1162. Colour 2,$555
  1163. Colour 15,$F0
  1164. Colour 14,$0
  1165. Colour 13,$730
  1166. End Proc
  1167. Rem *********************************  
  1168. Rem * Stall the show for a while... *
  1169. Rem *********************************
  1170. Procedure PAUSE
  1171. Wait 50
  1172. End Proc
  1173. Rem ********************** 
  1174. Rem * The insertion sort * 
  1175. Rem ********************** 
  1176. 5000 Window 1 : Clw : Pen 2
  1177. If STATUS=0 Then Print "There is no database file to sort" : PAUSE : Clw : Return 
  1178. Print "Are you sure you wish to sort database(Y/N)?"
  1179. QIN
  1180. If Q$<>"Y" Then Clw : Return 
  1181. Print : Print "Sort on which field-"
  1182. 5010 SLI[21,2,2,"",14,13,0,0]
  1183. If Val(Z$)>FIE Then Locate 24,2 : Print " Not Valid " : PAUSE : Locate 24,2 : Print "         " : Goto 5010
  1184. If Val(Z$)<1 Then Clw : Pen 2 : Return 
  1185. JJJ=Val(Z$)
  1186. Pen 2
  1187. Clw : Print "Sorting Database!"
  1188. 6000 For I=1 To LOT-1
  1189. 6010 Gosub 7000
  1190. 6020 For J=I To 1 Step -1
  1191. 6030 Get 1,J : Gosub 9000 : If K$(JJJ)>=N$(JJJ) Then 6070
  1192. 6040 Gosub 8000
  1193. 6050 Next J
  1194. 6060 J=0
  1195. 6070 Gosub 9050
  1196. 6080 Next I : Print : Print "Database is now sorted" : PAUSE : Clw : Goto 10000
  1197. 7000 Get 1,I+1
  1198. 7010 For F=1 To 10 : K$(F)=M$(F)
  1199. 7020 Next F
  1200. 7030 Return 
  1201. 8000 For F=1 To 10 : M$(F)=N$(F) : Next F
  1202. 8010 Put 1,J+1
  1203. 8020 Return 
  1204. 9000 For F=1 To 10 : N$(F)=M$(F)
  1205. 9010 Next F
  1206. 9020 Return 
  1207. 9050 For F=1 To 10 : M$(F)=K$(F)
  1208. 9060 Next F : Put 1,J+1
  1209. 9070 Return 
  1210. 10000 If DELETED<1 Then Return 
  1211. 10010 For F=1 To DELETED
  1212. 10020 DEL(F)=F
  1213. 10030 Next F
  1214. 10040 Return