Category : Files from Magazines
Archive   : DBMS0591.ZIP
Filename : NEBEL3.MAY

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