Liren Large Software Subsidy 5

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

/ Liren Large Software Subsidy 5 / 05.iso / a / a046 / 5.img / TEMPLATE / SSBAPPE.INC < prev next >

Wrap

Text File | 1992-04-01 | 6.9 KB | 284 lines

<<* SSBAPPE.INC *>> <<* (C) 1991 SHEN YANG WHITE HORSE SOFTWART COMPANY *>> <<# function fixfldini : string string strg begin strg := fldini if fldtyp = 'C' if not (strg[1] $ '["'+"'") strg := '"' + strg + '"' endif elsif fldtyp = 'L' if strg[1] <> '.' strg := '.' + strg + '.' endif endif RETURN strg end fixfldini procedure GenInitFlds begin select all genln( '* ---Initialize fields/memvars.' ) if not ismultials select database 1 select fields on fldini and (fldtyp $ 'CDLN') if fldtotal > 0 forall fields genln( 'STORE ',fixfldini,' TO ',fixfldnam ) endfor else genln( '* ---<none>.' ) endif else genln( 'DO CASE' ) forall databases filespec( dbfnam,fpath,fname,fext ) genln( 'CASE dbfarea = "',dbfcount,'"' ) pushmargin( 1 ) select fields on fldini and (fldtyp $ 'CDLN') if fldtotal > 0 forall fields genln( 'STORE ',fixfldini,' TO ',fixfldnam ) endfor else genln( '* ---╬▐╝╟┬╝' ) endif popmargin endfor genln( 'ENDCASE' ) endif end GenInitFlds #>> <<procedure AppendPages>> <<begin>> * ---Edit and page through the record. * ---The following loop is really a "REPEAT/UNTIL <cond>". DO WHILE .T. DO StatLine WITH LastRec+recnumOFS,IsDeleted @ 0,50 SAY "*┐╒ ░╫* " <<GenColor( 1,'SCREEN' )>> @ 23,0 CLEAR TO 24,79 @ 24,2 SAY '╩Σ╚δ╝╟┬╝╗≥░┤<Esc>╝ⁿ╖╡╗╪╤í╘±▓╦╡Ñ' DO {fileprefix}G <<if ismultials>> DO Page WITH pageno,1,dbfpagemax <<else>> DO Page WITH pageno,1,PageMax <<endif>> * ---Condition to exit inner loop. IF pageno = 1 EXIT ENDIF DO {fileprefix}F ENDDO <<if ismultials>> pageno = dbfpagemax <<endif>> <<end AppendPages>> <<procedure GenUniqueOne>> <<* Assumes one or more indexes *>> <<begin>> * ---Check for duplicate record. DO WHILE .T. <<GenColor( 1,'SCREEN' )>> @ 23,0 CLEAR TO 24,79 @ 24,2 SAY '╩Σ╚δ╝╟┬╝╗≥░┤<Esc>╝ⁿ╖╡╗╪╤í╘±▓╦╡Ñ' * ---Enter key field values. DO {fileprefix}K WITH expr,IsBlank,IsUnique IF IsBlank .OR. .NOT. IsUnique EXIT ENDIF * ---Check for duplicate key in master file. SEEK expr IF EOF() * ---No duplicate key found, so leave. EXIT ELSE * ---Found a duplicate record in the file. <<GenColor( 2,'STATUS' )>> @ 0,50 SAY "* ╔╛ │² *" DO SayLine WITH row,; "╣╪╝ⁿ╫╓╓╪╕┤, ╝╟┬╝▓╗─▄▒╗╘÷╝╙." WAIT ENDIF ENDDO <<end GenUniqueOne>> <<# procedure AppendWithEdit logical iswithndx begin iswithndx := false select all forall databases if ndxtotal > 0 iswithndx := true endif endfor #>> <<if iswithndx>> <<GenUniqueOne>> <<else>> * ---Enter key field values. <<GenColor( 1,'SCREEN' )>> @ 23,0 CLEAR TO 24,79 @ 24,2 SAY '╩Σ╚δ╝╟┬╝╗≥<Esc>╝ⁿ╖╡╗╪╤í╘±▓╦╡Ñ' DO {fileprefix}K WITH expr,IsBlank,IsUnique <<endif>> IF IsBlank IsDeleted = .T. ELSE <<if ismultipage>> <<pushmargin( 1 )>> <<AppendPages>> <<popmargin>> <<else>> DO {fileprefix}G <<endif>> ENDIF <<end AppendWithEdit>> <<procedure GenSBAppendBody>> <<string line>> <<integer count,ndxmax>> <<begin>> PRIVATE row,recnum,recnumOFS PRIVATE IsBlank,IsUnique,IsCarry,IsDeleted,IsEdited <<if ismultials>> <<GenPrivateFlds( 0 )>> <<endif>> * ---Initialize local memory variables. row = PromptRow recnumOFS = 0 STORE .F. TO IsBlank,IsUnique,IsCarry,IsDeleted,IsEdited expr = "" <<if not ismultipage>> DO {fileprefix}F <<endif>> * ---Start by adding one record. choice = "A" * ---The following loop is really a "REPEAT/UNTIL <cond>". DO WHILE .T. <<if ismultials and ismultipage>> * ---Start database file on correct page. DO CASE <<forall databases>> CASE dbfarea = {"}{dbfcount}{"} <<select field 1>> pageno = {fldpag} <<endfor>> ENDCASE <<endif>> <<if ismultipage>> DO {fileprefix}F <<endif>> IF (choice = "A") .OR. IsCarry * ---Add another record. recnumOFS = recnumOFS + 1 IF .NOT. IsCarry * ---Initialize memory variables with blanks. GOTO BOTTOM IF .NOT. EOF() SKIP ENDIF DO {fileprefix}S DO {fileprefix}T GOTO BOTTOM <<pushmargin( 3 )>> <<GenInitFlds>> <<popmargin>> ENDIF IsCarry = .F. ENDIF DO StatLine WITH LastRec+recnumOFS,IsDeleted @ 0,50 SAY "*┐╒ ░╫* " <<# pushmargin( 1 ) AppendWithEdit popmargin #>> DO StatLine WITH LastRec+recnumOFS,IsDeleted * ---Loop until Add, Carry, Edit, or Finished is selected. * ---The following loop is really a "REPEAT/UNTIL <cond>". menuchoice = 5 DO WHILE .T. * ---You can add other prompts and options in this inner loop. * ---For example, to add an invoicing routine: * * (1) Insert "{I}nvoice" in the prompt line below, * (2) Include "I" in the values for GetKey, and * (3) Add a CASE to the DO CASE structure, such as: * * CASE choice = "I" * DO <invoice_program_name> * <<* 1 2 3 4 5 6 7 0123456789012345678901234567890123456789012345678901234567890123456789012345678 ╤í╘±: 1.╩Σ╚δ╝╟┬╝ 2.╨»┤°╩Σ╚δ 3.╨▐╕─╩Σ╚δ 4.╔╛│²╩Σ╚δ 5.═╦ ╗╪ APPEND: Add-another Carry-add Edit <Del> Output *>> SET COLOR TO &promptatr @ 22,0 CLEAR TO 23,79 @ 23, 1 SAY "╤í╘±:" @ 23, 9 PROMPT "1.╩Σ╚δ╝╟┬╝" @ 23,23 PROMPT "2.╨»┤°╩Σ╚δ" @ 23,37 PROMPT "3.╨▐╕─╩Σ╚δ" @ 23,51 PROMPT "4.╔╛│²╩Σ╚δ" @ 23,65 PROMPT "5.╖╡ ╗╪" MENU TO menuchoice choice = SUBSTR("AACEDR",menuchoice+1,1) DO CASE CASE choice = "D" * ---Toggle IsDeleted flag. IsDeleted = .NOT. IsDeleted DO StatLine WITH LastRec+recnumOFS,IsDeleted CASE choice = "E" * ---Re-edit the record. IsDeleted = .F. CASE choice $ "ACR" * ---Finished, Add-another, or Carry-add. IsCarry = (choice = "C") IF IsDeleted * ---Reset offset so as not to increment. recnumOFS = recnumOFS - 1 ELSE * ---Save the memvar values. APPEND BLANK DO {fileprefix}R ENDIF <<if feat(featlabel)>> CASE choice = "O" * ---Print one label/record. <<pushmargin( 3 )>> <<GenOutputItems>> <<popmargin>> choice = "O" <<endif>> ENDCASE * ---Condition to exit inner loop. IF choice $ "ACER" EXIT ENDIF ENDDO * ---Condition to exit outer loop. IF choice = "R" EXIT ENDIF ENDDO LastRec = LastRec + recnumOFS GOTO TOP <<end>> <<*GenSBAppendBody*>> <<* EOF: SSBAPPE.INC *>>