> <<* w/search -- 12/23/87, mlr This template takes a data entry screen and generates a basic database system around it -- Next, Previous, First, Last, Delete, Edit, Append. Action is controlled by a bounce-bar menu on row 24. NOTE that this template generates inkey() -dependent code (for the bounce-bar menu), and thus isn't dBASE III compatible. Assumes that DBF name "X" has index also named "X" (e.g. use FRED index FRED). Assumes that lines 23 and 24 are free for menu bar and user prompts. w/restrict 12/30/87, mlr Restrict option sets a filter (e.g. state >= 'CA' .and. state <= 'DE') by popping a box with the field names, getting one, and then asking for min and max values. It is stupid -- e.g. all fields available, only filter on one field at a time and it doesn't work with numeric fields (though you could add that fairly readily). On the plus side, it is totally automatic -- its pop-up box and other stuff don't need (or want) your help at the WW level. You just do the data entry screen. >> *** *** Program: {file}.PRG : Add, Edit, Delete system *** Generated {date} *** <<if not Clipper>> * environment set talk off <<endif>> <<if db3plus>> set scoreboard off set status off <<endif>> * all our procedures are at the bottom of this file set proc to {file} * initialize dbf(s) <<for all dbfs>> select {count} use {dbf name} index {dbf name} <<endfor>> <<if MRD>> * load MRD command processor load MRDCMD.bin * load screen image file {file} into MRD. * NOTE that MRD must be resident in memory BEFORE this program is run. call MRDCMD with "l {file}" <<endif>> <<* end of startup code>> {display text} do disprec * menu initialization optkeys = "FBSNLREDAQ" numopts = 10 * inkey aliases up = 5 down = 24 right = 4 left = 19 car_ret = 13 key = 0 do disp with 1 && show menu, highlighting first option current = 1 do while .t. && main loop key = 0 do while key =0 && wait for a keypress key =inkey() enddo * key is an arrow key arrow = ( (key = up).or.(key = down).or.(key = left).or.(key = right) ) * is it an option first letter (or car_ret -- same as pressing current letter) letter = iif( key = car_ret, current, at(upper(chr(key)),optkeys) ) if (.not. arrow) .and. (letter = 0) loop endif && ignore erroneous keys * * must be an arrow, or a letter do lodisp with current && 'unselect' the current option if arrow if (key = left) .or. (key = up) current = iif (current <> 1, current - 1, numopts) else && must be right (or down) current = iif ( current <> numopts, current + 1, 1) endif else && must be a letter current = letter endif do hidisp with current && 'select' the new option if .not. arrow do case case current = 1 Go top do disprec case current = 2 do prevrec case current = 3 do srchrec case current = 4 do nextrec case current = 5 go bott do disprec case current = 6 do restrict with current case current = 7 do editrec case current = 8 do delrec case current = 9 do apprec case current = 10 quit endcase * do disp with current && redisplay, just in case endif enddo *end of main loop *display all options, with 'choice' highlighted proc disp param choice i = 1 do while i <= numopts do lodisp with i i = i + 1 enddo do hidisp with choice return * display option, (hi lite) proc hidisp param choice do case case choice = 1 SET COLOR TO W/B @ 24,00 SAY "First" case choice = 2 SET COLOR TO W/B @ 24,06 SAY "Back 1" case choice = 3 SET COLOR TO W/B @ 24,14 SAY "Search" case choice = 4 SET COLOR TO W/B @ 24,22 SAY "Next" case choice = 5 SET COLOR TO W/B @ 24,27 SAY "Last" case choice = 6 SET COLOR TO W/B @ 24,37 SAY "Restrict" case choice = 7 SET COLOR TO W/B @ 24,52 SAY "Edit" case choice = 8 SET COLOR TO W/B @ 24,57 SAY "Delete" case choice = 9 SET COLOR TO W/B @ 24,64 SAY "Append" case choice = 10 SET COLOR TO W/B @ 24,73 SAY "Quit" endcase return * display option, (lo lite) proc lodisp param choice do case case choice = 1 SET COLOR TO W/N @ 24,00 SAY "First" case choice = 2 SET COLOR TO W/N @ 24,06 SAY "Back 1" case choice = 3 SET COLOR TO W/N @ 24,14 SAY "Search" case choice = 4 SET COLOR TO W/N @ 24,22 SAY "Next" case choice = 5 SET COLOR TO W/N @ 24,27 SAY "Last" case choice = 6 SET COLOR TO W/N @ 24,37 SAY "Restrict" case choice = 7 SET COLOR TO W/N @ 24,52 SAY "Edit" case choice = 8 SET COLOR TO W/N @ 24,57 SAY "Delete" case choice = 9 SET COLOR TO W/N @ 24,64 SAY "Append" case choice = 10 SET COLOR TO W/N @ 24,73 SAY "Quit" endcase return <<* what follows are generic procedures to handle the options in the browse menu. Modify to your heart's content, either here or in the generated code. >> * goto next record proc NEXTREC if .not. eof() skip if eof() goto bottom endif endif do disprec RETURN * goto previous record proc PREVREC if .not. bof() skip -1 if bof() goto top endif endif do disprec RETURN * edit record proc EDITREC set color to {screen color} @ 23,0 to 23,79 clear set color to {field color} @ 23,0 say "Edit data, then press ^W (Write record) or ^Q (Quit, no save)" {get all fields} READ do disprec RETURN * delete record proc DELREC if .not. deleted() delete else recall endif do disprec RETURN * append record proc APPREC * declare private memvars to duplicate fields <<for all getfields>> private m{field name} <<endfor>> * initialize memvar dupes <<for all getfields>> m{field name} = {field init-val} <<endfor>> * get input set color to {screen color} @ 23,0 to 23,79 clear set color to {field color} @ 23,0 say "Enter data, then press ^W (Write record) or ^Q (Quit, no save)" set color to {screen color},{field color} <<for all getfields>> @ {field row},{field col} get m{field name} picture {field picture} <<endfor>> READ * valid/recalc code could go here * did user leave everything blank or escape out? <<if db3plus>>x=readkey()<<endif>><<* 3 plus code>> <<if clipper>>x=lastkey()<<endif>><<* Clipper code>> if x<37 .or. x=268 do disprec RETURN endif * nope -- add the new record append blank <<for all getfields>> replace {field name} with m{field name} <<endfor>> do disprec RETURN * basic record display proc DISPREC {say all variables} {get all variables} clear gets set color to {screen color} @ 23,0 to 23,79 clear @ 23,50 say "Record # " @ 23,59 say recno() picture '9999999' if deleted() @ 23,70 say "Deleted" endif RETURN proc SRCHREC srch_val = space(10) @ 23,0 say "Value: " get srch_val read oldrec = recno() seek trim(srch_val) if .not. eof() do disprec else go oldrec set colo to {screen color} @ 23,0 to 23,49 clear @ 23,0 say '"'+trim(srch_val)+'" not found.' endif return <<* mlr -- 12/28/87>> proc restrict parameter here private curr,nvars,key,no_choice,x,low_val,high_val,exp,oldrec,field * display box with all field names set color to {field color},{screen color} @ 0,65 to {number of fields}+2,79 double @ 1,66 to {number of fields}+1,78 clear << for all fields >> @ {count},67 say "{field name}" <<endfor>> nvars = {number of fields} + 1 @ nvars,67 say "unrestrict" * pick one of the fields * first, put the field names into memvars << for all fields >> v_{count} = "{field name}" <<endfor>> x=ltrim(str(nvars)) v_&x = "unrestrict" * initialization -- highlight the first one curr = 1 set color to {screen color} @ 1,67 say v_1 x = '1' * actual picking code set color to {field color} @ 23,0 to 23,79 clear @ 23,0 say " use "+chr(24)+" "+chr(25)+" -- press Return when selected " no_choice = .t. do while no_choice key = 0 do while key = 0 key = inkey() enddo do case case key = up .or. key = down set color to {field color} x = ltrim(str(curr)) @ curr,67 say v_&x set color to {screen color} if key = up curr = iif ( curr = 1, nvars, curr - 1 ) else && key = down curr = iif (curr = nvars, 1, curr + 1 ) endif x = ltrim(str(curr)) @ curr,67 say v_&x case key = car_ret no_choice = .f. otherwise ?? chr(7) endcase enddo if curr = nvars && 'unrestrict' * pop down {display text} * unrestrict set filter to else && restrict low_val = space(20) high_val = space(20) no_choice = .t. do while no_choice set color to {screen color},{field color} @ 23,0 to 23,79 clear @ 23,0 say "Mininum "+trim(v_&x)+" " get low_val @ 23, 40 say "Maximum " get high_val read if high_val < low_val @ 22,0 to 22,79 clear @ 22,10 say "Maximum must not be less than minimum" else no_choice = .f. endif enddo field = v_&x exp = field+' >= "'+trim(low_val)+'" .and. '+field+' <= "'+trim(high_val)+'"' set filter to &exp {display text} * get to the next record within the filter range oldrec = recno() if .not. &exp skip if eof() skip -1 if bof() @ 23,0 to 23,79 clear @ 23,0 say "Filter rejected, no records in range" set filter to go oldrec endif && null file after set filter endif && no matches after current record endif && current record not in filtered group endif && restrict or unrestrict do disprec do disp with here return

