Power-Programmierung

home *** CD-ROM | disk | FTP | other *** search

/ Power-Programmierung / CD1.mdf / xbase / library / clipper / debug / prg_help / prg_hlp.prg < prev next >

Wrap

Text File | 1987-04-07 | 36.7 KB | 1,403 lines

************************************************************************ * PRG_HLP.PRG version 1.2 * * S. ROBERT DAVIDOFF, D.M.D. * * November 1986 * ************************************************************************ * This program will allow you to make modifications in your .PRG * files and your database files from within your CLIPPER program. * It is a debugging tool that I designed to help me write my programs * more efficiently. I got tired of "jumping out" of my Clipper programs * to edit files and edit databases and make new databases, and use dflow * and Documentor to help me debug, and........ * In order to take maximum use of the program, you should have (AS IN * PURCHASE!!!) the following programs: * * THE NORTON EDITOR (NE) * NORTON UTILITIES DIRECTORY SORT (DS.COM) * DFLOW (WALLSOFT) * THE DOCUMENTOR (DOC) (WALLSOFT) * * You may, of course, substitute another editor for the Norton Editor and * you may choose to not use one or more of the other programs that I have * incorporated here, BUT to get maximum effect, I would suggest that you * purchase and use all of the programs... They were all designed as serious * adjuncts to serious programming. * * You can also link in DOT.PRG which comes on the Clipper Autmn disk. DOT * is supposed to do some of these things, but I found my program to be more * reliable and easier to operate. * * The beauty of this program is that you merely have to hit the F2 key * from any "Wait" state in your running clipper program and you can * Tinker with all the .prg files and databases without leaving clipper. * Make as many changes as you would like and then continue running your * clipper program. When your through debugging, simply recompile and your * in business! You can also make new databases as well as modifying old * ones from inside your Clipper program. ********************************************************************** * * CREDIT WHERE CREDIT IS DUE!!!! * ********************************************************************** * I wish to thank the DATABASED ADVISOR magazine from which some of my * better ideas eminate. This program is based on information from * DataBased Advisor, particularly J. Ari Kornfeld's article in the * December 1986 issue. I have consistently found this magazine to be * the best source of usefull information for my programming needs!!! ********************************************************************** ********************************************************************** * * BEFORE YOU BEGIN.... * ********************************************************************** * The calling program has to set the F2 key as follows: * * SET KEY -1 TO PRG_HLP * * This will activate this program from any "wait" state when the F2 key * is pressed. * * The variable "REPEAT", must be initialized by the calling program as * a PUBLIC variable (which is automatically set to .F.). This will prevent * a recurrsive call of this program. The parameters passed are the same as * the normal Clipper HELP program. * The PROCEDURES INDEX_H and REINDEX_ are set up for your specific programs. * I have included them here as demonsration modules. You have to set * then up for your own programs and you have to change them as you add or * subtract databases and/or indexes * ********************************************************************** * * PLEASE BE AWARE THAT THERE ARE STILL SOME BUGS IN THIS PROGRAM!!!! * I will release updates as they come along. * You are encouraged to make any modifications that you wish. I would hope * that any improvements generated will be thrown back into the public domaine * area so that others may use them..... * If you like the program or if you have any comments, please leave me a * message on the Source. * * Bob Davidoff * SOURCE ID: NA2066 ********************************************************************** ********************************************************************** parameters call_prg,Line_num,input_var MHLP_CODE = HELP_CODE HELP_CODE = "00" public hselection set console on PRIVATE MSEL,N,X if repeat && prevents recurrsive calls repeat = .F. return else repeat = .T. save screen to prghlp do while .T. @ 0,0 clear answer = space(1) ********************************************************************** * insert the version of clipper that you are using here * ********************************************************************** @ 1,4 say "AUTUMN VERSION" SET color to I do h_center with 1, call_prg + ".PRG" SET color to @ 1,60 say "MEMORY: [" + ALLTRIM(STR(memory(0))) + "]" msel = select() n = msel mdbf1 = space(1) row = 6 do while n > 0 if len(trim(H_dbf())) > 0 do Hs_select with n x = select() @ row,60 say "Select " @ row,col() say x row = row+1 @ row,65 say H_dbf() row = row+1 @ row,65 say "Record " +alltrim(str(recno())) row = row+1 n = n-1 else do Hs_select with n n = n-1 endif enddo do Hs_select with msel @ 5,59 to row,78 head1 = "1. NORTON EDITOR " head2 = "2. DFLOW " head3 = "3. DOCUMENTOR " head4 = "4. WHAT KEY " head5 = "5. NEWLY CHANGED PRG FILES " head6 = "6. MODIFY DBF FILES " head7 = "7. EDIT RECORDS IN DBF FILE" head8 = "8. CREATE A NEW DBF FILES " head9 = "9. COMPILE PROGRAM " head0 = "0. RETURN TO CLIPPER " Hnum_items = 10 HX = 7 HY = 23 HW = LEN(HEAD1) DO H_F1 WITH "HELP" @ 22,1 to 22,78 double @ 0,0 TO 24,79 DOUBLE @ 23,2 say "Use UP and DOWN arrows to highlight choice...Press ENTER to select" do h_lightbar with Hnum_items,HX,HY,HW,head1,head2,head3,head4,head5,head6,head7,head8,head9,head0 choice = str(hselection,1) do case case answer = "Q" clear quit case choice = "0" && RETURNS TO CLIPPER @ 0,0 clear repeat = .F. HELP_CODE = MHLP_CODE restore screen from prghlp return case choice = "1" && LOADS THE NORTON EDITOR mfile = "NE.COM" if .not. file(mfile) do hlp_mes with "YOU MUST HAVE THE NORTON EDITOR <NE.COM>" loop endif mfile = space(15) DO CLEARIT WITH 22,1,23,78 @ 22,1 accept "Enter name of file to edit..." to mfile if len(trim(mfile)) = 0 mfile = call_prg + ".prg" ! \ne + &mfile else X = AT(".",mfile) if X = 0 mfile = mfile + ".prg" ! \ne + &mfile else ! \ne + &mfile endif endif case choice = "2" && CALL DFLOW mfile = "DFLOW.COM" if .not. file(mfile) do hlp_mes with "YOU MUST HAVE WALLSOFT'S DFLOW <DFLOW.COM>" loop endif ! dflow case choice = "3" && CALL THE DOCUMENTOR mfile = "DOC.COM" if .not. file(mfile) do hlp_mes with "YOU MUST HAVE WALLSOFT'S DOCUMENTOR <DOC.COM>" loop endif ! doc case choice = "4" && CHECK INKEY VALUES do whatkey case choice = "5" && MAKES A BAT FILE TO COMPILE NEW PRG'S mfile = "DS.COM" if .not. file(mfile) do hlp_mes with "YOU MUST HAVE NORTON UTILITIES <DS.COM>" loop endif do H_make case choice = "6" && CHANGE A DBF FILE do dbf_chng case choice = "7" && EDIT A DBF FILE do srd_edit case choice = "8" && MAKE NEW DBF FILE do dbf_make case choice = "9" && COMPILE A SINGLE FILE mfile = "CLIPPER.EXE" if .not. file(mfile) do hlp_mes with "YOU MUST HAVE THE CLIPPER COMPILER <CLIPPER.EXE>" loop endif mfile = space(15) DO CLEARIT WITH 22,1,23,78 @ 22,1 accept "Enter name of file to Compile... " to mfile @ 0,0 clear if len(trim(mfile)) = 0 mfile = call_prg + "-m" ! clipper &mfile else mfile = mfile + "-m" ! clipper &mfile endif wait endcase enddo endif *********************************************************************** ********************************************************************** * PROCEDURE TO MODIFY DATABASE STRUCTURE procedure dbf_chng msel = select() n = msel mdbf1 = space(1) do while n > 0 if len(trim(H_dbf())) > 0 x = str(n,1) mdbf&x = H_dbf() mrec&x = recno() n = n-1 select n else mdbf&x = space(1) n = n-1 select n endif enddo close databases clear gets do while .T. do while .T. @ 0,0 clear mname = space(8) @ 0,10 dir *.dbf @ 20,35 say "Enter name of DBF file..." get mname picture "@!" read if len(trim(mname)) = 0 ? do index_H n = msel do while n > 0 x = str(n,1) if len(trim(mdbf&x)) > 0 select n mdbf = mdbf&x use &mdbf mrec = mrec&x goto mrec n = n-1 else n = n-1 endif enddo return endif mname = trim(mname) first = mname + ".DBF" if .not. file(first) ? first + " not found" WAIT loop else exit endif enddo use &mname copy to teststru structure extended use teststru copy to testasci SDF ! ne testasci.txt @ 0,0 clear do h_center with 12, "working..." second = mname + ".BAK" erase &second rename &first to &second use teststru zap append from testasci SDF create &mname from teststru append from &second @ 0,0 clear nnn = 1 for nnn = 1 to fcount() ? fieldname(nnn) next close databases erase &second erase teststru.dbf erase testasci.txt enddo ********************************************************************** * PROCEDURE TO CREAT A NEW DBF FILE procedure dbf_make msel = select() clear gets do while .T. do while .T. @ 0,0 clear mname = space(8) @ 0,10 dir *.dbf @ 20,35 say "Enter name of DBF file..." get mname picture "@!" read if len(trim(mname)) = 0 select msel return endif mname = trim(mname) first = mname + ".DBF" if file(first) ? first + " already exists" WAIT loop else exit endif enddo create TEST1 list * select (0) use TEST1 copy to teststru structure extended use teststru copy to testasci SDF ! ne testasci.txt @ 0,0 clear do h_center with 12, "working..." use teststru zap append from testasci SDF create &mname from teststru @ 0,0 clear nnn = 1 for nnn = 1 to fcount() ? fieldname(nnn) IF nnn = 22 inkey(0) @ 0,0 clear endif next inkey(0) @ 0,0 clear answer = space(1) @ 10,20 say "Do you want to add index files now? " get answer Picture "!" read if answer = "Y" use &mname do while .T. store space(8) to mindex store space(10) to mfield @ 10,20 say "Enter field to index on:" @ 10,50 get mfield Picture "@!" @ 11,20 say "Enter index name:" @ 11,50 get mindex Picture "@!" read if len(trim(mindex)) = 0 .or. len(trim(mfield)) = 0 exit else index on &mfield to &mindex endif enddo endif close databases erase test1.dbf erase teststru.dbf erase testasci.txt enddo ********************************************************************** * EDIT DBF RECORDS AND CHECK MEMORY VARIABLES procedure srd_edit call cursw with "ON" do while .T. @ 0,0 clear head1 = "1. EDIT MEMVARS" head2 = "2. EDIT RECORDS" head3 = "3. EDIT NEW DBF" head4 = "0. MAIN MEN " head5 = "XXXX" head6 = "XXXX" head7 = "XXXX" head8 = "XXXX" head9 = "XXXX" head0 = "XXXX" Hnum_items = 4 HX = 7 HY = 25 HW = LEN(HEAD1) @ 22,1 to 22,78 double @ 0,0 to 24,79 double @ 23,2 say "Use UP and DOWN arrows to highlight choice...Press ENTER to select" do h_lightbar with Hnum_items,HX,HY,HW,head1,head2,head3,head4,head5,head6,head7,head8,head9,head0 choice = str(hselection,1) do case case choice = "0" return case choice = "1" do while .T. do clearit with 1,1,23,78 mvar = space (10) @ 10,10 say "Enter the name of the memory variable: " get mvar Picture "@!" read @ 15,20 say "The memory variable " + mvar + " is: " set color to I @ 15,col() say &mvar set color to HMSG1 = "1. DO ANOTHER" HMSG2 = "0. MENU " HMSG3 = "XXXX" HMSG4 = "XXXX" HMSG5 = "XXXX" HMSG6 = "XXXX" HMSG7 = "XXXX" HMSG8 = "XXXX" HMSG9 = "XXXX" HMSG0 = "XXXX" HNUM_ITEMS = 2 HX = 23 HY = 1 HW = LEN(HMSG1) HMSTRING = "DM" DO CLEARIT WITH X-1,Y,X,78 @ X-1,1 to x-1,78 double DO HH_LIGHT WITH HNUM_ITEMS,HX,HY,HW,HMSG1,HMSG2,HMSG3,HMSG4,HMSG5,HMSG6,HMSG7,HMSG8,HMSG9,HMSG0,HMSTRING CHOICE = STR(hselection,1) if CHOICE = "0" EXIT endif enddo case choice = "2" if reccount() = 0 ? "No records found" inkey(6) return endif mfirrec = recno() msel = select() n = msel do while .T. mexit = .F. mdbf1 = space(1) clear gets mdelete = .F. do while .T. @ 0,0 clear private x,y,z,n n = 1 row = 1 if eof() skip-1 endif do while .not. eof() @ 1,0 say reccount() @ 2,0 say recno() for n = 1 to fcount() do case case n < 10 x = str(n,1) case n < 100 x = str(n,2) case n > 99 x = str(n,3) endcase mfield = fieldname(n) @ row,10 say fieldname(n) @ row,45 get &mfield row = row+1 if row > 20 read @ 0,0 clear row = 1 endif next read row = 1 HMSG1 = "DELETE " HMSG2 = "EDIT " HMSG3 = "PREVIOUS" HMSG4 = "NEXT " HMSG5 = "SELECT " HMSG6 = "MENU " HMSG7 = "XXXX" HMSG8 = "XXXX" HMSG9 = "XXXX" HMSG0 = "XXXX" HNUM_ITEMS = 6 HX = 23 HY = 1 HW = LEN(HMSG1) HMSTRING = "DEPNSM" DO CLEARIT WITH X-1,Y,X,78 @ X-1,1 to X-1,78 double DO HH_LIGHT WITH HNUM_ITEMS,HX,HY,HW,HMSG1,HMSG2,HMSG3,HMSG4,HMSG5,HMSG6,HMSG7,HMSG8,HMSG9,HMSG0,HMSTRING CHOICE = STR(hselection,1) do case case choice = "0" mexit = .T. exit case upper(choice) = "1" delete mdelete = .T. skip case upper(choice) = "4" skip case Upper(choice) = "3" skip - 1 case choice = "5" n = select() @ 0,0 clear @ 8,10 say "present select area is : " + str(n,1) @ 10,10 say "Enter new select area: " get n read do hs_select with n @ 12,10 say "New SELECT area is: " x = select() @ 12,col() say x @ 14,10 say "The DBF file is: " m_dbf = H_dbf() @ 14,col() say m_dbf inkey(8) endcase @ 0,0 clear if eof() .or. bof() @ 10,10 say "NO MORE RECORDS" INKEY(7) mexit = .T. EXIT endif enddo if mdelete pack endif do hs_select with msel goto mfirrec if mexit exit endif enddo if mexit exit endif enddo case choice = "3" msel = select() n = msel mdbf1 = space(1) do while n > 0 if len(trim(H_dbf())) > 0 x = str(n,1) mdbf&x = H_dbf() mrec&x = recno() n = n-1 select n else mdbf&x = space(1) n = n-1 select n endif enddo close databases clear gets mdelete = .F. do while .T. do while .T. @ 0,0 clear mname = space(8) @ 0,10 dir *.dbf @ 20,35 say "Enter name of DBF file..." get mname picture "@!" read if upper(trim(mname)) = "Q" n = msel do while n > 0 x = str(n,1) if len(trim(mdbf&x)) > 0 select n mdbf = mdbf&x use &mdbf mrec = mrec&x goto mrec n = n-1 else n = n-1 endif enddo return endif if len(trim(mname)) = 0 DO CLEARIT WITH 10,10,20,70 ANSWER = SPACE(1) @ 14,20 SAY "DO YOU WISH TO REINDEX THE FILES (Y/N)..." GET ANSWER PICTURE "!" @ 10,10 TO 20,70 DOUBLE READ IF ANSWER = "Y" do reindex_ ? ? "reindexing..." ENDIF n = msel do while n > 0 x = str(n,1) if len(trim(mdbf&x)) > 0 select n mdbf = mdbf&x use &mdbf goto mrec&x n = n-1 else n = n-1 endif enddo return endif mname = trim(mname) first = mname + ".DBF" if .not. file(first) ? first + " not found" WAIT loop else exit endif enddo @ 0,0 clear use &mname goto top private x,y,z,n n = 1 row = 1 do while .not. eof() @ 1,0 say reccount() @ 2,0 say recno() for n = 1 to fcount() x = iif(n > 10,str(n,1),str(n,2)) mfield = fieldname(n) @ row,10 say fieldname(n) @ row,45 get &mfield row = row+1 if row > 20 read @ 0,0 clear row = 1 endif next read row = 1 answer = space(1) HMSG1 = "DELETE " HMSG2 = "EDIT " HMSG3 = "PREVIOUS" HMSG4 = "NEXT " HMSG5 = "MENU " HMSG6 = "XXXX" HMSG7 = "XXXX" HMSG8 = "XXXX" HMSG9 = "XXXX" HMSG0 = "XXXX" HNUM_ITEMS = 5 HX = 23 HY = 1 HW = LEN(HMSG1) HMSTRING = "DEPNM" DO CLEARIT WITH X-1,Y,X,78 @ X-1,1 to X-1,78 double DO HH_LIGHT WITH HNUM_ITEMS,HX,HY,HW,HMSG1,HMSG2,HMSG3,HMSG4,HMSG5,HMSG6,HMSG7,HMSG8,HMSG9,HMSG0,HMSTRING CHOICE = STR(hselection,1) do case case choice = "0" exit case upper(choice) = "D" delete mdelete = .T. skip case upper(choice) = "N" skip case Upper(choice) = "P" skip - 1 endcase @ 0,0 clear enddo if mdelete pack endif use enddo endcase enddo ********************************************************************** * you must of course set this procedure up to make your indexes * ********************************************************************** procedure index_h DO WHILE .t. @ 23,0 clear @ 23,1 ?? "working..." ********************************************************************** * THIS HAS TO BE HARD-CODED BY YOU TO CREAT YOUR INDEX FILES * ********************************************************************** use done.dbf index on str(year(date1),4)+str(month(date1),2)+str(day(date1),2) to done1 index on str(year(date2),4)+str(month(date2),2)+str(day(date2),2) to done2 index on str(year(date3),4)+str(month(date3),2)+str(day(date3),2) to done3 use audio index on title to a_title index on lastname to a_artist use return enddo ********************************************************************** procedure reindex_ do while .t. ?? "working..." use ********************************************************************** * YOU MUST OF COURSE SET THIS PROCEDURE UP TO REINDEX YOUR FILES * ********************************************************************** use done.dbf set index to done1, done2, done3 reindex use audio set index to a_title, a_artist reindex use RETURN ENDDO ********************************************************************** procedure h_center Parameters row, string @ row,(78-len(string))/2 say string return ********************************************************************** procedure h_choice Parameters INSTRUCTION, RANGE @ 22,1 to 22,78 double choice = " " do while .not. choice $ RANGE @23,2 wait INSTRUCTION to choice enddo return ********************************************************************** * WHATKEY * ********************************************************************** * PLEASE NOTE THAT THIS PROCEDURE WAS NOT WRITTEN BY ME. iT WAS TAKEN* * OFF OF THE CLIPPER SIG ON THE SOURCE. * ********************************************************************** PROCEDURE WHATKEY @ 0,0 CLEAR toggle = 1 && 1=Clipper INKEY() 0=PC keyboard do MBAN with "WHAT KEY" @ 8,2 SAY 'IBM PC Keyboard Output' @ 8,42 SAY 'Clipper INKEY() Function Output' @ 9,2 to 21,35 @ 9,42 to 21,75 @ 0,0 TO 24,79 DOUBLE @ 11,65 SAY 'Dec Hex' && Fill Clipper box with prompts @ 13,45 SAY 'Clipper INKEY(): ' @ 15,45 SAY 'Printed character: ' @ 22,42 SAY '<Alt-T> to Toggle to IBM output' @ 23,42 SAY '<Alt-Q> to Quit' @ 15,65 SAY '' key = 0 DO WHILE .NOT.((toggle=1.AND.key=272) .OR. (toggle=0.AND.key=4096)) && <Alt-Q> key = 0 IF toggle = 1 && Get/display Clipper key output trash = INKEY(0) key = LASTKEY() IF key>=0 hex_str = DECTOHEX(key) ELSE hex_str=' ' ENDIF hex_str = SUBSTR('0000'+hex_str,LEN(hex_str)+1,4) @ 13,62 SAY STR(key,6)+' '+hex_str @ 15,65 SAY CHR(key) ELSE && Get/display PC key output key = PCKEY() hex_str = DECTOHEX(key) hex_str = SUBSTR('0000'+hex_str,LEN(hex_str)+1,4) @ 13,21 SAY STR(INT(key/256),6)+' '+SUBSTR(hex_str,1,2) @ 16,21 SAY STR(key%256,6)+' '+SUBSTR(hex_str,3,2) @ 19,25 SAY CHR(key%256) ENDIF :toggle=1 IF (toggle=1.AND.key=276) .OR. (toggle=0.AND.key = 5120) && <Alt-T> trash = INKEY(1) && Let user glimpse Alt-T toggle char output toggle = 1 - toggle && Toggle to other state, 1-to-0 or 0-to-1 IF toggle = 1 @ 9,2 to 21,35 @ 11,65 SAY 'Dec Hex' && and paint prompts in PC box @ 13,45 SAY 'Clipper INKEY(): ' @ 15,45 SAY 'Printed character: ' @ 22,0 @ 23,0 @ 22,42 SAY '<Alt-T> to Toggle to IBM output' @ 23,42 SAY '<Alt-Q> to Quit' @ 15,65 SAY '' ELSE @ 9,42,21,75 BOX empty_frame && Blank the INKEY() box to show PC @ 11,24 SAY 'Dec Hex' && and paint prompts in INKEY() box @ 13,5 SAY 'Auxiliary byte: ' @ 14,6 SAY '(scan code)' @ 16,5 SAY 'Main byte: ' @ 17,6 SAY '(ASCII value)' @ 19,5 SAY 'Printed character: ' @ 22,0 @ 23,0 @ 22,2 SAY '<Alt-T> to Toggle to Clipper output' @ 23,2 SAY '<Alt-Q> to Quit' @ 19,25 SAY '' ENDIF :toggle = 1 ENDIF :toggle.AND.key .OR. toggle.AND.key ENDDO :toggle.AND.key .OR. toggle.AND.key @ 22,0 CLEAR RETURN FUNCTION DECTOHEX * * Syntax: DECTOHEX(<expN>) * Return: <expC>, a string consisting of as many hexadecimal digits * as required to represent in hex the value of the input * PRIVATE dec,hex_str,power,no_times PARAMETERS dec hex_str = '' power = 0 DO WHILE INT( dec/(16^(power+1)) ) > 0 && find highest dividable power = power + 1 && power of 16 ENDDO DO WHILE power >= 0 && find how many of each no_times = INT(dec/(16^power)) hex_str = hex_str + IF(no_times<10,CHR(48+no_times),CHR(55+no_times)) dec = dec - no_times * (16^power) power = power - 1 ENDDO RETURN(hex_str) ********************************************************************** procedure MBAN Parameter BANNER clear @ 2,2 say cdow(date()) @ 2,(78-len(banner))/2 say banner @ 2,78-len(cdate) say cdate @ 3,1 to 3,78 double return ********************************************************************** procedure Hs_select parameter sel_num do case case sel_num = 1 select 1 case sel_num = 2 select 2 case sel_num = 3 select 3 case sel_num = 4 select 4 case sel_num = 5 select 5 case sel_num = 6 select 6 case sel_num= 7 select 7 case sel_num=8 select 8 case sel_num=9 select 9 endcase return ********************************************************************** procedure h_lightbar parameters Hitems,hx1,hy1,hwidth,hentry1,hentry2,hentry3,hentry4,hentry5,hentry6,hentry7,hentry8,hentry9,hentry10 answer = space(1) store hx1 to hx1m store hy1 to hy1m CALL CURSW WITH "OFF" * display menu and process the keys pressed * set color to I @ hx1m,hy1m to (hx1m+1+hitems),(hy1m+hwidth+1) double set color to * Enter menu lines to screen * for hn=1 to Hitems && FOR-NEXT LOOP hnstring = iif(hn = 10,str(hn,2),str(hn,1)) hmenu_line = iif(hentry&hnstring = "XXXX",space(hwidth),hentry&hnstring) @ hx1+hn,hy1+1 say hmenu_line next hn=hx1+1 hk=1 hcontrol= .T. do while hcontrol=.T. hkstring = iif(hk = 10,str(hk,2),str(hk,1)) store hentry&hkstring to hmenu_line * display current inverse lightbar * set color to I @ hn,hy1+1 say upper(hmenu_line) * wait for key to be pressed * hselection = 0 do while hselection=0 hselection=inkey() enddo * redisplay hilite area back to normal * if hselection<>13 set color to @ hn,hy1+1 say upper(hmenu_line) endif do case * Q was pressed * case hselection = 113 .or. hselection = 81 answer = "Q" exit * down arrow was pressed * case hselection=24 hk=hk+1 hn=hn+1 if hk>items hn=hx1+1 hk=1 endif loop * up arrow was pressed * case hselection=5 hk=hk-1 hn=hn-1 if hk<1 hn=hx1+hitems hk=hitems endif loop * Home or page up was pressed * case hselection = 1 .or. hselection = 18 hk=1 hn=hx1+1 loop * End or page down was pressed * case hselection = 6 .or. hselection = 3 hk = hitems hn = hx1+hitems loop * F1 was pressed * case hselection = 28 do help with A, B, C loop case hselection = 48 && 0 key pressed hk=0 hcontrol=.F. loop case hselection = 49 && 1 key pressed hk=1 hcontrol=.F. loop case hselection = 50 && 2 key pressed hk=2 hcontrol=.F. loop case hselection = 51 && 3 key pressed IF 3 > hitems loop endif hk=3 hcontrol=.F. loop case hselection = 52 && 4 key pressed IF 4 > hitems loop endif hk=4 hcontrol=.F. loop case hselection = 53 && 5 key pressed IF 5 > hitems loop endif hk=5 hcontrol=.F. loop case hselection = 54 && 6 key pressed IF 6 > hitems loop endif hk=6 hcontrol=.F. loop case hselection = 55 && 7 key pressed IF 7 > hitems loop endif hk=7 hcontrol=.F. loop case hselection = 56 && 8 key pressed IF 8 > hitems loop endif hk=8 hcontrol=.F. loop case hselection = 57 && 9 key pressed IF 9 > hitems loop endif hk=9 hcontrol=.F. loop * <cr> was pressed * case hselection=13 hcontrol=.F. loop endcase enddo if hk >= hitems hselection = 0 else hselection=hk endif * return video attributes to normal * set color to CALL CURSW WITH "ON" return PROCEDURE HH_LIGHT parameters hitems,hx1,hy1,hwidth,hentry1,hentry2,hentry3,hentry4,hentry5,hentry6,hentry7,hentry8,hentry9,hentry10,hlstring answer = space(1) hwidth = hwidth + 4 hmlength = hitems * hwidth hy1 = (78-hmlength)/2 set color to * Enter menu lines to screen * CALL CURSW WITH "OFF" hN = 1 DO WHILE hN <= hitems hnstring = iif(hn = 10,str(hn,2),str(hn,1)) hmenu_line = iif(hentry&hnstring = "XXXX",space(hwidth),hentry&hnstring) @ hx1,hy1+(hN*hWIDTH)-hwidth say hmenu_line hN = hN + 1 ENDDO hn=1 hk=1 hcontrol= .T. do while hcontrol hkstring = iif(hk = 10,str(hk,2),str(hk,1)) store hentry&hkstring to hmenu_line * display current inverse lightbar * set color to I @ hX1,hy1+(hN*hwidth)-hwidth say trim(upper(hmenu_line)) * wait for key to be pressed * hselection = 0 do while hselection=0 hselection=inkey() enddo * redisplay hilite area back to normal * if hselection<>13 set color to @ hX1,hy1+(hN*hwidth)-hwidth say trim(upper(hmenu_line)) endif do case * right arrow was pressed * case hselection=4 hk=hk+1 hn=hn+1 if hk>hitems hn=1 hk=1 endif loop * left arrow was pressed * case hselection=19 hk=hk-1 hn=hn-1 if hk<1 hn=hitems hk=hitems endif loop * Home was pressed * case hselection = 1 hk=1 hn=1 loop * End was pressed * case hselection = 6 hk = hitems hn = hitems loop * F1 was pressed * case hselection = 28 do help with A, B, C loop case hselection = 48 && 0 key pressed hk=0 hcontrol=.F. loop case hselection = 49 && 1 key pressed hk=1 hcontrol=.F. loop case hselection = 50 && 2 key pressed hk=2 hcontrol=.F. loop case hselection = 51 && 3 key pressed IF 3 > hitems loop endif hk=3 hcontrol=.F. loop case hselection = 52 && 4 key pressed IF 4 > hitems loop endif hk=4 hcontrol=.F. loop case hselection = 53 && 5 key pressed IF 5 > hitems loop endif hk=5 hcontrol=.F. loop case hselection = 54 && 6 key pressed IF 6 > hitems loop endif hk=6 hcontrol=.F. loop case hselection = 55 && 7 key pressed IF 7 > hitems loop endif hk=7 hcontrol=.F. loop case hselection = 56 && 8 key pressed IF 8 > hitems loop endif hk=8 hcontrol=.F. loop case hselection = 57 && 9 key pressed IF 9 > hitems loop endif hk=9 hcontrol=.F. loop * <cr> was pressed * case hselection=13 hcontrol=.F. loop case upper(chr(hselection)) $ hlstring hmpos = AT((upper(chr(hselection))),hlstring) hk = hmpos exit endcase enddo if hk >= hitems hselection = 0 else hselection=k endif * return video attributes to normal * set color to CALL CURSW WITH "ON" return ********************************************************************** Procedure H_F1 && help box parameter string private mlen string = "F1- " + string mlen = len(trim(string)) @ 19,(37 - (mlen/2)) to 21,(42 + (mlen/2)) set color to I @ 20,(39-(mlen/2)) say space(mlen+2) @ 20,(40-(mlen/2)) say string set color to return ********************************************************************** FUNCTION H_DBF * Syntax: DBF() * Return: The alias of the currently selected database. * Note..: Supposed to return the name of the currently selected database file. * RETURN ALIAS() ********************************************************************** * H_MAKE * ********************************************************************** *This program will set up a BAT file for linking newly changed PRG files PROCEDURE H_MAKE @ 0,0 clear do clearit with 1,1,23,78 mrunfile = space(8) @ 10, 10 say "Enter the name of the Run File:" get mrunfile Picture "@!" read @ 0,0 to 24,79 double do center with 13, "working..." set console off @ 15,20 ! ds d-t- set console on do clearit with 1,1,23,78 @ 0,0 to 24,79 double do center with 20, "Creating temporary files..." set console off !dir >newtemp.txt set console on use mfile = "linkfile.dbf" if file(mfile) use linkfile.dbf else create mm_lunk append blank replace field_name with "FILENAME" replace field_type with "C" replace field_len with 60 replace field_dec with 0 create lunk from mm_lunk use erase mm_lunk.dbf rename lunk.dbf to linkfile.dbf use linkfile.dbf endif zap append from newtemp SDF goto top counter = 1 mfile = space(8) do while .not. eof() if substr(filename,10,3) = "EXE" .and. substr(filename,1,8) = mrunfile counter = counter - 1 exit else if substr(filename,10,3) = "PRG" x = iif(counter > 9, str(counter,2),str(counter,1)) mfile&x = substr(filename,1,8) counter = counter + 1 endif endif skip enddo if counter > 0 do center with 20, "Creating batch file........" mmfile = "temp_lnk.dbf" if file(mmfile) use temp_lnk else create temp_lnk append blank replace field_name with "FILENAME" replace field_type with "C" replace field_len with 60 replace field_dec with 0 create mm_lnk from temp_lnk use erase temp_lnk.dbf rename mm_lnk.dbf to temp_lnk.dbf use temp_lnk endif zap err = "> err" for y = 1 to counter append blank x = iif(y > 9,str(y,2),str(y,1)) replace filename with "If not errorlevel 1 clipper @" + mfile&x + " > err" + x next append blank replace filename with "if not errorlevel 1 link @all.lnk" append blank copy to newfile sdf mfile = "new.bat" if file(mfile) erase new.bat endif rename newfile.txt to new.bat erase newfile.txt erase newtemp.txt use temp_lnk.dbf zap use linkfile.dbf zap use endif if counter > 0 do clearit with 1,1,23,78 do center with 5, "The file `NEW.BAT' has been created" row = 7 type new.bat inkey(0) clear else do center with 20, "No new PRG files have been created!..." @ 20,5 say "Enter any key to return to menu..." inkey(0) clear endif return *********************************EOF********************************