home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a040 / 2.ddi / SHRWARE4.ARC / GENFLD.INC < prev    next >
Encoding:
Text File  |  1988-02-25  |  2.4 KB  |  102 lines
  1. <<* GENFLD.INC *>>
  2. <<#
  3.  
  4. function fixfldnam : string
  5. begin
  6.   if AutoMem and (fldals <> 'M')
  7.     RETURN fldprefix + left( fldnam,10-len(fldprefix) )
  8.   else
  9.     RETURN fldnam
  10.   endif
  11. end <<*fixfldnam*>>
  12.  
  13.  
  14. function fixautomem( expr : string ) : string
  15. <<*---Replace fldnam(s) with AutoMem fldnam(s)---*>>
  16. begin
  17.   forall (fldtyp $ 'CDLN')
  18.     expr := stuff( expr,at(upper(fldnam),upper(expr)),len(fldnam),fixfldnam )
  19.   endfor
  20.   RETURN expr
  21. end fixautomem
  22.  
  23.  
  24. procedure genLABEL
  25. integer row,cp,wid
  26. begin
  27.   if fldtyp = 'B'  <<*Box Type*>>
  28.     GenBox
  29.   elsif (fldtyp = 'T') and not fldhor <<*Vertical Text*>>
  30.     row := fldrow
  31.     wid := len( fldlab )
  32.     for cp := 1 to wid
  33.       GenSay( row,fldcol,substr( fldlab,cp,1 ) )
  34.       row := row + 1
  35.     end
  36.   elsif fldlab  <<*All Fields and Text Objects*>>
  37.     GenSay( fldrow,fldcol,fldlab )
  38.   endif
  39. end <<*genLABEL*>>
  40.  
  41.  
  42. function getFIELD( IsWithPrefix : logical ) : string
  43. integer row,col,fldlablen
  44. string strg,picstrg
  45. begin
  46.   fldlablen := len( fldlab )
  47.   row := fldrow
  48.   col := fldcol
  49.   if fldhor  <<*SIDE*>>
  50.     col := col + fldlablen
  51.   else       <<*BELOW*>>
  52.     row := row + 1
  53.   endif
  54.   if fldsay
  55.     strg := '@ ' + str( row,2 ) + ',' + str( col,2 ) + ' SAY '
  56.   else
  57.     strg := '@ ' + str( row,2 ) + ',' + str( col,2 ) + ' GET '
  58.   end
  59.   <<*---FIELD NAME---*>>
  60.   if IsWithPrefix and (fldtyp <> 'M') and (fldals <> 'M')
  61.     strg := strg + ljust( fldprefix + left( fldnam,10-len(fldprefix) ),10 )
  62.   else  <<*all others*>>
  63.     if fldals $ 'AM'  <<* PRIMARY and MEMORY workareas *>>
  64.       strg := strg + ljust( fldnam,10 )
  65.     else
  66.       strg := strg + fldals + '->' + ljust( fldnam,10 )
  67.     endif
  68.   endif
  69.   <<*---PICTURE---*>>
  70.   if fldpic
  71.     strg := strg + ' PICTURE "' + fldpic + '"'
  72.   elsif fldtyp = 'N'  <<*force picture on numerics*>>
  73.     picstrg := replicate( '9',fldwid )
  74.     if flddec
  75.       picstrg[ fldwid-flddec ] := '.'
  76.     endif
  77.     strg := strg + ' PICTURE "' + picstrg + '"'
  78.   endif
  79.   RETURN strg
  80. end <<*getFIELD*>>
  81.  
  82.  
  83. procedure genFIELD
  84. string line
  85. begin
  86.   <<*---@ row,col SAY/GET FIELD NAME, PICTURE---*>>
  87.   line := getFIELD( AutoMem )
  88.   <<*---RANGE---*>>
  89.   if fldran
  90.     line := line + ' RANGE ' + fldran
  91.   endif
  92.   <<*---VALID---*>>
  93.   if fldval = ''
  94.     genln( rtrim(line) )
  95.   else 
  96.     genln( line,' VALID(',fixautomem(fldval),')' )
  97.   endif
  98. end <<*genFIELD*>>
  99.  
  100. <<* EOF: GENFLD.INC *>>
  101. #>>
  102.