home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / DBMS9105.ZIP / NEBEL3.MAY < prev   
Encoding:
Text File  |  1991-03-22  |  9.8 KB  |  307 lines
  1.  
  2. 16   * =========== Procedures Section of BOOKS.PRG ============== 
  3. 17   * ===== Routine to Check for and Correct BOF Condition ===== 
  4. 18   PROCEDURE bofcheck
  5. 19    * ----- trap for beginning of file first -----
  6. 20   IF BOF()
  7. 21      * ----- need two step skip to reposition with bof -----
  8. 22      SKIP 1
  9. 23      SKIP - 1
  10. 24   ENDIF
  11. 25    * ----- next trap for movement back past current group --
  12. 26   DO WHILE .NOT. EOF() .AND. .NOT. &mv_cond
  13. 27      SKIP
  14. 28   ENDDO
  15. 29   * ---
  16. 30   RETURN
  17. 31    
  18. 32   * =========== Routine to Center Text to Screen =============
  19. 33
  20. 34   
  21. 35   PROCEDURE centersc
  22. 35    
  23. 36   PARAMETERS mv_text
  24. 37   * -----
  25. 38   ? SPACE((80 - (LEN(TRIM(mv_text))))/2) + TRIM(mv_text) 
  26. 39   * ----
  27. 40   RETURN
  28. 41   
  29. 42   * ================== Routine to Draw Box ==================== 
  30. 43
  31. 44   
  32. 45   PROCEDURE draw_box
  33. 46    
  34. 47   PARAMETERS mv_left,mv_upper,mv_lower,mv_color
  35. 48   * ----- call routine to set color -----
  36. 49   DO setcolor WITH mv_color
  37. 50   * ----- draw box per dimension parameters -----
  38. 51   @mv_upper, mv_left TO mv_lower, 80 - mv_left - 1
  39. 52   * ----- call routine to set color to original -----
  40. 53   DO setcolor WITH "original"
  41. 54   * ----
  42. 55   RETURN
  43. 56    
  44. 57   * ====== Routine to Wait for An Operator Keystroke ========= 
  45. 58
  46. 59   PROCEDURE key_wait
  47. 60    
  48. 61   * ----- clear keyboard buffer -----
  49. 62   CLEAR TYPEAHEAD
  50. 63   mv_key = 0
  51. 64   * ----- enter loop to wait for keystroke -----
  52. 65   DO WHILE mv_key = 0
  53. 66      mv_key = INKEY()
  54. 67   ENDDO
  55. 68   * ----- flip key to uppercase if lowercase alpha -----
  56. 69   IF mv_key >= 97 .AND. mv_key <= 122
  57. 70      mv_key = mv_key - 32
  58. 71   ENDIF
  59. 72   * ----
  60. 73   RETURN
  61. 74    
  62. 75   * == Routine for Arrow Moves in Selection Lists == 
  63. 76    
  64. 77   PROCEDURE listarrw
  65. 78  
  66. 79   IF mv_key = 24
  67. 80      IF mv_on_scrn > 1
  68. 81         * ----- down arrow skip -----
  69. 82         SKIP - mv_on_scrn + 1
  70. 83      ELSE
  71. 84         SKIP - 1
  72. 85      ENDIF
  73. 86   ELSE
  74. 87      * ----- up arrow skip -----
  75. 88      SKIP - mv_on_scrn - 1
  76. 89   ENDIF
  77. 90   * ----- call routine for beginning of file check -----
  78. 91   DO bofcheck
  79. 92   * ----
  80. 93   RETURN
  81. 94  
  82. 95   * ======== Routine to Do Author Record List =========== 
  83. 96  
  84. 97   PROCEDURE listauth
  85. 98  
  86. 99   PARAMETERS mv_left,mv_upper,mv_depth
  87. 100  * -----
  88. 101  @mv_upper, mv_left + 4  SAY  "Last Name        First Name" 
  89. 102  * ---- call routine to do standard instructions and box --
  90. 103  DO listsupp WITH "Author",mv_left - 1,mv_upper
  91. 104  * ----- get cross-references to screen -----
  92. 105  DO WHILE mv_count # mv_depth + 1 
  93. 106     * -----
  94. 107     IF .NOT. EOF() .AND. &mv_cond
  95. 108        * ----- get fields to the screen -----
  96. 109        @ROW()+1,   mv_left + 1 SAY CHR(mv_count + 64)
  97. 110        @ROW(), COL()+2   GET authlist->authorln
  98. 111        @ROW(), COL()+2   GET authlist->authorfn
  99. 112        @ROW(),     COL()+2     SAY CHR(mv_count + 64)
  100. 113        SKIP
  101. 114        mv_on_scrn = mv_on_scrn + 1
  102. 115        * -----
  103. 116     ELSE
  104. 117        @ROW()+1, mv_left SAY SPACE(34)
  105. 118     ENDIF
  106. 119     * --- gets just used for color contrast -----
  107. 120     CLEAR GETS
  108. 121     * ----- increment loop control count -----
  109. 122     mv_count = mv_count + 1
  110. 123     * -----
  111. 124  ENDDO
  112. 125  * ----
  113. 126  RETURN
  114. 127  
  115. 128  * ============ Routine to Do Book Record List ============= 
  116. 129    
  117. 130  PROCEDURE listbook
  118. 131 
  119. 132  PARAMETERS mv_left,mv_upper,mv_depth
  120. 133  * ----- spot screen position for author label -----
  121. 134  @3, 0
  122. 135  * ----- call routine to center author to screen -----
  123. 136  DO centersc WITH "Author:  " + TRIM(authlist->authorln) + ;   
  124. 137         ", " + authlist->authorfn
  125. 138  * ----- do list caption -----
  126. 139  @mv_upper,mv_left + 4 SAY "Title" + SPACE(22) + "Year Call No." 
  127. 140  * ----- call routine to do standard instructions and box  -----
  128. 141  DO listsupp WITH "Title",mv_left - 1,mv_upper
  129. 142  * ----- get cross-references to screen -----
  130. 143  DO WHILE mv_count # mv_depth + 1 
  131. 144     * -----
  132. 145     IF .NOT. EOF() .AND. &mv_cond
  133. 146        * ----- get fields to the screen -----
  134. 147        @ROW()+1,   mv_left + 1 SAY CHR(mv_count + 64)
  135. 148        @ROW(), COL()+2   GET booklist->booktitl
  136. 149        @ROW(), COL()+2   GET booklist->bookyear
  137. 150        @ROW(), COL()+2   GET booklist->bookcall
  138. 151        @ROW(),     COL()+2     SAY CHR(mv_count + 64)
  139. 152        SKIP
  140. 153        mv_on_scrn = mv_on_scrn + 1
  141. 154        * -----
  142. 155     ELSE
  143. 156        @ROW()+1, mv_left SAY SPACE(49)
  144. 157     ENDIF
  145. 158     * --- gets just used for color contrast -----
  146. 159     CLEAR GETS
  147. 160     mv_count = mv_count + 1
  148. 161     * -----
  149. 162  ENDDO
  150. 163  * ----
  151. 164  RETURN
  152. 165  
  153. 166  * ===== Routine to Handle Page Moves in Selection List ===== 
  154. 167 
  155. 168  PROCEDURE listpage
  156. 169  
  157. 170  IF mv_key = 18
  158. 171     * ----- skip per current record depth on screen -----
  159. 172     SKIP - mv_depth + 1 - mv_on_scrn
  160. 173  ELSE
  161. 174     SKIP -1
  162. 175  ENDIF
  163. 176  * ----- call routine for beginning of file check -----
  164. 177  DO bofcheck
  165. 178  * ----
  166. 179  RETURN
  167. 180  
  168. 181  * ======= Routine to Supplement List Screen Display ====== 
  169. 182 
  170. 183  PROCEDURE listsupp
  171. 184 
  172. 185  PARAMETERS mv_entity,mv_left,mv_upper
  173. 186  * ----- call routine to draw box -----    
  174. 187  DO draw_box WITH mv_left,mv_upper + 1,mv_upper + ;
  175. 188       mv_depth + 2,"green"
  176. 189  * ----- spot position for user prompts -----
  177. 190  @mv_upper + mv_depth + 2, 0 SAY "  "
  178. 191  * --- call routine to center top prompt line to screen ---   
  179. 192  DO centersc WITH "Select " + TRIM(mv_entity) + ;
  180. 193       " by Select Letter"
  181. 194  * -- call routine to center middle prompt line to screen --   
  182. 195  DO centersc WITH "(Q)uit " + TRIM(mv_entity) + ;
  183. 196       " Listing Without Selecting"
  184. 197  * -- call routine to center bottom prompt line to screen -  
  185. 198  DO centersc WITH "<PGUP> ScrollUp, <PGDN> ScrollDown - " + ;   
  186. 199         CHR(24) + " Line Up - " + CHR(25) + " Line Down" 
  187. 200  * --- index to proper row for succeeding record scroll ----   
  188. 201  @mv_upper + 1, 40 SAY CHR(196)
  189. 202  * ----- initialize counters -----
  190. 203  mv_count = 1
  191. 204  mv_on_scrn = 0
  192. 205  * ----
  193. 206  RETURN
  194. 207 
  195. 208  * == Routine to Translate Key into Record Pointer Movement === 
  196. 209 
  197. 210  PROCEDURE scantran 
  198. 211
  199. 212  * ----- prepare intermediary value -----
  200. 213  mv_select = mv_key - 64
  201. 214  * ----- move record pointer -----
  202. 215  SKIP mv_select - mv_on_scrn - 1
  203. 216  * ----
  204. 217  RETURN
  205. 218 
  206. 219  * === General List Routine for Single Record Selection ====== 
  207. 220
  208. 221  PROCEDURE selslist
  209. 222
  210. 223  PARAMETERS mv_cond,mv_supp,mv_left,mv_upper,mv_depth
  211. 224  * ----- clear global exit flag -----
  212. 225  mv_exit = "N"
  213. 226  * ----- initialize local process control variables -----
  214. 227  mv_on_scrn = 0     && records on screen tracking variable 
  215. 228  mv_key     = 0     && variable to pass key value
  216. 229  mv_error   = "N"   && scroll disable on erroneous key
  217. 230  * ----- enter records display loop -----
  218. 231  DO WHILE .T.
  219. 232     * -----
  220. 233     IF mv_error = "N"
  221. 234        * ----- call routine to do record scroll -----
  222. 235        DO &mv_supp WITH mv_left,mv_upper,mv_depth
  223. 236        * -----
  224. 237     ENDIF
  225. 238     * ----- call routine to get and uppercase a key -----
  226. 239     DO key_wait
  227. 240     * ----- clear error flag -----
  228. 241     mv_error = "N"
  229. 242     * ---
  230. 242     DO CASE
  231. 243           * ----- check if in range select letter chosen ---   
  232. 244        CASE mv_key >= 65 .AND. mv_key <= 64 + mv_on_scrn 
  233. 245           * ----- call routine to home record pointer -----
  234. 246           DO scantran
  235. 247           EXIT
  236. 248           * ----- check if pgup or pgdn key chosen -----
  237. 249        CASE mv_key = 18 .OR. mv_key = 3 .AND. mv_on_scrn # 0    
  238. 250           * ----- call routine to handle pointer move -----
  239. 251           DO listpage
  240. 252          * ----- check if up arrow or down arrow key -----
  241. 253        CASE mv_key = 24 .OR. mv_key = 5 .AND. mv_on_scrn # 0    
  242. 254           * ----- call routine to handle pointer move -----
  243. 255           DO listarrw
  244. 256           * ----- check if user exit desired -----
  245. 257        CASE mv_key = 81
  246. 258           * ----- set public exit flag -----
  247. 259           mv_exit = "Y"
  248. 260           EXIT
  249. 261           * ----- invalid key if this point is reached -----    
  250. 262           OTHERWISE
  251. 263           * ----- beep the speaker -----
  252. 264           ?? CHR(7)
  253. 265           mv_error = "Y"
  254. 266           * -----
  255. 267     ENDCASE
  256. 268     * ---
  257. 269  ENDDO
  258. 270  * ----
  259. 271  RETURN
  260. 272  * ========= Routine to Set Screen Colors ============
  261. 273 
  262. 276  PROCEDURE setcolor
  263. 277 
  264. 278  PARAMETER mv_color
  265. 279  * ----- set according to current monitor -----
  266. 280  IF ISCOLOR()
  267. 281     DO CASE
  268. 282        CASE mv_color = "original"
  269. 283           SET COLOR TO W+/B+,G+/N,N
  270. 284        CASE mv_color = "green"
  271. 285           SET COLOR TO G+/B+,G+/N,N
  272. 286     ENDCASE
  273. 287  ELSE
  274. 288     SET COLOR TO
  275. 289  ENDIF
  276. 290   * ----
  277. 291  RETURN
  278. 292    
  279. 293  * ======= Routine to Spot Pointer in Selected Database ======= 
  280. 294    
  281. 295  PROCEDURE spot_ptr
  282. 296 
  283. 296  * ----- initialize seek variable ------
  284. 297  mv_seek = SPACE(15)
  285. 298  @8, 14 SAY "Enter Start Characters for Listing:"
  286. 299  @ROW(), COL()+2 GET mv_seek FUNCTION "!"
  287. 230  * ----- call routine to draw box -----
  288. 231  DO draw_box WITH 12,ROW()-1,ROW()+1,"green"
  289. 232  * ----- spot cursor -----
  290. 233  @ROW()+1, 0
  291. 234  * ----- call routine to center text to screen -----
  292. 235  DO centersc WITH "Press <ENTER> to Start at Listing Top" READ 
  293. 236  * ----- do a near seek to help ensure a hit -----
  294. 237  SET NEAR ON
  295. 238  SEEK TRIM(mv_seek)
  296. 239  SET NEAR OFF
  297. 240  * ----- position to last record if eof -----
  298. 241  IF EOF() .AND. RECCOUNT() # 0
  299. 242     SKIP -1
  300. 243  ENDIF
  301. 244  * ----- clear screen for succeeding record scroll ----- 
  302. 245  CLEAR
  303. 246  * ----
  304. 247  RETURN
  305. 248    
  306. 249  * =========== End of Procedures for BOOKS.PRG ========
  307.