<> <<* w/search -- 12/23/87, mlr This template takes a data entry screen and generates a basic database system around it -- Next, Previous, First, Last, Delete, Edit, Append. Action is controlled by a bounce-bar menu on row 24. NOTE that this template generates inkey() -dependent code (for the bounce-bar menu), and thus isn't dBASE III compatible. Assumes that DBF name "X" has index also named "X" (e.g. use FRED index FRED). Assumes that lines 23 and 24 are free for menu bar and user prompts. w/restrict 12/30/87, mlr Restrict option sets a filter (e.g. state >= 'CA' .and. state <= 'DE') by popping a box with the field names, getting one, and then asking for min and max values. It is stupid -- e.g. all fields available, only filter on one field at a time and it doesn't work with numeric fields (though you could add that fairly readily). On the plus side, it is totally automatic -- its pop-up box and other stuff don't need (or want) your help at the WW level. You just do the data entry screen. >> *** *** Program: {file}.PRG : Add, Edit, Delete system *** Generated {date} *** <<if not Clipper>> * environment set talk off <<endif>> <<if db3plus>> set scoreboard off set status off <<endif>> * all our procedures are at the bottom of this file set proc to {file} * initialize dbf(s) <<for all dbfs>> select {count} use {dbf name} index {dbf name} <<endfor>> <<if MRD>> * load MRD command processor load MRDCMD.bin * load screen image file {file} into MRD. * NOTE that MRD must be resident in memory BEFORE this program is run. call MRDCMD with "l {file}" <<endif>> <<* end of startup code>> {display text} do disprec * menu initialization optkeys = "FBSNLREDAQ" numopts = 10 * inkey aliases up = 5 down = 24 right = 4 left = 19 car_ret = 13 key = 0 do disp with 1 && show menu, highlighting first option current = 1 do while .t. && main loop key = 0 do while key =0 && wait for a keypress key =inkey() enddo * key is an arrow key arrow = ( (key = up).or.(key = down).or.(key = left).or.(key = right) ) * is it an option first letter (or car_ret -- same as pressing current letter) letter = iif( key = car_ret, current, at(upper(chr(key)),optkeys) ) if (.not. arrow) .and. (letter = 0) loop endif && ignore erroneous keys * * must be an arrow, or a letter do lodisp with current && 'unselect' the current option if arrow if (key = left) .or. (key = up) current = iif (current <> 1, current - 1, numopts) else && must be right (or down) current = iif ( current <> numopts, current + 1, 1) endif else && must be a letter current = letter endif do hidisp with current && 'select' the new option if .not. arrow do case case current = 1 Go top do disprec case current = 2 do prevrec case current = 3 do srchrec case current = 4 do nextrec case current = 5 go bott do disprec case current = 6 do restrict with current case current = 7 do editrec case current = 8 do delrec case current = 9 do apprec case current = 10 quit endcase * do disp with current && redisplay, just in case endif enddo *end of main loop *display all options, with 'choice' highlighted proc disp param choice i = 1 do while i <= numopts do lodisp with i i = i + 1 enddo do hidisp with choice return * display option, (hi lite) proc hidisp param choice do case case choice = 1 SET COLOR TO W/B @ 24,00 SAY "First" case choice = 2 SET COLOR TO W/B @ 24,06 SAY "Back 1" case choice = 3 SET COLOR TO W/B @ 24,14 SAY "Search" case choice = 4 SET COLOR TO W/B @ 24,22 SAY "Next" case choice = 5 SET COLOR TO W/B @ 24,27 SAY "Last" case choice = 6 SET COLOR TO W/B @ 24,37 SAY "Restrict" case choice = 7 SET COLOR TO W/B @ 24,52 SAY "Edit" case choice = 8 SET COLOR TO W/B @ 24,57 SAY "Delete" case choice = 9 SET COLOR TO W/B @ 24,64 SAY "Append" case choice = 10 SET COLOR TO W/B @ 24,73 SAY "Quit" endcase return * display option, (lo lite) proc lodisp param choice do case case choice = 1 SET COLOR TO W/N @ 24,00 SAY "First" case choice = 2 SET COLOR TO W/N @ 24,06 SAY "Back 1" case choice = 3 SET COLOR TO W/N @ 24,14 SAY "Search" case choice = 4 SET COLOR TO W/N @ 24,22 SAY "Next" case choice = 5 SET COLOR TO W/N @ 24,27 SAY "Last" case choice = 6 SET COLOR TO W/N @ 24,37 SAY "Restrict" case choice = 7 SET COLOR TO W/N @ 24,52 SAY "Edit" case choice = 8 SET COLOR TO W/N @ 24,57 SAY "Delete" case choice = 9 SET COLOR TO W/N @ 24,64 SAY "Append" case choice = 10 SET COLOR TO W/N @ 24,73 SAY "Quit" endcase return <<* what follows are generic procedures to handle the options in the browse menu. Modify to your heart's content, either here or in the generated code. >> * goto next record proc NEXTREC if .not. eof() skip if eof() goto bottom endif endif do disprec RETURN * goto previous record proc PREVREC if .not. bof() skip -1 if bof() goto top endif endif do disprec RETURN * edit record proc EDITREC set color to {screen color} @ 23,0 to 23,79 clear set color to {field color} @ 23,0 say "Edit data, then press ^W (Write record) or ^Q (Quit, no save)" {get all fields} READ do disprec RETURN * delete record proc DELREC if .not. deleted() delete else recall endif do disprec RETURN * append record proc APPREC * declare private memvars to duplicate fields <<for all getfields>> private m{field name} <<endfor>> * initialize memvar dupes <<for all getfields>> m{field name} = {field init-val} <<endfor>> * get input set color to {screen color} @ 23,0 to 23,79 clear set color to {field color} @ 23,0 say "Enter data, then press ^W (Write record) or ^Q (Quit, no save)" set color to {screen color},{field color} <<for all getfields>> @ {field row},{field col} get m{field name} picture {field picture} <<endfor>> READ * valid/recalc code could go here * did user leave everything blank or escape out? <<if db3plus>>x=readkey()<<endif>><<* 3 plus code>> <<if clipper>>x=lastkey()<<endif>><<* Clipper code>> if x<37 .or. x=268 do disprec RETURN endif * nope -- add the new record append blank <<for all getfields>> replace {field name} with m{field name} <<endfor>> do disprec RETURN * basic record display proc DISPREC {say all variables} {get all variables} clear gets set color to {screen color} @ 23,0 to 23,79 clear @ 23,50 say "Record # " @ 23,59 say recno() picture '9999999' if deleted() @ 23,70 say "Deleted" endif RETURN proc SRCHREC srch_val = space(10) @ 23,0 say "Value: " get srch_val read oldrec = recno() seek trim(srch_val) if .not. eof() do disprec else go oldrec set colo to {screen color} @ 23,0 to 23,49 clear @ 23,0 say '"'+trim(srch_val)+'" not found.' endif return <<* mlr -- 12/28/87>> proc restrict parameter here private curr,nvars,key,no_choice,x,low_val,high_val,exp,oldrec,field * display box with all field names set color to {field color},{screen color} @ 0,65 to {number of fields}+2,79 double @ 1,66 to {number of fields}+1,78 clear << for all fields >> @ {count},67 say "{field name}" <<endfor>> nvars = {number of fields} + 1 @ nvars,67 say "unrestrict" * pick one of the fields * first, put the field names into memvars << for all fields >> v_{count} = "{field name}" <<endfor>> x=ltrim(str(nvars)) v_&x = "unrestrict" * initialization -- highlight the first one curr = 1 set color to {screen color} @ 1,67 say v_1 x = '1' * actual picking code set color to {field color} @ 23,0 to 23,79 clear @ 23,0 say " use "+chr(24)+" "+chr(25)+" -- press Return when selected " no_choice = .t. do while no_choice key = 0 do while key = 0 key = inkey() enddo do case case key = up .or. key = down set color to {field color} x = ltrim(str(curr)) @ curr,67 say v_&x set color to {screen color} if key = up curr = iif ( curr = 1, nvars, curr - 1 ) else && key = down curr = iif (curr = nvars, 1, curr + 1 ) endif x = ltrim(str(curr)) @ curr,67 say v_&x case key = car_ret no_choice = .f. otherwise ?? chr(7) endcase enddo if curr = nvars && 'unrestrict' * pop down {display text} * unrestrict set filter to else && restrict low_val = space(20) high_val = space(20) no_choice = .t. do while no_choice set color to {screen color},{field color} @ 23,0 to 23,79 clear @ 23,0 say "Mininum "+trim(v_&x)+" " get low_val @ 23, 40 say "Maximum " get high_val read if high_val < low_val @ 22,0 to 22,79 clear @ 22,10 say "Maximum must not be less than minimum" else no_choice = .f. endif enddo field = v_&x exp = field+' >= "'+trim(low_val)+'" .and. '+field+' <= "'+trim(high_val)+'"' set filter to &exp {display text} * get to the next record within the filter range oldrec = recno() if .not. &exp skip if eof() skip -1 if bof() @ 23,0 to 23,79 clear @ 23,0 say "Filter rejected, no records in range" set filter to go oldrec endif && null file after set filter endif && no matches after current record endif && current record not in filtered group endif && restrict or unrestrict do disprec do disp with here return