home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a070 / 3.ddi / FOXPRO / TEMPLGEN / AP1APPE.INC < prev    next >
Encoding:
Text File  |  1988-02-11  |  7.7 KB  |  310 lines
  1. <<* APPAPPE.INC *>>
  2. <<#
  3.  
  4. function fixfldini : string
  5. string strg
  6. begin
  7.   strg := fldini
  8.   if fldtyp = 'C'
  9.     if not (strg[1] $ '["'+"'")
  10.       strg := '"' + strg + '"'
  11.     endif
  12.   elsif fldtyp = 'L'
  13.     if strg[1] <> '.'
  14.       strg := '.' + strg + '.'
  15.     endif
  16.   endif
  17.   RETURN strg
  18. end fixfldini
  19.  
  20.  
  21. procedure GenInitFlds
  22. begin
  23.   select all
  24.   genln( '* ---Initialize fields/memvars.' )
  25.   if not ismultials
  26.     select database 1
  27.     select fields on fldini and (fldtyp $ 'CDLN')
  28.     if fldtotal > 0
  29.       forall fields
  30.         genln( 'STORE ',fixfldini,' TO ',fixfldnam )
  31.       endfor
  32.     else
  33.       genln( '* ---<none>.' )
  34.     endif
  35.   else
  36.     genln( 'DO CASE' )
  37.     forall databases
  38.       filespec( dbfnam,fpath,fname,fext )
  39.       genln( 'CASE dbfarea = "',dbfcount,'"' )
  40.       pushmargin( 1 )
  41.       select fields on fldini and (fldtyp $ 'CDLN')
  42.       if fldtotal > 0
  43.         forall fields
  44.           genln( 'STORE ',fixfldini,' TO ',fixfldnam )
  45.         endfor
  46.       else
  47.         genln( '* ---<none>.' )
  48.       endif
  49.       popmargin
  50.     endfor
  51.     genln( 'ENDCASE' )
  52.   endif
  53. end GenInitFlds
  54. #>>
  55.  
  56.  
  57. <<procedure AppendPages>>
  58. <<begin>>
  59. * ---Edit and page through the record.
  60. * ---The following loop is really a "REPEAT/UNTIL <cond>".
  61. DO WHILE .T.
  62.    DO StatLine WITH LastRec+recnumOFS,IsDeleted
  63.    @ 0,50 SAY "*BLANK*  "
  64.    DO SayLine WITH row,"Press {Ctrl-W} to Exit"
  65.    DO {fileprefix}_GETS
  66.    <<if ismultials>>
  67.    DO Page WITH pageno,1,dbfpagemax
  68.    <<else>>
  69.    DO Page WITH pageno,1,PageMax
  70.    <<endif>>
  71.    * ---Condition to exit inner loop.
  72.    IF pageno = 1
  73.       EXIT
  74.    ENDIF
  75.    DO {fileprefix}_FORM
  76. ENDDO
  77. <<if ismultials>>
  78. pageno = dbfpagemax
  79. <<endif>>
  80. <<end AppendPages>>
  81.  
  82.  
  83. <<procedure GenUniqueOne>>  <<* Assumes one or more indexes *>>
  84. <<begin>>
  85. * ---Check for duplicate record.
  86. DO WHILE .T.
  87.    DO SayLine WITH row,"Press {Ctrl-W} to Exit"
  88.    * ---Enter key field values.
  89.    DO {fileprefix}_KEYS WITH expr,IsBlank,IsUnique
  90.    IF IsBlank .OR. .NOT. IsUnique
  91.       EXIT
  92.    ENDIF
  93.    * ---Check for duplicate key in master file.
  94.    SEEK expr
  95.    IF EOF()
  96.       * ---No duplicate key found, so leave.
  97.       EXIT
  98.    ELSE
  99.       * ---Found a duplicate record in the file.
  100.      <<GenColor( 2,'STATUS' )>>
  101.       @ 0,50 SAY "*DELETED*"
  102.       DO SayLine WITH row,;
  103.          "DUPLICATE KEY encountered.  Record cannot be appended."
  104.       WAIT
  105.    ENDIF
  106. ENDDO
  107. <<end GenUniqueOne>>
  108.  
  109.  
  110. <<#
  111. procedure AppendWithEdit
  112. logical iswithndx
  113. begin
  114.   iswithndx := false
  115.   select all
  116.   forall databases
  117.     if ndxtotal > 0
  118.       iswithndx := true
  119.     endif
  120.   endfor
  121. #>>
  122.   <<if iswithndx>>
  123.     <<GenUniqueOne>>
  124.   <<else>>
  125. * ---Enter key field values.
  126. DO SayLine WITH row,"Press {Ctrl-W} to Exit"
  127. DO {fileprefix}_KEYS WITH expr,IsBlank,IsUnique
  128.   <<endif>>
  129. IF IsBlank
  130.    IsDeleted = .T.
  131. ELSE
  132. <<if ismultipage>>
  133.    <<pushmargin( 1 )>>
  134.    <<AppendPages>>
  135.    <<popmargin>>
  136. <<else>>
  137.    DO {fileprefix}_GETS
  138. <<endif>>
  139. ENDIF
  140. <<end AppendWithEdit>>
  141.  
  142.  
  143. <<procedure GenAppendBody>>
  144. <<string line>>
  145. <<begin>>
  146. PRIVATE row,recnum,recnumOFS
  147. PRIVATE IsBlank,IsUnique,IsCarry,IsDeleted
  148. <<if ismultials>>
  149.   <<GenPrivateFlds( 0 )>>
  150. <<endif>>
  151. * ---Initialize local memory variables.
  152. row = PromptRow
  153. recnumOFS = 0
  154. STORE .F. TO IsBlank,IsUnique,IsCarry,IsDeleted
  155. expr = ""
  156. <<if not ismultipage>>
  157. DO {fileprefix}_FORM
  158. <<endif>>
  159. * ---Start by adding one record.
  160. choice = Returnkey
  161. * ---The following loop is really a "REPEAT/UNTIL <cond>".
  162. DO WHILE .T.
  163.   <<if ismultials and ismultipage>>
  164.    * ---Start database file on correct page.
  165.    DO CASE
  166.    <<forall databases>>
  167.    CASE dbfarea = {"}{dbfcount}{"}
  168.       <<select field 1>>
  169.       pageno = {fldpag}
  170.    <<endfor>>
  171.    ENDCASE
  172.   <<endif>>
  173.   <<if ismultipage>>
  174.    DO {fileprefix}_FORM
  175.   <<endif>>
  176.    IF (choice = Returnkey) .OR. IsCarry
  177.       * ---Add another record.
  178.       recnumOFS = recnumOFS + 1
  179.       IF .NOT. IsCarry
  180.          * ---Initialize memory variables with blanks.
  181.          GOTO BOTTOM
  182.          IF .NOT. EOF()
  183.             SKIP
  184.          ENDIF
  185.          DO {fileprefix}_SAYS
  186.          DO {fileprefix}_STOR
  187.          GOTO BOTTOM
  188.          <<pushmargin( 3 )>>
  189.          <<GenInitFlds>>
  190.          <<popmargin>>
  191.       ENDIF
  192.       IsCarry = .F.
  193.    ENDIF
  194.    DO StatLine WITH LastRec+recnumOFS,IsDeleted
  195.    @ 0,50 SAY "*BLANK*  "
  196. <<#
  197.    pushmargin( 1 )
  198.    AppendWithEdit
  199.    popmargin
  200. #>>
  201.    DO StatLine WITH LastRec+recnumOFS,IsDeleted
  202.    * ---Loop until Add, Carry, Edit, or Finished is selected.
  203.    * ---The following loop is really a "REPEAT/UNTIL <cond>".
  204. <<if LiteBar>>
  205.    menuchoice = 4
  206. <<endif>>
  207.    DO WHILE .T.
  208.       * ---You can add other prompts and options in this inner loop.
  209.       * ---For example, to add an invoicing routine:
  210.       *
  211.       *    (1) Insert "{I}nvoice" in the prompt line below,
  212.       *    (2) Include "I" in the values for GetKey, and
  213.       *    (3) Add a CASE to the DO CASE structure, such as:
  214.       *
  215.       *        CASE choice = "I"
  216.       *           DO <invoice_program_name>
  217.       *
  218. <<if LiteBar>>
  219. <<*
  220.           1         2         3         4         5         6
  221. 0123456789012345678901234567890123456789012345678901234567890123
  222. APPEND:   Add-another   Carry-add   Edit   Finished   <Del> "
  223. APPEND:   Add-another   Carry-add   Edit   Finished   Output  <Del> "
  224. *>>
  225.       SET COLOR TO &PromptAtr
  226.       @ row,0 CLEAR
  227.       @ row, 0 SAY "APPEND:"
  228.       @ row,10 PROMPT "Add-another"
  229.       @ row,24 PROMPT "Carry-add"
  230.       @ row,36 PROMPT "Edit"
  231.       @ row,43 PROMPT "Finished"
  232.   <<if feat(featlabel)>>
  233.       @ row,54 PROMPT "Output"
  234.       @ row,62 SAY "<Del>"
  235.       @ row,63 PROMPT "Del"
  236.   <<else>>
  237.       @ row,54 SAY "<Del>"
  238.       @ row,55 PROMPT "Del"
  239.   <<endif>>
  240.       MENU TO menuchoice
  241.   <<if feat(featlabel)>>
  242.       choice =SUBSTR( "F"+Returnkey+"CEFO"+DelRecord,menuchoice + 1,1 )
  243.   <<else>>
  244.       choice =SUBSTR( "F"+Returnkey+"CEF"+DelRecord,menuchoice + 1,1 )
  245.   <<endif>>
  246. <<else>>
  247. <<#
  248.   line := '"APPEND:  <Return>:add-another  {C}arry-add  {E}dit  {F}inished  <Del> "'
  249.         <<*1234567890123456789012345678901234567890123456789012345678901234567890*>>
  250.   if feat(featlabel)
  251.     line := stuff( line,66,0,'{O}utput  ' )   <<*insert*>>
  252.     line := stuff( line,23,8,'' )             <<*delete '-another'*>>
  253.   endif
  254.   if Simple
  255.     line := ChangePat( line,'{','(' )
  256.     line := ChangePat( line,'}',')' )
  257.   endif
  258. #>>
  259.       DO SayLine WITH row,;
  260.       {line}
  261.   <<if feat(featlabel)>>
  262.       DO GetKey WITH choice,"CEFO"+DelRecord+Returnkey
  263.   <<else>>
  264.       DO GetKey WITH choice,"CEF"+DelRecord+Returnkey
  265.   <<endif>>
  266. <<endif>>
  267.       DO CASE
  268.       CASE choice = DelRecord
  269.          * ---Toggle IsDeleted flag.
  270.          IsDeleted = .NOT. IsDeleted
  271.          DO StatLine WITH LastRec+recnumOFS,IsDeleted
  272.       CASE choice = "E"
  273.          * ---Re-edit the record.
  274.          IsDeleted = .F.
  275.       CASE choice $ "CF"+Returnkey
  276.          * ---Finished, Add-another, or Carry-add.
  277.          IsCarry = (choice = "C")
  278.          IF IsDeleted
  279.             * ---Reset offset so as not to increment.
  280.             recnumOFS = recnumOFS - 1
  281.          ELSE
  282.             * ---Save the memvar values.
  283.             APPEND BLANK
  284.             DO {fileprefix}_REPL
  285.          ENDIF
  286. <<if feat(featlabel)>>
  287.       CASE choice = "O"
  288.          * ---Print one label/record.
  289.          <<pushmargin( 3 )>>
  290.          <<GenOutputItems>>
  291.          <<popmargin>>
  292.          choice = "O"
  293. <<endif>>
  294.       ENDCASE
  295.       * ---Condition to exit inner loop.
  296.       IF choice $ "CEF"+Returnkey
  297.          EXIT
  298.       ENDIF
  299.    ENDDO
  300.    * ---Condition to exit outer loop.
  301.    IF choice = "F"
  302.       EXIT
  303.    ENDIF
  304. ENDDO
  305. LastRec = LastRec + recnumOFS
  306. GOTO TOP
  307. <<end>> <<*GenAppendBody*>>
  308.  
  309. <<* EOF: APPAPPE.INC *>>
  310.