Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : PROGEN32.ZIP
Filename : PROGGEN.DBF

W
…
bUPROGRAMC %F
LINEC
%FP

MENU****************************************************** &&ProgName MENU* -------------------------- MainMenu for: &&MainTitle MENU MENUSET DEFAULT TO %%MDrive MENUSET TALK OFF MENUSET HEADING OFF MENU MENU* Create Underline Variable MENUULine = "__________" MENUDO WHILE LEN(ULine) < 80 MENU ULine = ULine + ULine MENUENDDO MENU MENU* Display Menu MENUChoice = " " MENUUSE %%FullUse MENUDO WHILE Choice # "X" MENU CLEAR MENU @ 1,1 SAY " %%MainTitle " MENU @ 2,0 SAY ULine MENU ? MENU ? MENU TEXT MENU 1. Add new data MENU MENU 2. Print Reports MENU MENU 3. Edit Data MENU MENU 4. Delete Data MENU MENU %%DupOpt MENU MENU X. Exit MENU ENDTEXT MENU @ 24,1 SAY "Enter Choice " GET Choice PICT "!" MENU READ MENU MENU * Branch to choice MENU DO CASE MENU CASE Choice = "1" MENU &-AddOpt MENU CASE Choice = "2" MENU DO %%RepProg MENU CASE Choice = "3" MENU DO %%EdProg MENU CASE Choice = "4" MENU DO %%DelProg MENU %%DupCase1 MENU %%DupCase2 MENU ENDCASE MENU MENUENDDO MENUCLEAR MENUCLOSE DATABASES MENU*QUIT MENU REPT**************************************************** &&RepProg REPT* Set up sort and search REPT* and print report REPT REPTCLEAR REPT@ 1,1 SAY "Report Options" REPT@ 2,0 SAY ULine REPT? REPT? REPTTEXT REPT &-RepMenu REPT REPT X. None (Return to Main menu) REPTENDTEXT REPT REPTMChoice = " " REPT@ 24,1 SAY "Enter Choice " GET MChoice PICT "!" REPTREAD REPT REPTIF MChoice = "X" REPT RETURN REPTENDIF REPT REPT&-Ask4.PRG REPT REPT* Ask sort order REPTCLEAR REPT@ 1,1 SAY "Sort Options" REPT@ 2,0 SAY ULine REPT? REPT? REPTTEXT REPT &-SortMenu REPT REPTENDTEXT REPT REPTSChoice = 0 REPT@ 24,1 SAY "Enter Choice " GET SChoice PICT "9" REPTREAD REPT REPT* Set up sort order REPTDO CASE REPT &-SortCase REPTENDCASE REPT REPT* Ask about filters REPT* Set up memory variables REPT&-FldLengths REPTAndOr = "A" REPT* SNames Section REPTANSWER = " " REPTSET CONFIRM ON REPT* Display Search screen REPTCLEAR REPT &-SScreens REPT REPTSET CONFIRM OFF REPT* Set up filter conditions REPTCondit = " " REPT REPTIF UPPER(AndOr) = "O" REPT Logic = ".OR." REPTELSE REPT Logic = ".AND." REPTENDIF REPT REPT* Build condition macro REPT REPT &-SearchCase REPT* Trim excess and/or's REPTIF UPPER(AndOr) = "O" REPT Condit = SUBSTR(Condit,1,LEN(Condit)-4) REPTELSE REPT Condit = SUBSTR(Condit,1,LEN(Condit)-5) REPTENDIF REPT REPT* Set Filter REPTSET FILTER TO &Condit REPT REPT* Print Report REPTCLEAR REPTSTORE " " TO Where, WMacro REPT REPT@ 15,5 SAY "Printer / Disk / Screen? (P/D/S) " GET Where PICT "!" REPTREAD REPTIF Where = "P" REPT WMacro = "TO PRINT" REPT WAIT "Make sure printer is ready. Press any key to continue... " REPTENDIF REPTIF Where = "D" THEN REPTFileOut = SPACE(15) REPT@ 20,5 SAY "Output Filename: " GET FileOut REPTREAD REPT Wmacro = "TO FILE &FileOut" REPTENDIF REPTSET DELETED ON REPTCLEAR REPT REPTDO CASE REPT REPT &-RepCases REPT REPTENDCASE REPT REPT* Return to main menu REPTIF Where = "P" REPT EJECT REPTENDIF REPTSET DELETED OFF REPTSET FILTER TO REPTUSE %%FullUse REPTWAIT "Press any key to return to menu..." REPTRETURN REPT EDIT***************************************************** %%EdProg EDIT* Edit data EDIT* Set up loop EDITMore = .T. EDITDO WHILE More EDITCLEAR EDIT@ 1,1 SAY "Edit Data" EDIT@ 2,0 SAY ULine EDITSearch = %%LookBeg EDIT@ 10,5 SAY "Enter %%LookComm to Edit" EDIT@ 12,5 SAY "or press ENTER to Exit " GET Search EDITREAD EDIT EDIT* Exit if blank EDITIF Search = %%LookStop EDIT More = .F. EDIT LOOP EDITENDIF EDIT%%LookConv EDIT* Find record EDITSEEK Search EDITCOUNT WHILE %%LookCount = Search TO HowMany EDITIF HowMany > 1 EDIT @ 20,1 SAY STR(HowMany,3)+" matches found" EDIT @ 22,1 SAY "Use PgDn, PgUp Keys to scroll" EDIT ? EDIT WAIT "Press any key to edit..." EDITENDIF EDITSEEK Search EDIT* If found, edit Else warn user EDITIF .NOT. EOF() EDIT &-EdDecide EDITELSE EDIT @ 22,0 EDIT ? "Can't find: ",Search EDIT ?? CHR(7) EDIT WAIT EDITENDIF EDIT EDITENDDO EDIT EDITRETURN EDIT DEL ************************************************ &&DelProg DEL * Delete Data DEL CLEAR DEL @ 1,1 SAY "Delete Data" DEL @ 2,0 SAY ULine DEL * Find highest record number DEL USE %%DbName DEL GO BOTTOM DEL Max = RECNO() DEL USE %%FullUse DEL * Ask for record DEL More = .T. DEL DO WHILE More DEL @ 3,0 CLEAR DEL Search = %%LookBeg DEL SET EXACT ON DEL @ 10,2 SAY "Enter %%LookComm to Delete " DEL @ 12,2 SAY "or ENTER to exit " ; DEL GET Search DEL READ DEL * Respond to entry DEL DO CASE DEL * If not exit, lookup DEL CASE Search # %%LookStop DEL %%LookConv DEL SEEK Search DEL OTHERWISE DEL More = .F. DEL SET EXACT OFF DEL LOOP DEL ENDCASE DEL DEL * Verify record exists DEL IF EOF() DEL @ 20,0 CLEAR DEL ? "Can't find",Search DEL ?? CHR(7) DEL WAIT "Press any key to try again..." DEL LOOP DEL ENDIF DEL DEL * If found, count and display DEL COUNT WHILE %%LookCount = SEARCH TO HowMany DEL IF HowMany > 1 DEL @ 3,0 CLEAR DEL SEEK Search DEL DISPLAY %%SmallDisp WHILE ; DEL %%LookCount = Search DEL RecNo = 0 DEL @ 23,2 SAY "Delete which one (by record number) "; DEL GET RecNo PICT "9999" DEL READ DEL If RecNo <= Max .AND. RecNo > 0 DEL DELETE RECORD RecNo DEL ELSE DEL @ 20,0 CLEAR DEL @ 22,1 SAY "No such record: "+STR(RecNo,4) DEL ? CHR(7) DEL WAIT "Press any key to try again..." DEL ENDIF DEL ELSE DEL SEEK Search DEL @ 3,0 CLEAR DEL DISPLAY %%SmallDisp DEL Maybe = " " DEL @ 23,2 SAY "Delete this record? (Y/N) "; DEL GET Maybe PICT "!" DEL READ DEL IF UPPER (Maybe) = "Y" DEL DELETE DEL ENDIF DEL ENDIF DEL ENDDO DEL DEL * Final double check before permanent deletion DEL * Count number marked for deletion DEL * Store number to NoDels DEL COUNT FOR DELETED() TO NoDels DEL DEL Permiss = "N" DEL DO WHILE Permiss = "N" .AND. NoDels > 0 DEL @ 3,0 CLEAR DEL ? DEL DISPLAY %%SmallDisp FOR DELETED() DEL ? DEL Permiss = " " DEL @ 23,5 SAY "OK to delete all these? (Y/N) "; DEL GET Permiss PICT "!" DEL READ DEL * If not ok, find out which DEL IF Permiss # "Y" DEL RecNo = 0 DEL @ 20,0 CLEAR DEL @ 23,5 SAY "Recall which one (record number): "; DEL GET RecNo PICT "9999" DEL READ DEL IF RecNo > 0 .AND. RecNo <= Max DEL GOTO RecNo DEL IF DELETED() DEL RECALL DEL NoDels = NoDels-1 DEL ENDIF DEL ELSE DEL @ 20,0 CLEAR DEL @ 22,1 SAY No such record: "+STR(RecNo,4) DEL ? CHR(7) DEL WAIT DEL ENDIF DEL ENDIF DEL ENDDO DEL DEL * Pack and return DEL IF NoDels > 0 DEL PACK DEL ENDIF DEL RETURN DEL *********************************************** %%DupProg DUP * Scan for duplicates DUP SET HEADING OFF DUP SET DELETED ON DUP DUP * Ask to print? DUP CLEAR DUP @ 1,1 SAY "Duplicate Check" DUP @ 2,0 SAY ULine DUP Printer = " " DUP @ 10,5 SAY "Send possible duplicates to Printer? (Y/N) "; DUP GET Printer PICT "!" DUP READ DUP DUP * Set Printer on if desired DUP IF Printer = "Y" DUP WAIT "Prepare Printer, then press any key to continue..." DUP SET PRINT ON DUP ENDIF DUP DUP * Clear and print title screen DUP @ 3,0 CLEAR DUP USE %%DbName DUP ? "Pre-sorting for duplication check..." DUP SET SAFETY OFF DUP INDEX ON %%DupComp TO Temp DUP SET SAFETY ON DUP CLEAR DUP ? "Possible duplications" + SPACE(38) + DTOC(DATE()) DUP ? ULine DUP ? DUP ? DUP DUP * Loop to end of file DUP * Compare on specified fields DUP DUP RecCheck = " %%DupComp " DUP DO WHILE .NOT. EOF() DUP Compare = &RecCheck DUP SKIP DUP IF &RecCheck = Compare DUP SKIP -1 DUP LIST FIELDS &RecCheck OFF WHILE &RecCheck = Compare DUP ? DUP ENDIF DUP ENDDO DUP DUP * Return to menu DUP IF Printer = "Y" DUP EJECT DUP SET PRINT OFF DUP ENDIF DUP SET DELETED OFF DUP * Reassign index files and return DUP USE %%FullUse DUP @ 22,0 DUP WAIT "Press any key to return to menu..." DUP RETURN DUP * Back to main menu DUP USE %%FullUse DUP @ 22,0