home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a040 / 2.ddi / SHRWARE4.ARC / MSAGETS.INC < prev    next >
Encoding:
Text File  |  1988-06-03  |  3.1 KB  |  146 lines
  1. <<* APPGETS.INC *>>
  2. <<#
  3.  
  4. procedure GenValidSeek( expr : string )
  5. begin
  6. #>>
  7. IsValid = .F.
  8. <<if ismultials>>
  9. DO VLOOKUP WITH dbfarea,{expr},IsValid
  10. <<else>>
  11. DO VLOOKUP WITH "A",{expr},IsValid
  12. <<endif>>
  13. DO WHILE .NOT. IsValid
  14. <<#
  15.   pushmargin( 1 )
  16.   GenColorAtr
  17.   gen( rtrim( getFIELD( AutoMem ) ) )
  18.   if fldran
  19.     gen( ' RANGE ',fldran )
  20.   endif
  21.   genln
  22.   popmargin
  23. #>>
  24.    READ
  25.    <<if ismultials>>
  26.    DO VLOOKUP WITH dbfarea,{expr},IsValid
  27.    <<else>>
  28.    DO VLOOKUP WITH "A",{expr},IsValid
  29.    <<endif>>
  30. ENDDO
  31. <<end GenValidSeek>>
  32.  
  33.  
  34. <<procedure GenValidLoop( expr : string )>>
  35. <<string rowstr>>
  36. <<begin>>
  37.   <<rowstr := '@ PromptRow,0'>>
  38. DO WHILE .NOT. ({expr})
  39.   <<GenColor( 1,'PROMPT' )>>
  40.    {rowstr} CLEAR
  41.   <<if fldusr>>
  42.    {rowstr} SAY [{fldusr}]
  43.   <<else>>
  44.    {rowstr} SAY "INVALID DATA.  Please re-enter."
  45.   <<endif>>
  46. <<#
  47.   pushmargin( 1 )
  48.   GenColorAtr
  49.   gen( rtrim( getFIELD( AutoMem ) ) )
  50.   if fldran
  51.     gen( ' RANGE ',fldran )
  52.   endif
  53.   genln
  54.   popmargin
  55. #>>
  56.    READ
  57. <<GenColor( 1,'PROMPT' )>>
  58.    {rowstr} CLEAR
  59. ENDDO
  60. <<end GenValidLoop>>
  61.  
  62.  
  63. <<#
  64. procedure GenValidCheck   <<* VALID() loop for versions  *>>
  65. string expr,token
  66. integer pos
  67. begin
  68.   expr := fldval
  69.   token := "VLU("     <<*VLOOKUP keyword*>>
  70.   pos := at( token,upper(expr) )
  71.   if pos > 0
  72.     expr := substr( expr,pos,255 )
  73.     if expr[ len(expr) ] = ")"
  74.       expr := rtrim( left( expr,len(expr) - 1 ) )   <<*delete rparen*>>
  75.     endif
  76.     expr := stuff( expr,1,len(token),"" )  <<*delete keyword*>>
  77.     pos := at( ',',expr )
  78.     expr := left( expr,pos ) + fixautomem( substr( expr,pos+1,255 ) )
  79.     GenValidSeek( expr )
  80.   else  <<*Normal VALID expression*>>
  81.     GenValidLoop( fixautomem(expr) )   <<*Insert fldprefix*>>
  82.   endif
  83. end GenValidCheck
  84.  
  85.  
  86. procedure WriteGetFlds
  87. logical IsSomeValid,IsReadNeeded
  88. begin
  89.   forecolor := 32000  <<*For GenColorAtr() procedure*>>
  90.   backcolor := 32000
  91.   IsReadNeeded := false
  92.   IsSomeValid := false
  93.   forall (fldcal = '')
  94.     IsReadNeeded := true
  95.     GenColorAtr
  96.     genFIELD
  97.   endfor
  98.   if IsReadNeeded
  99.     genln( 'READ' )  <<*Read the last alias selected*>>
  100.   endif
  101.   if IsSomeValid
  102.     forecolor := 32000
  103.     backcolor := 32000
  104.     forall fldval
  105.       GenValidCheck
  106.     endfor
  107.   endif
  108. end WriteGetFlds
  109.  
  110.  
  111. procedure GenGetsBody
  112. begin
  113.   select on databases,fields,pages
  114.   select fields on fldget and (fldtyp $ 'CDLMN')
  115.   if ndxtotal > 0
  116.     select index 1  <<*---Use the first index as MASTER index---*>>
  117.     select fields on not (upper(fldnam) $ upper(ndxkey))
  118.   endif
  119.   genln( '?? SYS(2002,1)  && TURN CURSOR ON' )
  120.   if ismultipage
  121.     if fldtotal > 0
  122.       genln( 'DO CASE' )
  123.       forall pages
  124.         if fldtotal > 0
  125.           genln( 'CASE pageno=',pagcount )
  126.           pushmargin( 1 )
  127.           WriteGetFlds
  128.           popmargin
  129.         endif
  130.       endfor
  131.       genln( 'ENDCASE' )
  132.     endif
  133.   else  <<*Single page format*>>
  134.     select page 1
  135.     if fldtotal > 0
  136.       WriteGetFlds
  137.     endif
  138.   endif
  139.   select all fields
  140.   genln( '?? SYS(2002)    && TURN CURSOR OFF' )
  141.  
  142. end <<*GenGetsBody*>>
  143.  
  144. <<* EOF: APPGETS.INC *>>
  145. #>>
  146.