home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a046 / 5.img / TEMPLATE / GENFLD.INC < prev    next >
Encoding:
Text File  |  1992-04-01  |  3.4 KB  |  137 lines
  1. <<* GENFLD.INC *>>
  2. <<* (C) 1991 SHEN YANG WHITE HORSE SOFTWART COMPANY  *>>
  3.  
  4. <<#
  5. function fixfldnam : string
  6. begin
  7.   if AutoMem and (fldals <> 'M')
  8.     if ismultials
  9.       RETURN fldprefix + fldals + left( fldnam,10-len(fldprefix+fldals) )
  10.     else
  11.       RETURN fldprefix + left( fldnam,10-len(fldprefix) )
  12.     endif
  13.   else
  14.     RETURN fldnam
  15.   endif
  16. end <<*fixfldnam*>>
  17.  
  18. function fixareafldnam : string
  19. begin
  20.   if AutoMem and (fldals <> 'M')
  21.     if ismultials
  22.       RETURN fldprefix + fldals + left( fldnam,10-len(fldprefix+fldals) )
  23.     else
  24.       RETURN fldprefix + left( fldnam,10-len(fldprefix) )
  25.     endif
  26.   else
  27.     RETURN fldnam
  28.   endif
  29. end <<*fixfldnam*>>
  30.  
  31. function fixautomem( expr : string ) : string
  32. string expres
  33. <<*---Replace fldnam(s) with AutoMem fldnam(s)---*>>
  34. begin
  35.   if ismultials
  36.     expres := ''
  37.     expr := ltrim(expr)
  38.     while len(expr) > 0
  39.       if ( "+" $ expr)
  40.         expres := expres + fldprefix + fldals + substr(expr,1,at('+',expr))
  41.         expr := stuff( expr,1,at('+',expr),'' )
  42.       else
  43.         expres := expres + fldprefix + fldals + expr
  44.         expr := ""
  45.       endif
  46.       expr := ltrim(expr)
  47.     end
  48.     RETURN expres
  49.   else
  50.     forall (fldtyp $ 'CDLN')
  51.       expr := stuff( expr,at(upper(fldnam),upper(expr)),len(fldnam),fixfldnam )
  52.     endfor
  53.     RETURN expr
  54.   endif
  55. end fixautomem
  56.  
  57. procedure genLABEL
  58. integer row,cp,wid
  59. begin
  60.   if (fldtyp = 'T') and not fldhor <<*Vertical Text*>>
  61.     row := fldrow
  62.     wid := len( fldlab )
  63.     for cp := 1 to wid
  64.       GenSay( row,fldcol,substr( fldlab,cp,1 ) )
  65.       row := row + 1
  66.     end
  67.   elsif fldlab and ( fldtyp = 'T')  <<*All Fields and Text Objects*>>
  68.     GenSay( fldrow,fldcol,fldlab )
  69.   endif
  70. end <<*genLABEL*>>
  71.  
  72.  
  73. function getFIELD( IsWithPrefix : logical ) : string
  74. integer row,col,fldlablen
  75. string strg,picstrg
  76. begin
  77.   fldlablen := len( fldlab )
  78.   row := fldrow
  79.   col := fldcol
  80.   if fldhor  <<*SIDE*>>
  81.     col := col + fldlablen
  82.   else       <<*BELOW*>>
  83.     row := row + 1
  84.   endif
  85.   if fldsay
  86.     strg := '@ ' + str( row,2 ) + ',' + str( col,2 ) + ' SAY '
  87.   else
  88.     strg := '@ ' + str( row,2 ) + ',' + str( col,2 ) + ' GET '
  89.   end
  90.   <<*---FIELD NAME---*>>
  91.   if IsWithPrefix and (fldtyp <> 'M') and (fldals <> 'M')
  92.     if ismultials
  93.       strg := strg + ljust( fldprefix + fldals + left( fldnam,9-len(fldprefix) ),10 )
  94.     else
  95.       strg := strg + ljust( fldprefix + left( fldnam,10-len(fldprefix) ),10 )
  96.     endif
  97.   else  <<*all others*>>
  98.     if fldals $ 'AM'  <<* PRIMARY and MEMORY workareas *>>
  99.       strg := strg + ljust( fldnam,10 )
  100.     else
  101.       strg := strg + fldals + '->' + ljust( fldnam,10 )
  102.     endif
  103.   endif
  104.   <<*---PICTURE---*>>
  105.   if fldpic
  106.     strg := strg + ' PICTURE "' + fldpic + '"'
  107.   elsif fldtyp = 'N'  <<*force picture on numerics*>>
  108.     picstrg := replicate( '9',fldwid )
  109.     if flddec
  110.       picstrg[ fldwid-flddec ] := '.'
  111.     endif
  112.     strg := strg + ' PICTURE "' + picstrg + '"'
  113.   endif
  114.   RETURN strg
  115. end <<*getFIELD*>>
  116.  
  117.  
  118. procedure genFIELD
  119. string line
  120. begin
  121.   <<*---@ row,col SAY/GET FIELD NAME, PICTURE---*>>
  122.   line := getFIELD( AutoMem )
  123.   <<*---RANGE---*>>
  124.   if fldran
  125.     line := line + ' RANGE ' + fldran
  126.   endif
  127.   <<*---VALID---*>>
  128.   if fldval = ''
  129.     genln( rtrim(line) )
  130.   else 
  131.     genln( line,' VALID(',fixautomem(fldval),')' )
  132.   endif
  133. end <<*genFIELD*>>
  134.  
  135. <<* EOF: GENFLD.INC *>>
  136. #>>
  137.