Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive : UI_CLP56.ZIP
Filename : ALLCLIP.TEM

Output of file : ALLCLIP.TEM contained in archive : UI_CLP56.ZIP

<> <<uicode>> * * ALLCLIP.TEM Version 5.6 (c) 1990 * * Generates: * * A complete programming system generating Clipper 87 code depending * upon what kind of boxes are on screen at generation time * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ************************ *** template startup *** ************************ * load libraries used by this template load_lib("allclip") load_lib("varfunsc") ******************************* *** end of template startup *** ******************************* save_file = file makefile = .t. sys = grab_box("SYSTEM") mnu = grab_box("MAINMENU") pickkey = write_header() <<enduicode>> <<if mnu>> ********************************** * Set up window for all messages,* * error or otherwise * ********************************** <<bm = grab_box("MESSY")>> <<if .not. bm>> bmrow = 24 bmcolumn = 0 bmcolor = "+W/BG,+W/N" <<else>> bmrow = {bm.row} bmcolumn = {bm.column} bmcolor = "{bm.color + ',+W/N'}" <<endif>> cx = uncolor(bmcolor,mono) SET COLOR TO &cx @ bmrow,bmcolumn SAY space(80 - (2 * bmcolumn)) messages(3,'Please Stand By --- Initializing Databases',0,'') <<init_all_dbfs()>> <<found = .t.>> <<if .not. grab_box("DF_HELP")>> <<found = .f.>> <<for all dicdbfs>> <<if dicdbf.name = "GEN_HELP">> <<found = .t.>> <<endif>> <<endfor>> <<if .not. found>> * Open database GEN_HELP (alias GEN_HELP * * Indexes used: * 1: GEN_HELP ('upper(topic)') * SELECT 0 IF .NOT. FILE("GEN_HELP.DBF") PRIVATE names[2],types[2],lens[2],decs[2] names[1] = "PAGE" types[1] = "M" lens[1] = 10 decs[1] = 0 names[2] = "TOPIC" types[2] = "C" lens[2] = 16 decs[2] = 0 create_dbf("GEN_HELP",names,types,lens,decs) ENDIF USE GEN_HELP ALIAS GEN_HELP * first, check the existence of needed indexes IF .not. file("GEN_HELP{ndxtag}") messages(3,'Indexing GEN_HELP (upper(topic))',1,'') INDEX ON upper(topic) TO GEN_HELP ENDIF * now SET INDEX SET INDEX TO GEN_HELP <<endif>> <<endif>> <<endif>> <<uicode>> include_option_text_here(sys,"BEGIN",.t.) if mnu ? "MAINMENU()" else ? "* SUBMODULE -- contains functions called by a mainline program" ? "*" ? "* Must be compiled separated and linked together with calling prog" endif <<enduicode>> <<if mnu>> SET CURSOR ON <<include_option_text_here(sys,"END",.t.)>> CLOSE DATABASES SET COLOR TO W/N CLEAR <<include_option_text_here(sys,"RETURN",.t.)>> * End program <<endif>> <<if erase_sys()>> <<set_output("memvalid")>> <<set_output("pick.me")>> <<endif>> <<set_output("wanted.hlp")>> HELP WANTED FILE Help needed on following items: <<append_output(save_file)>> <<uicode>> private next_screen next_screen = wwfile do while next_screen q_indent = 0 ? "* BOXES FROM {next_screen} *" ? "********************** MENUS ******************************** " for all boxes where (box.popup .and. is_menu(box)) .and. upper(box.slot1) <> "PICK" menu_write(box) endfor ? " " ? "********************* BROWSE BOXES **************************" for all boxes where (box.popup .and. is_browse(box)) browse_write(box) endfor ? " " ? "********************* ENTRY BOXES ***************************" for all boxes where (box.popup .and. is_entry(box)) entry_write(box) endfor ? " " ? "********************* MEMO BOXES ****************************" for all boxes where (box.popup .and. is_memo(box)) memo_write(box) endfor ? " " ? "********************* ACHOICE BOXES *************************" for all boxes where (box.popup .and. is_achoice(box)) achoice_write(box) endfor ? " " ? "********************* PLAIN BOXES ***************************" for all boxes where (box.popup .and. is_plain(box)) justabox_write(box) endfor ? " " ? "********************* MENU PICK BOXES ***********************" for all boxes where (box.popup .and. is_menu(box)) .and. upper(box.slot1) = "PICK" menu_write(box) endfor ? " " ? "********************* MISC. FUNCTION ************************" write_field_functions() write_pick_functions() write_pick_me() write_memvalid() if mnu ? " " ? "********************* STANDARD FUNCTIONS *******************" write_standard_functions() endif next_screen = get_screen() enddo end_file() <<enduicode>> * End of File <<function menu_write>> <<parameter menub>> <<private name, prev_row, prev_col, holdvar>> <<if upper(menub.slot1) = "PICK">> ************************************** *** *** {lower(menub.name)} *** MENU PICK BOX ************************************** <<else>> ************************************** *** *** {lower(menub.name)} *** MENU BOX ************************************** <<endif>> FUNCTION {lower(menub.name)} <<name = crunch(menub.name,10,"savebuf")>> PRIVATE zkey, zhold, sys_color,{name} sys_color = SETCOLOR() <<private maine, holdvar, prev_row, prev_col, type, found_col>> <<if upper(menub.name) = "MAINMENU">> <<maine = .t.>> <<else>> <<maine = .f.>> <<endif>> <<q_indent = 3>> <<pop_box(menub)>> <<include_option_text_here(menub,"BEGIN",.t.)>> zkey = 1 <<if maine>> zhold1 = 1 <<endif>> DO WHILE .t. <<include_option_text_here(menub,"LOOP",.t.)>> <<q_indent = 6>> <<holdvar = first_var_in_box(menub)>> <<if holdvar>> cx = uncolor("{menub.contents.color}",mono) SET COLOR TO &cx <<say_all_vars_in_box(menub)>> <<endif>> <<uicode>> dwn = .f. across = .f. prev_row = first_opt_in_box(menub).row prev_col = first_opt_in_box(menub).col for all options in menub if option.row <> prev_row dwn = .t. endif if option.col <> prev_col across = .t. endif prev_row = option.row prev_col = option.col endfor do case case (dwn .and. across) type = 3 case dwn type = 1 case across type = 2 endcase hold = 0 for all options in menub hold = hold + 1 endfor optarray = array('OPT_ARRAY',hold) ? "zmenu = {hold}" if maine ? "zhold2 = zmenu" endif optkey = "" for all options in menub optarray[count] = option holder = iif(len(option.trigger) > 0,option.trigger[1]," ") if "" = trim(holder) .or. at(holder,ltrim(digest_text(box_text(option,0,0)))) = 0 holder = substr(ltrim(digest_text(box_text(option,0,0))),2,1) endif optkey = optkey + holder ? "mprompt[{count}] = {digest_text(box_text(option,0,0))}" endfor if upper(menub.slot1) <> "PICK" for all options in menub if .not. empty(option.slot3) ? "mhelp[{count}] = '{option.slot3}'" help_wanted(option.slot3) else ? "mhelp[{count}] = {ltrim(digest_text(box_text(option,0,0)))}" help_wanted(ltrim(digest_text(box_text(option,0,0)))) endif endfor endif for all options in menub if type = 1 .or. type = 3 ? "mr[{count}] = {option.row}" endif if type = 2 .and. count = 1 ? "g_col = {option.col}" endif if type = 2 .or. type = 3 ? "mc[{count}] = {option.col}" endif endfor holder = number_of_options_in_box(menub) if type < 3 if type = 1 ? "STORE {option.col} TO mc[1]" for i = 2 to holder ?? ",mc[{i}]" endfor else ? "STORE {option.row} TO mr[1]" for i = 2 to holder ?? ",mr[{i}]" endfor endif endif for all options in menub if .not. empty(option.message) .and. upper(menub.slot1) <> "PICK" ? 'mmessage[{count}] = "{option.message}"' else ? 'mmessage[{count}] = ""' endif endfor ? "optcols = uncolor('{menub.contents.color}',mono)" ? "keycols = uncolor('{key_color(menub,menub.contents.color,0)}',mono)" ? "unkeycols = uncolor('{key_color(menub,(first_opt_in_box(menub)).color_selected,1)}',mono)" ? "revcols = uncolor('{(first_opt_in_box(menub)).color_selected}',mono)" <<enduicode>> <<if maine>> IF zhold1 <> zkey SET COLOR TO &optcols @ mr[zhold1], mc[zhold1] SAY mprompt[zhold1] zhold1 = zkey SET COLOR TO &revcols @ mr[zhold1], mc[zhold1] SAY mprompt[zhold1] cx = uncolor(bmcolor,mono) SET COLOR TO &cx @ bmrow,bmcolumn + 1 @ bmrow,bmcolumn + 1 SAY mmessage[zhold1] SET COLOR TO &optcols ELSE zkey = menu({type},zkey,{holder},'{optkey}') ENDIF <<else>> zkey = menu({type},1,{holder},'{optkey}') <<endif>> DO CASE CASE zkey <1 zx = zkey EXIT <<q_indent=12>> <<herehold = 0>> <<for menus = 1 to len(optarray)>> <<herehold = herehold + 1>> CASE zkey = {herehold} <<uicode>> action_comics = optarray[menus].action[1] if upper(menub.slot1) = "PICK" xbox = grab_field(menub.slot2) if len(action_comics) < disp_len(xbox) action_comics = action_comics + space(disp_len(xbox)-len(action_comics)) endif ? "KEYBOARD '{action_comics}'" ? "EXIT" else xbox = grab_box(action_comics) if .not. xbox do case case upper(action_comics) = "PACK" ? 'answer = messages(2,"Pack all Databases? ","L","pack_it",.T.)' ? "IF answer" q_indent = 15 pack_all_dbfs() q_indent = 12 ? "ENDIF" case upper(action_comics) = "INDEX" ? 'answer = messages(2,"Index all Databases? ","L","index_it",.T.)' ? "IF answer" q_indent = 15 reindex_all_dbfs() q_indent = 12 ? "ENDIF" case upper(action_comics) = "RECALL" ? 'answer = messages(2,"Recall all deleted records in all Databases? ","L","delete_it",.T.)' ? "IF answer" q_indent = 15 recall_all_dbfs() q_indent = 12 ? "ENDIF" otherwise for i = 1 to 5 if "" <> trim(optarray[menus].action[i]) ? optarray[menus].action[i] endif endfor endcase else if maine ? "zhold1 = zkey" endif write_box_code(xbox," ") endif endif <<enduicode>> <<next>> ENDCASE <<if maine>> DO CASE CASE lastkey() = left_arrow zkey = IIF(zhold1 = 1, 1, zhold1-1) CASE lastkey() = right_arrow zkey = IIF(zhold1 <> zhold2, zhold1+1, zhold2) CASE lastkey() = down_arrow zkey = IIF(zx<>0,zx,zhold1) CASE LASTKEY() = esc .OR. LASTKEY() = sp_bar .OR. zx = -28 .OR. zx = 0 zkey = zhold1 CASE zx > 0 zkey = zx OTHERWISE key = -zx ENDCASE <<endif>> ENDDO <<q_indent = 0>> <<include_option_text_here(menub,"END",.t.)>> <<unpop_box(menub)>> <<include_option_text_here(menub,"RETURN",.t.)>> SET COLOR TO &sys_color RETURN "" * End of Function <<return>> <<function justabox_write>> <<parameter b>> <<if upper(b.name) <> "MESSY">> <<private topic,name>> *************************************** *** *** {lower(b.name)} *** PLAIN POP-UP BOX ************************************** FUNCTION {lower(b.name)} <<name = crunch(b.name,10,"savebuf")>> PRIVATE zkey, zhold, sys_color,{name} sys_color = SETCOLOR() <<uicode>> q_indent = 3 pop_box(b) include_option_text_here(b,"BEGIN",.t.) for all vars in b calc_var(var.name, var) endfor init_all_memvars_in_box(b) say_all_vars_in_box(b) if has_get_var(b) get_all_vars_in_box(b) ? "SET CURSOR ON" ? "READ" ? "SET CURSOR OFF" endif if .not. empty(b.slot1) .or. has_get_var(b) do case case upper(b.slot1) = "INDEX" reindex_all_dbfs() case upper(b.slot1) = "PACK" pack_all_dbfs() case upper(b.slot1) = "RECALL" recall_all_dbfs() endcase <<enduicode>> zkey = 0 <<else>> zkey = inkey(0) DO CASE CASE zkey = F1 <<if .not. empty(b.slot3)>> <<topic = b.slot3>> <<else>> <<topic = b.name>> <<endif>> DO helpme WITH "","","{topic}" <<help_wanted(topic)>> CASE zkey = 27 zx = 0 CASE zkey = 19 .OR. zkey = 4 .OR. (UPPER(CHR(zkey)) >= "A" .AND. UPPER(CHR(zkey)) <= "Z") zx = -zkey OTHERWISE zx = 0 ENDCASE <<endif>> <<include_option_text_here(b,"END",.t.)>> <<unpop_box(b)>> <<include_option_text_here(b,"RETURN",.t.)>> SET COLOR TO &sys_color RETURN (zkey) * End of procedure <<endif>> <<q_indent = 0>> <<return>> <<function memo_write>> <<parameter b>> <<private name>> ************************************** *** *** {lower(b.name)} *** MEMOEDIT TYPE BOX ************************************** FUNCTION {lower(b.name)} PARAMETER insert <<name = crunch(b.name,10,"savebuf")>> PRIVATE zkey, sys_color, sys_alias,{name} <<uicode>> private mf,holder q_indent = 3 write_box_top(b) for all fields in b if field.type = "M" mf = field endif next ? "edit_memo('{mf.name}',{mf.row},{mf.col},{b.bottom-(mf.row-b.top)},{b.right-(mf.col-b.left)},'{mf.color}',{b.right+b.left},insert)" <<enduicode>> <<q_indent = 3>> <<write_box_bottom(b,.t.)>> <<q_indent = 0>> RETURN "" * End of procedure <<return>> <<function achoice_write>> <<parameter b>> <<private ff,say_col,tall_clear,b_row>> ************************************** *** *** *** {lower(b.name)} *** ACHOICE BOX *** ************************************** FUNCTION {lower(b.name)} PRIVATE x,holder,init_row,chosen,cx holder = 1 init_row = 0 chosen = 1 <<uicode>> ff = first_var_in_box(b) if number_of_vars_in_box(b) > 1 ? "PRIVATE zvar[{number_of_vars_in_box(b)}], zret[{number_of_vars_in_box(b)}],on_off[{number_of_vars_in_box(b)}]" for all vars in box ? "zvar[{count}] = '{var.name}'" ? "zret[{count}] = '{var.slot3}'" ? "on_off[{count}] = {iif(empty(var.slot2),.t.,var.slot2)}" next else ? "PRIVATE {ff.name}[{ff.slot2}],on_off[{ff.slot2}]" ? "AFILL(on_off,.t.)" ? "{ff.slot3}" endif say_col = say_color(b) write_box_top(b) * find amount of lines to achoice tall_clear = 0 b_row = (ff.row - b.top) + iif(b.outline.type,1,0) do while len(trim(box_text(b,b_row,1,b.width-2))) = 0 .and. b_row < (b.height - iif(b.outline.type,0,1)) tall_clear = tall_clear + 1 b_row = b_row + 1 enddo ? 'cx = uncolor("{b.contents.color},{say_col}",mono)' ? 'cx = cx + ",,,{iif(substr(b.color,1,1) = "+",substr(b.color,2),"W/N")}"' ? "SET COLOR TO &cx" if upper(b.slot1) <> "CHOOSE" ? "DO WHILE LASTKEY() <> esc .AND. LASTKEY() <> sp_bar" q_indent = 3 endif ? 'chosen = ACHOICE({ff.row}, {ff.column}, {ff.row + tall_clear}, {ff.column+disp_len(ff)-1},{iif(number_of_vars_in_box(b) > 1, 'zvar', ff.name)},on_off,"acfunc",chosen,init_row)' ? "IF chosen <> 0" ? ' SET COLOR TO uncolor("{say_col},W/B",mono)' ? " @ ROW(),COL() SAY {iif(number_of_vars_in_box(b) > 1, 'zvar', ff.name)}[chosen]" ? " SET COLOR TO &cx" q_indent = q_indent + 3 include_option_text_here(b,"LOOP",.t.) q_indent = q_indent - 3 ? " holder = chosen" ? "ENDIF" if upper(b.slot1) <> "CHOOSE" q_indent = 0 ? "ENDDO" endif <<enduicode>> <<write_box_bottom(b,.t.)>> RETURN {iif(number_of_vars_in_box(b) > 1, 'zret', ff.name)}[holder] <<return>> <<function browse_write>> <<parameter b>> <<private dbrowse,counter,xoptions,ff,zrow,zstart,zwidth,pf,condition,name,thisdbf,primo,i,j>> <<dbrowse = is_browse_only(b)>> ************************************** *** *** *** {lower(b.name)} <<do case>> <<case is_browse_full(b)>> *** FULL SCREEN BROWSE BOX *** <<case is_what("DISPLAY",b)>> *** DISPLAY ONLY BOX *** <<case (dbrowse .or. is_what("PICK",b))>> *** DISPLAY ONLY BROWSE BOX *** <<otherwise>> *** BROWSE BOX *** <<endcase>> ************************************** FUNCTION {lower(b.name)} <<counter = number_of_vars_in_box(b)>> PRIVATE fnames[{counter}], fpics[{counter}], fdiv[{counter}], finput[{counter}], fshow[{counter}] <<if is_what("PICK",b)>> PRIVATE holder <<endif>> <<uicode>> q_indent = 3 xoptions = get_option(b) condition = .f. related = .f. say_col = say_color(b) write_box_top(b) if .not. related ? "GOTO TOP" endif ff = first_field_in_box(b) zrow = ff.row - b.top for all memvars in b if memvar.row <> ff.row init_var(memvar) calc_var(memvar.name, memvar) say_var(memvar) endif endfor ? 'fdiv[1] = ""' for all vars in b if var.row = ff.row if count <> 1 zstart = (pf.column + disp_len(pf)) - b.left zwidth = (var.column-b.left) - zstart ? 'fdiv[{count}] = "{box_text(b,zrow,zstart,zwidth)}"' endif if var.isfield ? "fnames[{count}] = '{field_say_name(var,var.dbf)}'" else if .not. var.calc_formula ? "NA = 'Not Defined'" ? "fnames[{count}] = 'NA'" else ? "fnames[{count}] = '{var.calc_formula}'" endif endif if var.picture ? "fpics[{count}] = {var.picture}" else ? "fpics[{count}] = ''" endif ? "finput[{count}] = {iif(var.input,'.t.','.f.')}" ? "fshow[{count}] = {iif((len(var.picture) <> 0 .and. len(var.picture) < var.length) ,'.t.','.f.')}" pf = var endif next if condition if .not. related if sought ? "SEEK {sought}" else ? "LOCATE FOR {condition}" endif endif if related ? "IF {iif(thisdbf.alias, thisdbf.alias, thisdbf.name)}->(EOF())" else ? "IF .NOT. FOUND()" endif q_indent = 6 if is_what("DISPLAY",b) write_box_bottom(b,.f.) ? "RETURN ''" else if dbrowse ? "messages(4,'No records in file meet conditions -- Press any key to continue')" else ? 'answer = messages(2,"No records in file --- Insert New Record? ","L","insert_rec",.T.)' ? '@ {ff.row},{ff.column} SAY ""' ? 'IF LASTKEY() <> esc .AND. answer' ? ' ret_val = ed_{substr(b.name,1,5)}("I",1)' ? ' IF LASTKEY() = esc' q_indent = 12 write_box_bottom(b,.t.) ? "RETURN ''" q_indent = 6 ? " ENDIF" ? "ELSE" q_indent = 9 endif write_box_bottom(b,.t.) ? "RETURN ''" if .not. dbrowse q_indent = 6 ? "ENDIF" endif endif q_indent = 3 ? "ENDIF" ? "SET FILTER TO {condition} .AND. db_while({condition},{iif(sought,".t.",".f.")})" endif ? 'cx = uncolor("{b.contents.color},{say_col}",mono)' ? "SET COLOR TO &cx" if condition .and. .not. is_what("DISPLAY",b) .and. .not. is_what("NOEDIT",b) ? 'DO WHILE LASTKEY() <> esc .AND. LASTKEY() <> sp_bar' q_indent = 6 endif * find amount of lines to dbedit tall_clear = 0 b_row = (ff.row - b.top) + iif(b.outline.type,1,0) do while len(trim(box_text(b,b_row,1,b.width-2))) = 0 .and. b_row < (b.height - iif(b.outline.type,0,1)) tall_clear = tall_clear + 1 b_row = b_row + 1 enddo ? 'zseek = ""' ? 'DBEDIT({ff.row}, {ff.column}, {ff.row + tall_clear}, {pf.column+disp_len(pf)-1}, fnames,"db{substr(b.name,1,5)}",fpics,"","",fdiv)' if condition .and. .not. is_what("DISPLAY",b) .and. .not. is_what("NOEDIT",b) q_indent = 3 ? "ENDDO" endif if condition if .not. is_what("NOEDIT",b) if sought ? "SEEK {sought}" else ? "GOTO TOP" ? "LOCATE FOR {condition}" endif endif ? "SET FILTER TO" endif if is_what("PICK",b) ? "IF LASTKEY() <> esc" ? " holder = {b.slot3}" ? " KEYBOARD holder" ? "ENDIF" endif if .not. is_what("DISPLAY",b) write_box_bottom(b,.t.) else write_box_bottom(b,.f.) endif <<enduicode>> RETURN "" *End of Function * Function for dbedit of {b.name} FUNCTION db{substr(b.name,1,5)} PARAMETERS mode, fld_ptr PRIVATE ret_val, holder, zrow holder = fnames[fld_ptr] IF "" = zseek zrow = ROW() messages(3,if(fshow[fld_ptr],&holder," ")) @ zrow, 0 SAY "" ENDIF <<if upper(b.slot1) <> "DISPLAY">> <<include_option_text_here(b,"LOOP",.t.)>> ret_val = 1 DO CASE CASE mode = 0 IF LASTKEY() = up_arrow .OR. LASTKEY() = down_arrow .OR. ; LASTKEY() = pg_up .OR. LASTKEY() = pg_down zseek = "" ENDIF CASE mode = 1 messages(1,"Start of File",1,"") CASE mode = 2 messages(1,"End of File",1,"") CASE mode = 3 ret_val = 0 <<if .not. dbrowse .and. .not. is_what("PICK",b) .and. .not. is_helpbrowse(b)>> <<if condition>> <<if sought>> SEEK {sought} <<else>> GOTO TOP LOCATE FOR {condition} <<endif>> IF .NOT. FOUND() <<endif>> answer = messages(2,"No records in file --- Insert New Record? ","L","insert_rec",.T.) @ {ff.row},{ff.column} SAY "" IF answer .AND. LASTKEY() <> esc ret_val = ed_{substr(b.name,1,5)}("I",1) <<if condition>> ELSE KEYBOARD CHR(esc) <<endif>> ENDIF <<if condition>> ENDIF <<endif>> <<else>> <<if is_what("PICK",b)>> messages(4,"No records in lookup Box -- Must add some or this won't work (press Esc twice)") KEYBOARD chr(esc) INKEY(0) <<else>> messages(3," ") <<endif>> <<endif>> CASE mode = 4 DO CASE CASE LASTKEY() = esc .OR. LASTKEY() = sp_bar <<if .not. is_what("PICK",b)>> ret_val = 0 <<else>> IF "" = zseek ret_val = 0 ELSE IF LASTKEY() <> sp_bar messages(3," ") zseek = "" ret_val = 1 ELSE zseek = zseek + " " ENDIF ENDIF <<endif>> CASE LASTKEY() = enter <<if called_by_something(b,"RETURN",.f.)>> <<nextbox = called_by_something(b,"RETURN",.f.)>> <<if is_helpbrowse(b)>> df_help({(first_field_in_box(b)).name}) zseek = "" messages(3," ") <<else>> <<q_indent = 15>> messages(3," ") <<write_box_code(nextbox," ")>> ret_val = 2 <<endif>> <<else>> <<if .not. dbrowse .and. .not. is_what("PICK",b) .and. .not. is_what("NOEDIT",b)>> ret_val = ed_{substr(b.name,1,5)}("R",fld_ptr) <<else>> ret_val = 0 messages(3," ") <<endif>> <<endif>> <<if .not. is_helpbrowse(b) .and. .not. is_what("PICK",b)>> <<if .not. is_browse_full(b) .and. .not. dbrowse>> CASE LASTKEY() = 10 && Control-return edits record ret_val = ed_{substr(b.name,1,5)}("R",fld_ptr) CASE LASTKEY() = 23 && Alt i / Append Loop DO WHILE LASTKEY() <> esc ret_val = ed_{substr(b.name,1,5)}("I",1) ENDDO <<if .not. is_what("EDITONLY",b)>> CASE LASTKEY() = 22 && Insert code ret_val = ed_{substr(b.name,1,5)}("I",fld_ptr) CASE LASTKEY() = 7 BEGIN SEQUENCE <<include_option_text_here(b,"DELETE",.t.)>> answer = messages(2,"Delete this Record?","L","delete_rec",.T.) IF answer <<if condition>> ret_val = 0 <<else>> ret_val = 2 <<endif>> <<if len(get_prime(b).rel) > 0>> answer = messages(2,"Deleting this record will delete records in related databases -- Proceed?","L","delete_rec",.T.) IF answer <<q_indent = 21>> <<do delete_all_related with get_prime(b)>> <<prime_dbf = get_prime(b)>> SELECT {iif(prime_dbf.alias, prime_dbf.alias, prime_dbf.name)} <<q_indent = 18>> <<endif>> <<if multi>> IF e_network(3,5,"Record not available for locking. Retry? (Y/N)") <<endif>> DELETE <<if multi>> UNLOCK ENDIF <<endif>> <<if len(get_prime(b).rel) > 0>> ENDIF <<endif>> SKIP -1 IF EOF() <<if condition>> KEYBOARD chr(esc) <<else>> ret_val = 0 <<endif>> ENDIF ENDIF END <<endif>> <<endif>> CASE LASTKEY() = F1 <<if .not. empty(b.slot3)>> <<topic = b.slot3>> <<else>> <<topic = b.name>> <<endif>> DO helpme WITH "","","{topic}" <<help_wanted(topic)>> <<endif>> <<q_indent = 12>> <<write_other_keys(b)>> <<if .not. is_helpbrowse(b) .and. .not. dbrowse .and. .not. is_what("PICK",b) .and. .not. is_what("NOEDIT",b)>> ret_val = ed_{substr(b.name,1,5)}("R",fld_ptr) <<endif>> ENDIF ENDCASE ENDCASE <<else>> ret_val = 0 <<endif>> RETURN (ret_val) <<if .not. dbrowse .and. .not. is_helpbrowse(b) .and. .not. is_what("PICK",b) .and. upper(b.slot1) <> "DISPLAY">> ************************* * function to get record* * called by read of * * {b.name} * ************************* FUNCTION ed_{substr(b.name,1,5)} PARAMETER io,inum <<q_indent = 3>> <<if nextbox .and. is_entry(nextbox)>> <<write_box_code(nextbox,"io")>> <<else>> PRIVATE cur_field, hold_color, frow, hold_order <<declare_field_dupes_in_box(b)>> frow = ROW() hold_color = SETCOLOR() cx = uncolor("{b.contents.color},{ff.color}",mono) SET COLOR TO &cx cur_field = fnames[inum] IF io = "I" <<uicode>> q_indent = 6 init_dupe_fields(b,"r") q_indent = 3 ? "ELSE" q_indent = 6 init_dupe_fields(b,"f") <<enduicode>> ENDIF IF inum <> 1 * do just the one field IF finput[inum] @ frow, COL() GET &cur_field PICTURE fpics[inum] SET CURSOR ON <<include_option_text_here(b,"READ",.t.)>> READ SET CURSOR OFF KEYBOARD CHR(down_arrow) ENDIF SET COLOR TO &hold_color RETURN 1 ELSE * do all the fields <<q_indent = 6>> <<for all fields in b>> <<if field.input>> <<get_field_dupe_at_row(field)>> <<endif>> <<endfor>> ENDIF SET CURSOR ON SET KEY F1 TO helpme SET KEY {pickkey} TO pickme <<include_option_text_here(b,"READ",.t.)>> READ SET KEY F1 TO SET KEY {pickkey} TO SET CURSOR OFF IF LASTKEY() <> esc <<uicode>> q_indent = 6 uni = .f. if is_indexed(b) if upper((get_prime(b)).index[1].slot3) = "UNIQUE" ? "hold_order = INDEXORD()" ? "SET ORDER TO 1" ? "z_temp = m->({(get_prime(b)).index[1].expr})" ? "zhere = RECNO()" ? "SEEK z_temp" ? 'IF .NOT. FOUND() .OR. (io <> "I" .AND. RECNO() = zhere)' ? " GOTO zhere" q_indent = 9 uni = .t. endif endif ? 'IF io = "I"' include_option_text_here(b,"INSERT",.t.) if multi ? 'IF e_network(4,5,"File not available for locking. Retry? (Y/N)")' else ? " APPEND BLANK" replace_all_memos(b) endif ? " KEYBOARD CHR(down_arrow)" if multi ? "UNLOCK" ? "ENDIF" endif ? "ELSE" include_option_text_here(b,"EDIT",.t.) ? "ENDIF" replace_all_fields(b) include_option_text_here(b,"CHANGE",.t.) if uni q_indent = 6 ? "ELSE" ? ' messages(1,"Record Key Already in Use",1,"")' ? "ENDIF" ? "SET ORDER TO hold_order" endif q_indent = 3 ? "ENDIF" q_indent = 0 ? "SET COLOR TO &hold_color" endif if is_browse_full(b) ? "KEYBOARD CHR(down_arrow)" endif if condition if .not. is_what("NOEDIT",b) ? "SKIP -1" endif q_indent = 0 ? "RETURN 0" else q_indent = 0 ? "RETURN 2" endif endif <<enduicode>> <<q_indent = 0>> <<return>> <<function entry_write>> <<private xoptions,condition,cbox,topic,a_i,n_i,pages,holddbf,tf,bo,printendif,uni,x,prime_dbf,say_col,name,fbo>> <<parameter b>> *************************************** *** *** {lower(b.name)} *** ENTRY (FIELDS) BOX ************************************** FUNCTION {lower(b.name)} PARAMETER io PRIVATE key, newstring, hold_order <<uicode>> q_indent = 3 declare_field_dupes_in_box(b) xoptions = get_option(b) condition = ".t." say_col = say_color(b) write_box_top(b) for all memvars in b init_var(memvar) endfor ? 'cx = uncolor("{say_col},{field.color}",mono)' ? "SET COLOR TO &cx" <<enduicode>> DO WHILE .t. <<q_indent = 6>> <<cbox = called_by_something(b,"",.f.)>> <<if cbox>> zarea = SELECT() <<called_by_something(b,"",.t.)>> SELECT (zarea) <<endif>> <<include_option_text_here(b,"LOOP",.t.)>> <<for all memvars in b>> <<calc_var(memvar.name, memvar)>> <<say_var(memvar)>> <<endfor>> <<for all fields in b>> <<if field.type <> "M">> <<say_var(field)>> <<else>> <<x = say_memo(field,b,.f.)>> <<endif>> <<endfor>> IF pcount() > 0 DO CASE CASE io = "R" get{substr(b.name,1,5)}("R") EXIT <<if called_by_something(b,"PGDN",.f.) .or. b.slot1 = "PGDN">> <<fbo = find_first_box_in_line(b)>> <<if fbo .and. b <> fbo>> CASE io = "H" get{substr(b.name,1,5)}("H") EXIT <<endif>> <<endif>> OTHERWISE get{substr(b.name,1,5)}("I") EXIT ENDCASE ENDIF IF EOF() .OR. .NOT. {condition} <<if .not. is_what("EDITONLY",b)>> GOTO TOP IF EOF() .OR. .NOT. {condition} answer = messages(2,"No records in file --- Insert New Record? ","L","insert_rec",.T.) IF answer .AND. LASTKEY() <> esc get{substr(b.name,1,5)}("I") ELSE EXIT ENDIF ENDIF <<else>> APPEND BLANK <<endif>> ELSE key = inkey(0) * update choice number based on key response DO CASE <<q_indent = 12>> <<if .not. empty(b.slot3)>> <<topic = b.slot3>> <<else>> <<topic = b.name>> <<endif>> <<help_wanted(topic)>> CASE keycheck(key, "{condition}","get{substr(b.name,1,5)}","{topic}",{iif(is_what("EDITONLY",b),'.t.','.f.')}) IF "" <> zseek zseek = "" messages(3," ") ENDIF <<if .not. is_what("EDITONLY",b)>> CASE key = 7 IF .NOT. EOF() .AND. {condition} BEGIN SEQUENCE <<include_option_text_here(b,"DELETE",.t.)>> answer = messages(2,"Delete this Record?","L","delete_rec",.T.) IF answer here = RECNO() <<if len(get_prime(b).rel) > 0>> answer = messages(2,"Deleting this record will delete records in related databases -- Proceed?","L","delete_rec",.T.) IF answer <<q_indent = 24>> <<do delete_all_related with get_prime(b)>> <<prime_dbf = get_prime(b)>> SELECT {iif(prime_dbf.alias, prime_dbf.alias, prime_dbf.name)} <<q_indent = 12>> <<endif>> <<if multi>> IF e_network(3,5,"Record not available for locking. Retry? (Y/N)") DELETE UNLOCK ENDIF <<else>> DELETE <<endif>> SKIP -1 IF BOF() .OR. .NOT. {condition} goto HERE SKIP ENDIF <<if len(get_prime(b).rel) > 0>> ENDIF <<endif>> ENDIF END ELSE messages(1,"No records in File -- Cannot Delete",1,"") ENDIF <<endif>> CASE key = esc .OR. key = sp_bar .OR. key = 18 && PgUp EXIT <<write_other_keys(b)>> get{substr(b.name,1,5)}("R") ENDIF ENDCASE ENDIF ENDDO <<q_indent = 3>> <<write_box_bottom(b,.t.)>> RETURN "" * End of Procedure ******************************** * FUNCTION to edit or add to * {b.name} ******************************** FUNCTION get{substr(b.name,1,5)} PARAMETER io <<bo = grab_box("MAINMENU")>> <<pages = .f.>> <<q_indent = 3>> DO CASE CASE io = "I" <<uicode>> unique_key = is_unique(b) if called_by_something(b,"PGDN",.f.) .or. b.slot1 = "PGDN" fbo = find_first_box_in_line(b) if fbf .and. b <> fbo ? ' messages(3,"Editing record at this level -- cannot insert except at top level")' ? ' RETURN ""' ? 'CASE io = "H"' ? ' * Do nothing - Basically' else q_indent = 6 init_dupe_fields(b,"r") q_indent = 3 endif pages = .t. else q_indent = 6 init_dupe_fields(b,"r") q_indent = 3 endif if unique_key q_indent = 6 get_field_dupe(unique_key) ? "SET CURSOR ON" ? "SET KEY F1 TO helpme" ? "SET KEY {pickkey} TO pickme" ? "READ" ? "SET KEY F1 TO" ? "SET KEY {pickkey} TO" ? "SET CURSOR OFF" ? "IF LASTKEY() = esc" ? " RETURN ''" ? "ENDIF" ? "hold_order = INDEXORD()" ? "SET ORDER TO {i}" ? "z_temp = m->{unique_key.name}" ? "zhere = RECNO()" ? "SEEK z_temp" ? 'IF .NOT. FOUND()' ? " GOTO zhere" ? 'ELSE' ? ' messages(1,"Key Already Exists!",1)' ? ' KEYBOARD chr(13)' ? ' RETURN ""' ? 'ENDIF' endif ? "OTHERWISE" q_indent = 6 init_dupe_fields(b,"f") q_indent = 3 ? "ENDCASE" tfcounter = 1 for all fields in b if field.input if field.type <> "M" if unique_key if unique_key <> field get_field_dupe(field) endif else get_field_dupe(field) endif else ?"@ {field.row}, {field.col} GET m->memo_{tfcounter} VALID memvalid('',0,'{field.name}',if(io='I',.t.,.f.))" tfcounter = tfcounter + 1 endif endif endfor ? "SET CURSOR ON" ? "SET KEY F1 TO helpme" ? "SET KEY {pickkey} TO pickme" include_option_text_here(b,"READ",.t.) ? "READ" ? "SET KEY F1 TO" ? "SET KEY {pickkey} TO" ? "SET CURSOR OFF" if fbo .and. fbo = b bo = called_by_something(fbo,"PGDN",.f.) do while called_by_something(bo,"PGDN",.f.) write_box_code(bo,"H") bo = called_by_something(bo,"PGDN",.f.) enddo bo = find_last_box_in_line(b) write_box_code(bo,"H") endif <<enduicode>> IF LASTKEY() <> esc <<uicode>> q_indent = 6 uni = .f. if is_indexed(b) .and. .not. unique_key if upper((get_prime(b)).index[1].slot3) = "UNIQUE" ? "hold_order = INDEXORD()" ? "SET ORDER TO 1" ? "z_temp = m->({(get_prime(b)).index[1].expr})" ? "zhere = RECNO()" ? "SEEK z_temp" ? 'IF .NOT. FOUND() .OR. (io <> "I" .AND. RECNO() = zhere)' ? " GOTO zhere" q_indent = 9 uni = .t. endif endif ? 'DO CASE' ? 'CASE io = "I"' include_option_text_here(b,"INSERT",.t.) if multi ? 'IF e_network(4,5,"File not available for locking. Retry? (Y/N)")' else ? " APPEND BLANK" replace_all_memos(b) endif if multi ? "UNLOCK" ? "ENDIF" endif if pages .and. fbo <> b ? 'CASE io = "H"' ? ' * Do nothing' endif ? "OTHERWISE" include_option_text_here(b,"EDIT",.t.) if pages .and. fbo <> b replace_all_fields(b) endif ? "ENDCASE" q_indent = 6 if .not. pages .or. fbo = b replace_all_fields(b) endif include_option_text_here(b,"CHANGE",.t.) if uni ? "ELSE" ? ' messages(1,"Record Key Already in Use",1,"")' ? "ENDIF" ? "SET ORDER TO hold_order" endif if len(get_prime(b).rel) > 0 ? "IF io = 'I'" ? " SKIP" ? " SKIP -1" ? "ENDIF" endif q_indent = 3 ? "ENDIF" q_indent = 0 ? "RETURN ''" <<enduicode>> <<return>> </div> </div> <footer class="post-footer postdata fix"> </footer> <div class='postdata line'> </div> <section id="comments"> <h3 class="comments"> 3 Responses to “Category : Dbase (Clipper, FoxBase, etc) Languages Source Code Archive : UI_CLP56.ZIP Filename : ALLCLIP.TEM ”</h3> <ol class="commentlist"> <li id="comment-468" class="comment even thread-even depth-1 plain-nested"> <div id="div-comment-468" class="comment-body"> <div class="comment-author fix vcard"> <img alt='' src='https://secure.gravatar.com/avatar/8f76d6c77c12a5a1083dce633a326642?s=48&d=mm&r=g' srcset='https://secure.gravatar.com/avatar/8f76d6c77c12a5a1083dce633a326642?s=96&d=mm&r=g 2x' class='avatar avatar-48 photo' height='48' width='48' decoding='async'/> <div class="comment-author-link"> <cite class="fn">Daniel</cite> says: </div> <div class="comment-meta commentmetadata"><a href="https://www.pcorner.com/list/#comment-468"> January 27, 2013 at 3:59 pm</a> </div> </div> Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives! </div> <div class="reply"> </div> </li> <li id="comment-1491" class="comment odd alt thread-odd thread-alt depth-1 plain-nested"> <div id="div-comment-1491" class="comment-body"> <div class="comment-author fix vcard"> <img alt='' src='https://secure.gravatar.com/avatar/6b4f9d1304972a01f7c30ad1710ddc18?s=48&d=mm&r=g' srcset='https://secure.gravatar.com/avatar/6b4f9d1304972a01f7c30ad1710ddc18?s=96&d=mm&r=g 2x' class='avatar avatar-48 photo' height='48' width='48' decoding='async'/> <div class="comment-author-link"> <cite class="fn">Joshie</cite> says: </div> <div class="comment-meta commentmetadata"><a href="https://www.pcorner.com/list/#comment-1491"> March 18, 2014 at 4:57 pm</a> </div> </div> This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though. </div> <div class="reply"> </div> </li> <li id="comment-31187" class="comment even thread-even depth-1 plain-nested"> <div id="div-comment-31187" class="comment-body"> <div class="comment-author fix vcard"> <img alt='' src='https://secure.gravatar.com/avatar/e91d5d889b8284060613b258afef30f7?s=48&d=mm&r=g' srcset='https://secure.gravatar.com/avatar/e91d5d889b8284060613b258afef30f7?s=96&d=mm&r=g 2x' class='avatar avatar-48 photo' height='48' width='48' decoding='async'/> <div class="comment-author-link"> <cite class="fn">DiskingRound</cite> says: </div> <div class="comment-meta commentmetadata"><a href="https://www.pcorner.com/list/#comment-31187"> January 14, 2015 at 10:57 pm</a> </div> </div> But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: <a href="http://www.os2museum.com/wp/mtswslnk/" rel="nofollow ugc">http://www.os2museum.com/wp/mtswslnk/</a> </div> <div class="reply"> </div> </li> </ol> <div class="navigation fix"> <div class="alignleft"></div> <div class="alignright"></div> </div> </section>  </article> </div> </div> <div id='sidebar-shell-1' class='sidebar-shell sidebar-shell-right'> <div class="dbx-group right boxed warea" id="sidebar"> <aside id="block-15" class="dbx-box suf-widget widget_block"><div class="dbx-content"> <h2 class="wp-block-heading">Login/Logout</h2> </div></aside><aside id="block-10" class="dbx-box suf-widget widget_block"><div class="dbx-content"><div class="logged-out wp-block-loginout"><a href="https://www.pcorner.com/wp-login.php?redirect_to=https%3A%2F%2Fwww.pcorner.com%2Flist%2FDBASE%2FUI_CLP56.ZIP%2FALLCLIP.TEM%2F">Log in</a></div></div></aside><aside id="block-16" class="dbx-box suf-widget widget_block"><div class="dbx-content"> <h2 class="wp-block-heading">Donation</h2> </div></aside><aside id="paypal_donations-4" class="dbx-box suf-widget widget_paypal_donations"><div class="dbx-content"> <form action="https://www.paypal.com/cgi-bin/webscr" method="post"> <div class="paypal-donations"> <input type="hidden" name="cmd" value="_donations" /> <input type="hidden" name="bn" value="TipsandTricks_SP" /> <input type="hidden" name="business" value=" donation@pcorner.com" /> <input type="hidden" name="return" value="http://www.pcorner.com" /> <input type="hidden" name="item_name" value="Keep Site Alive" /> <input type="hidden" name="amount" value="25" /> <input type="hidden" name="rm" value="0" /> <input type="hidden" name="currency_code" value="USD" /> <input type="image" style="cursor: pointer;" src="https://www.paypalobjects.com/en_US/i/btn/btn_donate_LG.gif" name="submit" alt="PayPal - The safer, easier way to pay online." /> <img alt="" src="https://www.paypalobjects.com/en_US/i/scr/pixel.gif" width="1" height="1" /> </div> </form>  </div></aside></div> </div> </div> </div> <footer> <div id='page-footer'> <div class='col-control'> <div id="cred"> <table> <tr> <td class="cred-left">© 2018 <a href='http://www.pcorner.com'>The Programmer's Corner</a> by Personalized Computer Systems </td> <td class="cred-center"><script async src="//pagead2.googlesyndication.com/pagead/js/adsbygoogle.js"></script> <ins class="adsbygoogle" style="display:inline-block;width:728px;height:90px" data-ad-client="ca-pub-8001169946558833" data-ad-slot="6568049104"></ins> <script> (adsbygoogle = window.adsbygoogle || []).push({}); </script> </td> <td class="cred-right"></td> </tr> </table> </div> </div> </div> </footer>   <script type='text/javascript'> //<![CDATA[ jQuery(document).ready(function($) { $('html').MagicLiquidizerTable({ whichelement: 'table', breakpoint: '780', headerSelector: 'thead td, thead th, tr th', bodyRowSelector: 'tbody tr, tr', table: '' }) }) //]]> </script> <script type="text/javascript" src="https://www.pcorner.com/wp-includes/js/comment-reply.min.js?ver=6.5.3" id="comment-reply-js" async="async" data-wp-strategy="async"></script> </body> </html> <script>(function(){if (!document.body) return;var js = "window['__CF$cv$params']={r:'88b777d20900874f',t:'MTcxNjk5NjAyMi41ODYwMDA='};_cpo=document.createElement('script');_cpo.nonce='',_cpo.src='/cdn-cgi/challenge-platform/scripts/jsd/main.js',document.getElementsByTagName('head')[0].appendChild(_cpo);";var _0xh = document.createElement('iframe');_0xh.height = 1;_0xh.width = 1;_0xh.style.position = 'absolute';_0xh.style.top = 0;_0xh.style.left = 0;_0xh.style.border = 'none';_0xh.style.visibility = 'hidden';document.body.appendChild(_0xh);function handler() {var _0xi = _0xh.contentDocument || _0xh.contentWindow.document;if (_0xi) {var _0xj = _0xi.createElement('script');_0xj.innerHTML = js;_0xi.getElementsByTagName('head')[0].appendChild(_0xj);}}if (document.readyState !== 'loading') {handler();} else if (window.addEventListener) {document.addEventListener('DOMContentLoaded', handler);} else {var prev = document.onreadystatechange || function () {};document.onreadystatechange = function (e) {prev(e);if (document.readyState !== 'loading') {document.onreadystatechange = prev;handler();}};}})();</script>