home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a040 / 2.ddi / SHRWARE4.ARC / MSAPHRA.INC < prev    next >
Encoding:
Text File  |  1988-06-03  |  6.5 KB  |  289 lines
  1. <<* APPPHRA.INC *>>
  2. <<#
  3.  
  4. procedure FldNamList
  5. <<* Generates: "Field1    Field2    Field3..." *>>
  6. integer itemcount,listcount
  7. begin
  8.   listcount := 0
  9.   while (listcount < 3) and not eof(fields)
  10.     gen( '   "' )
  11.     itemcount := 0
  12.     while (itemcount < 5) and not eof(fields)
  13.       gen( ljust( fldnam,10 ) )
  14.       itemcount := itemcount + 1
  15.       skip field
  16.     endwhile
  17.     listcount := listcount + 1
  18.     if (listcount = 3) or eof(fields)
  19.       genln( '",;' )
  20.     else
  21.       genln( '"+;' )   <<*More to come*>>
  22.     endif
  23.   endwhile
  24. end FldNamList
  25.  
  26.  
  27. procedure GenFldName( phrasetotal : integer )
  28. begin
  29. #>>
  30. <<if phrasetotal <= 15>>
  31. fldnam = SUBSTR(;
  32.    <<FldNamList>>
  33.    fldnum*10-9,10 )
  34. <<elsif phrasetotal <= 30>>
  35. IF fldnum <= 15
  36.    fldnam = SUBSTR(;
  37.    <<FldNamList>>
  38.    fldnum*10-9,10 )
  39. ELSE
  40.    fldnam = SUBSTR(;
  41.    <<FldNamList>>
  42.    (fldnum-15)*10-9,10 )
  43. ENDIF
  44. <<elsif phrasetotal <= 32000>>
  45. DO CASE
  46. CASE fldnum <= 15
  47.    fldnam = SUBSTR(;
  48.    <<FldNamList>>
  49.    fldnum*10-9,10 )
  50. CASE fldnum <= 30
  51.    fldnam = SUBSTR(;
  52.    <<FldNamList>>
  53.    (fldnum-15)*10-9,10 )
  54. OTHERWISE
  55.    fldnam = SUBSTR(;
  56.    <<FldNamList>>
  57.    (fldnum-30)*10-9,10 )
  58. ENDCASE
  59. <<endif>>
  60. <<end GenFldName>>
  61.  
  62.  
  63. <<#
  64. procedure FldAlsList( fldmax : integer )
  65. begin
  66.   gen( 'fldals = SUBSTR( "' )
  67.   forall (forcount <= fldmax)
  68.     gen( fldals )
  69.   endfor
  70.   genln( '",fldnum,1 )' )
  71. end <<*FldAlsList*>>
  72.  
  73.  
  74. procedure FldTypList( fldmax : integer )
  75. begin
  76.   gen( 'fldtyp = SUBSTR( "' )
  77.   forall (forcount <= fldmax)
  78.     gen( fldtyp )
  79.   endfor
  80.   genln( '",fldnum,1 )' )
  81. end <<*FldTypList*>>
  82.  
  83.  
  84. procedure FldWidList
  85. integer listcount,itemcount
  86. begin
  87.   select field 1  <<*GOTO TOP*>>
  88.   genln( 'fldwid = VAL( SUBSTR(;' )
  89.   listcount := 0
  90.   while (listcount < 3) and not eof(fields)
  91.     gen( '   "' )
  92.     itemcount := 0
  93.     while (itemcount < 15) and not eof(fields)
  94.       gen( str( fldwid,3 ) )
  95.       itemcount := itemcount + 1
  96.       skip field
  97.     endwhile
  98.     listcount := listcount + 1
  99.     if (listcount = 3) or eof(fields)
  100.       genln( '",;' )
  101.     else
  102.       genln( '"+;' )   <<*More to come*>>
  103.     endif
  104.   endwhile
  105.   genln( '   fldnum*3-2,3 ) )' )
  106. end <<*FldWidList*>>
  107.  
  108.  
  109. procedure FldDecList
  110. integer listcount,itemcount
  111. begin
  112.   select field 1  <<*GOTO TOP*>>
  113.   genln( '   flddec = VAL( SUBSTR(;' )
  114.   listcount := 0
  115.   while (listcount < 3) and not eof(fields)
  116.     gen( '   "' )
  117.     itemcount := 0
  118.     while (itemcount < 15) and not eof(fields)
  119.       gen( str(flddec,2) )
  120.       itemcount := itemcount + 1
  121.       skip field
  122.     endwhile
  123.     listcount := listcount + 1
  124.     if (listcount = 3) or eof(fields)
  125.       genln( '",;' )
  126.     else
  127.       genln( '"+;' )   <<*More to come*>>
  128.     endif
  129.   endwhile
  130.   genln( '   fldnum*2-1,2 ) )' )
  131. end <<*FldDecList*>>
  132.  
  133.  
  134. procedure GenFldGet
  135. integer phrasecount
  136. logical isholding
  137. string  picstrg,fldstrg
  138. begin
  139.   phrasecount := 0
  140.   isholding := false
  141.   forall fields
  142.     phrasecount := phrasecount + 1
  143.     fldstrg := str( phrasecount )  <<*Convert fld# to str*>>
  144.  
  145.     if (fldran or fldval or fldpic) or ((fldpic = '') and (fldtyp = 'N'))
  146.       if isholding
  147.         genln( 'CASE fldnum < ',fldstrg )
  148.         genln( '   @ row,col GET fldget' )
  149.       end
  150.       genln( 'CASE fldnum = ',fldstrg )
  151.       gen( '   @ row,col GET fldget' )
  152.  
  153.       if fldpic  <<*We've got a PICTURE clause*>>
  154.         gen( ' PICTURE "',fldpic,'"' )
  155.       elsif fldtyp = 'N'  <<*Force a PICTURE on Numerics*>>
  156.         picstrg := replicate( '9',fldwid )
  157.         if flddec <> 0
  158.           picstrg[ fldwid-flddec ] := '.'
  159.         endif
  160.         gen( ' PICTURE "',picstrg,'"' )
  161.       endif
  162.  
  163.       if fldran
  164.         gen( ' RANGE ',fldran )
  165.       endif
  166.       <<*Don't allow VALID(), since it might fail when using CONDITIONS.*>>
  167.       <<*CONDITIONS uses SELECT H, and VALID might expect SELECT A,B,etc.*>>
  168.       genln  <<*CR/LF*>>
  169.       isholding := false
  170.     else
  171.       isholding := true
  172.     end
  173.   endfor
  174.  
  175.   if isholding
  176.     genln( 'CASE fldnum <= ',fldstrg )  <<*Gen phrasetotal value*>>
  177.     genln( '   @ row,col GET fldget' )
  178.   end
  179. end <<*GenFldGet*>>
  180. #>>
  181.  
  182.  
  183. <<procedure GenPhrase( phrasetotal : integer )>>
  184. <<begin>>
  185. PARAMETER firstrow,fldnum,phrase
  186. PRIVATE row,col,oper,opernum,operMAX
  187. PRIVATE fldnam,fldtyp,fldwid,flddec,fldget
  188. row = firstrow
  189. opernum = 0
  190. *
  191. <<if feat(featals)>>
  192. * ---Get field information:  fldals->fldnam,fldtyp,fldwid,flddec
  193.   <<FldAlsList( phrasetotal )>>
  194. <<else>>
  195. * ---Get field information:  fldnam,fldtyp,fldwid,flddec
  196. <<endif>>
  197. <<GenFldName( phrasetotal )>>
  198. @ row+1,0
  199. <<GenColor( 0,'HILITE' )>>
  200. @ row+1,0 SAY fldnam
  201. <<if feat(featals)>>
  202. fldnam = fldals + "->" + TRIM(fldnam)
  203. <<else>>
  204. fldnam = TRIM( fldnam )
  205. <<endif>>
  206. <<FldTypList( phrasetotal )>>
  207. <<FldWidList>>
  208. DO CASE
  209. CASE fldtyp = "C"
  210.    fldget = SPACE( fldwid )
  211. CASE fldtyp = "D"
  212.    fldget = CTOD( "  /  /  " )
  213. CASE fldtyp = "N"
  214.    fldget = 0.00
  215. <<FldDecList>>
  216. OTHERWISE
  217.    fldget = .T.
  218.    opernum = 1
  219. ENDCASE
  220. *
  221. * ---Get OPERATOR.
  222. <<GenColor( 0,'WINDOW' )>>
  223. IF opernum = 0
  224.    opernum = 1
  225.    operMAX = VAL( SUBSTR( "8661",AT( fldtyp,"CDNL" ),1 ) )
  226.    @ row,0
  227.    @ row,0 SAY "Enter OPERATOR #" GET opernum PICTURE "99" RANGE 1,operMAX
  228.    READ
  229.    IF opernum = 8
  230.       fldget = SPACE( 65 )
  231.    ENDIF
  232. ENDIF
  233. oper = TRIM( SUBSTR( " = <>> >=< <=$ $ ",opernum*2,2 ) )
  234. <<GenColor( 0,'HILITE' )>>
  235. @ row+1,12 SAY oper
  236. *
  237. * ---Get field VALUE.
  238. <<GenColor( 0,'WINDOW' )>>
  239. @ row,0
  240. @ row,0 SAY "Enter VALUE to compare"
  241. row = row + 1
  242. col = 15
  243. DO CASE
  244. <<GenFldGet>>
  245. ENDCASE
  246. READ
  247. *
  248. * ---Build phrase.
  249. DO CASE
  250. CASE opernum = 7
  251.    * ---Only character types can use the "$" operator.
  252.    phrase = [{"}]+UPPER(TRIM(fldget))+[{"}] + oper + "UPPER("+fldnam+")"
  253. CASE fldtyp = "C"
  254.    phrase = "UPPER("+fldnam+")" + oper + [{"}]+UPPER(TRIM(fldget))+[{"}]
  255. CASE fldtyp = "N"
  256.    phrase = fldnam + oper + STR( fldget,fldwid,flddec )
  257. CASE fldtyp = "D"
  258.    IF DTOC(fldget) = "  /  /  "
  259.       phrase = [DTOC(] + fldnam + [)] + oper + ["  /  /  "]
  260.    ELSE
  261.       phrase = fldnam + oper + [CTOD({"}] + DTOC(fldget) + [{"})]
  262.    ENDIF
  263. CASE fldget
  264.    phrase = fldnam
  265. OTHERWISE
  266.    phrase = ".NOT." + fldnam
  267. ENDCASE
  268. phrase = "(" + phrase + ")"
  269. <<end>> <<*GenPhrase*>>
  270.  
  271.  
  272. <<#
  273. procedure GenPhraseBody
  274. begin
  275.   <<*---set the filter---*>>
  276.     select fields on (fldtyp $ 'CDLN') and fldget
  277.   if fldtotal = 0
  278.     <<*do nothing*>>
  279.   elsif fldtotal > 42  <<*Maximum # of fields in Query Table*>>
  280.     GenPhrase( 42 )
  281.   else
  282.     GenPhrase( fldtotal )
  283.   endif
  284.   select all fields
  285. end GenPhraseBody
  286.  
  287. <<* EOF: APPPHRA.INC *>>
  288. #>>
  289.