home *** CD-ROM | disk | FTP | other *** search
/ Boston 2 / boston-2.iso / DOS / PROGRAM / BASIC / PROGEN / PROSRC.ZIP / PROCAS71.BAS < prev    next >
Encoding:
BASIC Source File  |  1991-10-08  |  12.0 KB  |  326 lines
  1. DEFINT A-Z
  2. COMMON SHARED masterFile$, numberoffields, ff, progfile$, startp
  3. '$DYNAMIC
  4. '$INCLUDE: 'PROLIB71.BI'
  5.  
  6. REM $STATIC
  7. '
  8. SUB PROSRC.CASE.1
  9.  
  10. PRINT #ff, "         CASE 1  'Insert a new record"
  11. PRINT #ff, "            mainscreen"
  12. PRINT #ff, "            GOSUB InitRecField ' set all fields to null"
  13. PRINT #ff, "            GOSUB getfieldinfo ' get new record info"
  14. PRINT #ff, ""
  15.  
  16. END SUB
  17.  
  18. SUB PROSRC.CASE.2.1
  19.  
  20. PRINT #ff, "         CASE 2  'Browse through Records"
  21. PRINT #ff, "            mainscreen"
  22. PRINT #ff, "            Imopt = 1"
  23. PRINT #ff, ""
  24. PRINT #ff, "            DO"
  25. PRINT #ff, "                IF ISMstatus(keyindex) = 0 THEN"
  26. PRINT #ff, "                  msg.nodata"
  27. PRINT #ff, "                  EXIT DO"
  28. PRINT #ff, "               END IF"
  29. PRINT #ff, ""
  30. END SUB
  31.  
  32. SUB PROSRC.CASE.2.2
  33.  
  34. PRINT #ff, "               MOVEFIRST keyindex"
  35. PRINT #ff, ""
  36. PRINT #ff, "               BrowseIrec nameofindex$, keyindex, Exitcode"
  37. PRINT #ff, ""
  38. PRINT #ff, "               IF Exitcode = 0 THEN"
  39. PRINT #ff, "                  msg.nodata"
  40. PRINT #ff, "                  EXIT DO"
  41. PRINT #ff, "               END IF"
  42. PRINT #ff, ""
  43. PRINT #ff, "               IF Exitcode = 1 THEN"
  44. PRINT #ff, "                  EXIT DO"
  45. PRINT #ff, "               END IF"
  46. PRINT #ff, ""
  47. PRINT #ff, "               WHILE Exitcode = 2"
  48. PRINT #ff, ""
  49. PRINT #ff, "                  RETRIEVE keyindex, RecField"
  50. PRINT #ff, ""
  51. PRINT #ff, "                  CALL " + progfile$ + ".scn1"
  52. PRINT #ff, "                  CALL " + progfile$ + ".info" + LTRIM$(STR$((sc \ 18) + 1))
  53. PRINT #ff, "                  LOCATE 21, 2"
  54. PRINT #ff, ""
  55. PRINT #ff, "                   CenterText " + CHR$(34) + "                                                          " + CHR$(34) + ", 21, fg, bg"
  56. PRINT #ff, "                   CenterText " + CHR$(34) + "Index in use: " + CHR$(34) + " + GETINDEX$(keyindex), 21, fg, bg"
  57. PRINT #ff, ""
  58. PRINT #ff, "                  BO$ = " + CHR$(34) + "           Next        Prev        Search         Edit        Menu          " + CHR$(34)
  59. PRINT #ff, ""
  60. PRINT #ff, "                  Imopt = MenuBar(25, 3, BO$, BLACK, WHITE, RED, Imopt)"
  61. PRINT #ff, ""
  62. PRINT #ff, "                  IF Imopt = 3 THEN"
  63. PRINT #ff, "                       Exitcode = 0"
  64. PRINT #ff, "                  END IF"
  65. PRINT #ff, ""
  66. PRINT #ff, "                  IF Imopt = 4 THEN"
  67. PRINT #ff, "                     mopt = 2"
  68. PRINT #ff, "                     GOSUB getfieldinfo"
  69. PRINT #ff, "                  END IF"
  70. PRINT #ff, ""
  71. PRINT #ff, "                  IF Imopt = 5 THEN"
  72. PRINT #ff, "                     EXIT DO"
  73. PRINT #ff, "                  END IF"
  74. PRINT #ff, ""
  75. PRINT #ff, "                  IF Imopt = 1 THEN"
  76. PRINT #ff, "                     MOVENEXT keyindex "
  77. PRINT #ff, "                    pnc " + CHR$(34) + "░░░░░░░░░░░░░░░░░░░░░░" + CHR$(34) + ", 24, 11, fg, bg"
  78. PRINT #ff, ""
  79. PRINT #ff, "                  IF EOF(keyindex) THEN"
  80. PRINT #ff, "                    MOVELAST keyindex"
  81. PRINT #ff, "                    pnc " + CHR$(34) + "** At Last record **" + CHR$(34) + ", 24, 11, fg + 8, bg"
  82. PRINT #ff, ""
  83. PRINT #ff, "                  END IF"
  84. PRINT #ff, ""
  85. PRINT #ff, "                  END IF"
  86. PRINT #ff, ""
  87. PRINT #ff, "                  IF Imopt = 2 THEN"
  88. PRINT #ff, ""
  89. PRINT #ff, "                     MOVEPREVIOUS keyindex "
  90. PRINT #ff, "                    pnc " + CHR$(34) + "░░░░░░░░░░░░░░░░░░░░░░" + CHR$(34) + ", 24, 11, fg, bg"
  91. PRINT #ff, ""
  92. PRINT #ff, "                     IF BOF(keyindex) THEN"
  93. PRINT #ff, "                     MOVEFIRST keyindex"
  94. PRINT #ff, "                     pnc " + CHR$(34) + "** At First record **" + CHR$(34) + ", 24, 11, fg + 8, bg"
  95. PRINT #ff, "                  END IF"
  96. PRINT #ff, "                  END IF"
  97. PRINT #ff, ""
  98. PRINT #ff, "                  RETRIEVE keyindex, RecField"
  99. PRINT #ff, ""
  100. PRINT #ff, "               WEND"
  101. PRINT #ff, "            LOOP"
  102.  
  103. END SUB
  104.  
  105. SUB PROSRC.CASE.3.1
  106. PRINT #ff, "         CASE 3  'Print all selected records"
  107. PRINT #ff, "               DO"
  108. PRINT #ff, ""
  109. PRINT #ff, "                IF ISMstatus(keyindex) = 0 THEN"
  110. PRINT #ff, "                  msg.nodata"
  111. PRINT #ff, "                  EXIT DO"
  112. PRINT #ff, "                END IF"
  113. PRINT #ff, ""
  114.  
  115. '3.2
  116.  
  117.  
  118. END SUB
  119.  
  120. SUB PROSRC.CASE.3.3
  121. PRINT #ff, ""
  122. PRINT #ff, "            DispLine$(1) = " + CHR$(34) + "Enter Starting Rec " + CHR$(34)
  123. PRINT #ff, "            DispLine$(2) = " + CHR$(34) + "Enter for all" + CHR$(34)
  124. PRINT #ff, ""
  125. PRINT #ff, "            ans$ = " + CHR$(34) + "" + CHR$(34)
  126. PRINT #ff, ""
  127. PRINT #ff, "            DialogBox DispLine$(), 1, 1, nl, BLACK, WHITE, BLACK, WHITE, 1, ans$," + CHR$(34) + CHR$(34) + ", Exk"
  128. PRINT #ff, "            key$ = ans$"
  129. PRINT #ff, "            DispLine$(1) = " + CHR$(34) + "Print to Display or Printer" + CHR$(34)
  130. PRINT #ff, "            Ques$ = " + CHR$(34) + "(D/P)" + CHR$(34)
  131. PRINT #ff, "            answ$ = " + CHR$(34) + "DdPp" + CHR$(34)
  132. PRINT #ff, "            AskQuestion DispLine$(), 1, 1, 1, BLACK, WHITE, BLACK, WHITE, Ques$, answ$"
  133. PRINT #ff, ""
  134. PRINT #ff, "            IF UCASE$(answ$) = " + CHR$(34) + "D" + CHR$(34) + " THEN"
  135. PRINT #ff, "               output$ = " + CHR$(34) + "CONS:" + CHR$(34)
  136. PRINT #ff, "               CLS"
  137. PRINT #ff, "            ELSE"
  138. PRINT #ff, "               output$ = " + CHR$(34) + "LPT1:" + CHR$(34)
  139. PRINT #ff, "               IF CheckPrinter <> 1 THEN EXIT DO"
  140. PRINT #ff, "            END IF"
  141. PRINT #ff, ""
  142. PRINT #ff, "            prt = FREEFILE"
  143. PRINT #ff, ""
  144. PRINT #ff, "            OPEN output$ FOR OUTPUT AS #prt"
  145. PRINT #ff, "            WIDTH #prt, 80"
  146. PRINT #ff, "            'Print the DB in sequence"
  147. PRINT #ff, ""
  148. PRINT #ff, "            IF key$ = " + CHR$(34) + CHR$(34) + " THEN"
  149. PRINT #ff, "            ISM " + CHR$(34) + "F" + CHR$(34) + ", keyindex, indexrec"
  150. PRINT #ff, "            ELSE"
  151. PRINT #ff, "            ISM " + CHR$(34) + "EQ" + CHR$(34) + ", keyindex, indexrec"
  152. PRINT #ff, "            END IF"
  153. PRINT #ff, ""
  154. PRINT #ff, "            IF indexrec THEN"
  155. PRINT #ff, ""
  156. PRINT #ff, "               RETRIEVE keyindex, RecField"
  157.  
  158. END SUB
  159.  
  160. SUB PROSRC.CASE.3.4
  161. PRINT #ff, ""
  162. PRINT #ff, "               IF output$ = " + CHR$(34) + "LPT1:" + CHR$(34) + " THEN"
  163. PRINT #ff, "                  PRINT #prt, LP$"
  164. PRINT #ff, "                ELSE"
  165. PRINT #ff, "                  PRINT #prt, LEFT$(LP$,79)"
  166. PRINT #ff, "                END IF"
  167. PRINT #ff, ""
  168. PRINT #ff, "               DO WHILE indexrec"
  169. PRINT #ff, ""
  170. PRINT #ff, "                  ISM " + CHR$(34) + "N" + CHR$(34) + ", keyindex, indexrec"
  171. PRINT #ff, "                  IF indexrec = 1 THEN"
  172. PRINT #ff, "                  RETRIEVE keyindex, RecField"
  173. PRINT #ff, ""
  174.  
  175. END SUB
  176.  
  177. SUB PROSRC.CASE.3.5
  178. PRINT #ff, "               IF output$ = " + CHR$(34) + "LPT1:" + CHR$(34) + " THEN"
  179. PRINT #ff, "                  PRINT #prt, LP$"
  180. PRINT #ff, "                ELSE"
  181. PRINT #ff, "                  PRINT #prt, LEFT$(LP$,79)"
  182. PRINT #ff, "                END IF"
  183. PRINT #ff, "               ENDIF"
  184. PRINT #ff, "               LOOP"
  185. PRINT #ff, ""
  186. PRINT #ff, "               IF output$ = " + CHR$(34) + "LPT1:" + CHR$(34) + " THEN"
  187. PRINT #ff, "                  PRINT #prt, CHR$(12)"
  188. PRINT #ff, "               ELSE"
  189. PRINT #ff, "                  waitkey 24, fg, bg"
  190. PRINT #ff, "               END IF"
  191. PRINT #ff, "               CLOSE #prt"
  192. PRINT #ff, "            END IF"
  193. PRINT #ff, ""
  194. PRINT #ff, "            EXIT DO"
  195. PRINT #ff, "            LOOP"
  196. PRINT #ff, ""
  197.  
  198. END SUB
  199.  
  200. SUB PROSRC.CASE.4.1
  201.  
  202. PRINT #ff, "         CASE 4  'Delete a record"
  203. PRINT #ff, ""
  204. PRINT #ff, "            DO"
  205. PRINT #ff, "                IF ISMstatus(keyindex) = 0 THEN"
  206. PRINT #ff, "                  msg.nodata"
  207. PRINT #ff, "                  EXIT DO"
  208. PRINT #ff, "               END IF"
  209. PRINT #ff, ""
  210. PRINT #ff, ""
  211.  
  212. END SUB
  213.  
  214. SUB PROSRC.CASE.4.2
  215.  
  216. PRINT #ff, "               BrowseIrec nameofindex$, keyindex, Exitcode"
  217. PRINT #ff, ""
  218. PRINT #ff, "               IF Exitcode = 0 THEN  'Index is Empty"
  219. PRINT #ff, "                  msg.nodata"
  220. PRINT #ff, "                  EXIT DO"
  221. PRINT #ff, "               END IF"
  222. PRINT #ff, ""
  223. PRINT #ff, "                     RETRIEVE keyindex, RecField"
  224. PRINT #ff, "                     'display the details"
  225. PRINT #ff, "                     CALL " + progfile$ + ".scn1'" + LTRIM$(STR$(NS))
  226. PRINT #ff, "                     CALL " + progfile$ + ".info" + LTRIM$(STR$((sc \ 18) + 1))
  227. PRINT #ff, ""
  228. PRINT #ff, "                     DispLine$(1) = " + CHR$(34) + "YES, go ahead and delete displayed record   : " + CHR$(34) + "+KEY$"
  229. PRINT #ff, "                     DispLine$(2) = " + CHR$(34) + "NO, I don't want to delete displayed record : " + CHR$(34) + "+KEY$"
  230. PRINT #ff, ""
  231. PRINT #ff, "                     Imopt = 1"
  232. PRINT #ff, "                     Ques$ = " + CHR$(34) + "(Y/N)" + CHR$(34)
  233. PRINT #ff, "                     answ$ = " + CHR$(34) + "YyNn" + CHR$(34)
  234. PRINT #ff, ""
  235. PRINT #ff, "                     AskQuestion DispLine$(), 2, 1, 2, BLACK, WHITE, BLACK, WHITE, Ques$, answ$"
  236. PRINT #ff, ""
  237. PRINT #ff, "                     IF UCASE$(answ$) = " + CHR$(34) + "Y" + CHR$(34) + " THEN"
  238. PRINT #ff, ""
  239. PRINT #ff, "                        GOSUB InitRecField  'Initialize NAME"
  240. PRINT #ff, "                        DELETE keyindex"
  241. PRINT #ff, ""
  242. PRINT #ff, "                     END IF"
  243. PRINT #ff, "                     EXIT DO"
  244. PRINT #ff, "            LOOP"
  245. PRINT #ff, ""
  246.  
  247. END SUB
  248.  
  249. SUB PROSRC.CASE.5.0
  250. PRINT #ff, "         CASE 5  '!!! DELETE ALL DATA AND KEY FILES !!!"
  251. PRINT #ff, ""
  252. PRINT #ff, "            DrawBox 21, 22, 40, 3, 2, BLACK, WHITE, 1, BLACK, WHITE, 1"
  253. PRINT #ff, ""
  254. PRINT #ff, "            CenterText " + CHR$(34) + "Select File to Delete " + CHR$(34) + ", 22, BLACK, WHITE"
  255. PRINT #ff, "            MsgLine " + CHR$(34) + "Press   for last  for next  ENTER to select" + CHR$(34) + ", 25, 0, 7"
  256. PRINT #ff, ""
  257. PRINT #ff, "            MFILE$ = SelFiles$(" + CHR$(34) + "*.DBF" + CHR$(34) + ")"
  258. PRINT #ff, ""
  259. PRINT #ff, "            trim MFILE$"
  260. PRINT #ff, "            masterfile$ = MFILE$"
  261. PRINT #ff, ""
  262. PRINT #ff, "            IF MFILE$ <> " + CHR$(34) + "" + CHR$(34) + " THEN"
  263. PRINT #ff, "               DispLine$(1) = " + CHR$(34) + "Delete " + CHR$(34) + "+ MFILE$ +" + CHR$(34) + ", Are You Sure ?" + CHR$(34)
  264. PRINT #ff, "               DispLine$(2) = " + CHR$(34) + "Yes to erase" + CHR$(34) + "+ MFILE$"
  265. PRINT #ff, "               Ques$ = " + CHR$(34) + "(Y/N)" + CHR$(34)
  266. PRINT #ff, "               ans$ = " + CHR$(34) + "YyNn" + CHR$(34)
  267. PRINT #ff, ""
  268. PRINT #ff, "               AskQuestion DispLine$(), 2, 1, 1, BLACK, WHITE, BLACK, WHITE, Ques$, ans$"
  269. PRINT #ff, ""
  270. PRINT #ff, "               IF UCASE$(ans$) = " + CHR$(34) + "Y" + CHR$(34) + " THEN"
  271. PRINT #ff, "                 CLOSE"
  272. PRINT #ff, ""
  273. PRINT #ff, "                  delimit = INSTR(masterfile$, " + CHR$(34) + "." + CHR$(34) + ")"
  274. PRINT #ff, ""
  275. PRINT #ff, "                  IF delimit THEN"
  276. PRINT #ff, "                  dfile$ = LEFT$(masterfile$, delimit - 1)"
  277. PRINT #ff, "                  ELSE"
  278. PRINT #ff, "                  dfile$ = masterfile$"
  279. PRINT #ff, "                  END IF"
  280. PRINT #ff, ""
  281. PRINT #ff, "                  KILL dfile$ + " + CHR$(34) + ".DBF" + CHR$(34)
  282. PRINT #ff, ""
  283. PRINT #ff, "                  GOTO NEWFILE"
  284. PRINT #ff, ""
  285. PRINT #ff, "               END IF"
  286. PRINT #ff, "            END IF"
  287. PRINT #ff, ""
  288.  
  289. END SUB
  290.  
  291. SUB PROSRC.CASE.6
  292.  
  293. PRINT #ff, "         CASE 6 ' display equipment "
  294. PRINT #ff, ""
  295. PRINT #ff, "            DspEquipment"
  296. PRINT #ff, ""
  297.  
  298. END SUB
  299.  
  300. SUB PROSRC.CASE.7.1
  301.  
  302. PRINT #ff, "         CASE 7  'QUIT exit to dos"
  303. PRINT #ff, ""
  304.  
  305.  
  306. END SUB
  307.  
  308. SUB PROSRC.CASE.7.2
  309.  
  310. PRINT #ff, ""
  311. PRINT #ff, "            CLOSE"
  312. PRINT #ff, "            EXIT DO"
  313. PRINT #ff, ""
  314. PRINT #ff, "         CASE 99"
  315. PRINT #ff, "         CASE ELSE"
  316. PRINT #ff, "      END SELECT"
  317. PRINT #ff, "   LOOP"
  318. PRINT #ff, ""
  319. PRINT #ff, "   LOCATE 23, 1"
  320. PRINT #ff, "   COLOR white, black"
  321. PRINT #ff, "   CLS"
  322. PRINT #ff, "   END  'End of program"
  323.  
  324. END SUB
  325.  
  326.