home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a046 / 5.img / TEMPLATE / SSBGETS.INC < prev    next >
Encoding:
Text File  |  1992-04-01  |  3.0 KB  |  143 lines
  1. <<* SSBGETS.INC *>>
  2. <<* (C) 1991 SHEN YANG WHITE HORSE SOFTWART COMPANY  *>>
  3.  
  4. <<#
  5. procedure GenValidSeek( expr : string )
  6. begin
  7. #>>
  8. IsValid = .F.
  9. <<if ismultials>>
  10. DO VLOOKUP WITH dbfarea,{expr},IsValid
  11. <<else>>
  12. DO VLOOKUP WITH "A",{expr},IsValid
  13. <<endif>>
  14. DO WHILE .NOT. IsValid
  15. <<#
  16.   pushmargin( 1 )
  17.   GenColorAtr
  18.   gen( rtrim( getFIELD( AutoMem ) ) )
  19.   if fldran
  20.     gen( ' RANGE ',fldran )
  21.   endif
  22.   genln
  23.   popmargin
  24. #>>
  25.    READ
  26.    <<if ismultials>>
  27.    DO VLOOKUP WITH dbfarea,{expr},IsValid
  28.    <<else>>
  29.    DO VLOOKUP WITH "A",{expr},IsValid
  30.    <<endif>>
  31. ENDDO
  32. <<end GenValidSeek>>
  33.  
  34.  
  35. <<procedure GenValidLoop( expr : string )>>
  36. <<string rowstr>>
  37. <<begin>>
  38.   <<rowstr := '@ PromptRow,0'>>
  39. DO WHILE .NOT. ({expr})
  40.   <<GenColor( 1,'PROMPT' )>>
  41.    {rowstr} CLEAR
  42.   <<if fldusr>>
  43.    {rowstr} SAY [{fldusr}]
  44.   <<else>>
  45.    {rowstr} SAY "╬▐╨º╩²╛▌. ╟δ╓╪╨┬╩Σ╚δ."
  46.   <<endif>>
  47. <<#
  48.   pushmargin( 1 )
  49.   GenColorAtr
  50.   gen( rtrim( getFIELD( AutoMem ) ) )
  51.   if fldran
  52.     gen( ' RANGE ',fldran )
  53.   endif
  54.   genln
  55.   popmargin
  56. #>>
  57.    READ
  58. <<GenColor( 1,'PROMPT' )>>
  59.    {rowstr} CLEAR
  60. ENDDO
  61. <<end GenValidLoop>>
  62.  
  63.  
  64. <<#
  65. procedure GenValidCheck   <<* VALID() loop for versions  *>>
  66. string expr,token
  67. integer pos
  68. begin
  69.   expr := fldval
  70.   token := "VLU("     <<*VLOOKUP keyword*>>
  71.   pos := at( token,upper(expr) )
  72.   if pos > 0
  73.     expr := substr( expr,pos,255 )
  74.     if expr[ len(expr) ] = ")"
  75.       expr := rtrim( left( expr,len(expr) - 1 ) )   <<*delete rparen*>>
  76.     endif
  77.     expr := stuff( expr,1,len(token),"" )  <<*delete keyword*>>
  78.     pos := at( ',',expr )
  79.     expr := left( expr,pos ) + fixautomem( substr( expr,pos+1,255 ) )
  80.     GenValidSeek( expr )
  81.   else  <<*Normal VALID expression*>>
  82.     GenValidLoop( fixautomem(expr) )   <<*Insert fldprefix*>>
  83.   endif
  84. end GenValidCheck
  85.  
  86.  
  87. procedure WriteGetFlds
  88. logical IsSomeValid,IsReadNeeded
  89. begin
  90.   forecolor := 32000  <<*For GenColorAtr() procedure*>>
  91.   backcolor := 32000
  92.   IsReadNeeded := false
  93.   IsSomeValid := false
  94.   forall (fldcal = '')
  95.     IsReadNeeded := true
  96.     GenColorAtr
  97.     genFIELD
  98.   endfor
  99.   if IsReadNeeded
  100.     genln( 'READ' )  <<*Read the last alias selected*>>
  101.   endif
  102.   if IsSomeValid
  103.     forecolor := 32000
  104.     backcolor := 32000
  105.     forall fldval
  106.       GenValidCheck
  107.     endfor
  108.   endif
  109. end WriteGetFlds
  110.  
  111.  
  112. procedure GenGetsBody
  113. begin
  114.   select on databases,fields,pages
  115.   select fields on fldget and (fldtyp $ 'CDLMN')
  116.   if ndxtotal > 0
  117.     select index 1  <<*---Use the first index as MASTER index---*>>
  118.     select fields on not (upper(fldnam) $ upper(ndxkey))
  119.   endif
  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. end <<*GenGetsBody*>>
  140. #>>
  141.  
  142. <<* EOF: SSBGETS.INC *>>
  143.