home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a070 / 3.ddi / FOXPRO / TEMPLGEN / PROFRM.INC < prev    next >
Encoding:
Text File  |  1990-02-19  |  4.5 KB  |  174 lines
  1. <<* Genfrm.inc *>>
  2. <<#pragma
  3.  
  4. <<* Function to specify color set *>>
  5.  
  6. function AtrCode( atr : integer ) : string
  7. string hilite,blink,hues,atrstrg
  8. integer hinib,lonib
  9. begin
  10.   hues := 'N ,BU,G ,BG,R ,BR,GR,W '
  11.   if (atr and 8) = 8
  12.     hilite := '+'
  13.   endif
  14.   if (atr and 128) = 128
  15.     blink := '*'
  16.   endif
  17.   lonib := (atr and 7)
  18.   hinib := ((atr shr 4) and 7)
  19.   atrstrg := rtrim( substr( hues,(lonib * 3) + 1,2 ) ) + blink + hilite + '/'
  20.   atrstrg := atrstrg + rtrim( substr( hues,(hinib * 3) + 1,2 ) )
  21.   RETURN atrstrg
  22. end <<*AtrCode*>>
  23.  
  24. <<*  Procedure to create a window for a memo field *>>
  25.  
  26. Procedure Defmemo
  27. string hcolor
  28. begin
  29.   forall fldlab and not fldnap
  30.     if fldtyp = 'B' 
  31.       if len(rtrim(fldusr)) > 0
  32.         hcolor := atrcode(fldhue)
  33.         gen('DEFINE WINDOW ',fldusr+'1',' FROM ',fldrow,',',fldcol)
  34.         genln(' TO ',fldrow+flddec,',',fldcol+fldwid,' DOUBLE CLOSE ZOOM FLOAT GROW SHADOW COLOR ',hcolor, ' TITLE ', '"'+fldusr+'"')
  35.       endif
  36.     endif  
  37.   endfor
  38. end
  39.   
  40. <<*  Place @...SAYs on the screen *>>
  41.  
  42. procedure DisplayFormat
  43. string box, hcolor
  44. begin
  45.   forall fldlab and not fldnap
  46.     if fldtyp = 'B'      <<*BOX Type*>>
  47.       if fldusr = ''
  48.         box := fldlab  <<*Used to swap chars for Character box*>>
  49.         hcolor := atrcode(fldhue)
  50.         gen( '    @ ',fldrow,',',fldcol,',' )
  51.         gen( fldrow+flddec,',',fldcol+fldwid," BOX '" )
  52.         genln( substr(box,1,3),box[5],box[8],box[7],box[6],box[4],"'" )
  53.         genln  <<*Send CR/LF*>>
  54.       endif
  55.     else  <<*All Fields and Text Objects*>>
  56.       gen( '    @ ',fldrow,',',fldcol," SAY '",fldlab,"'" )
  57.       hcolor := atrcode(fldhue)
  58.       if substr(upper(screencolor),1,at(',',screencolor)) <> upper(hcolor) 
  59.         gen(' COLOR ',hcolor)
  60.       endif 
  61.     genln  <<*Send CR/LF*>>
  62.     endif
  63.   endfor
  64. end <<*DisplayFormat*>>
  65.  
  66. <<*  Generate the picture clauses for @...SAY/GETs *>>
  67.  
  68. procedure GenPicture
  69. string picstrg
  70. begin
  71.   if fldpic
  72.     gen( " PICTURE '",fldpic,"'" )
  73.   elsif fldtyp = 'N'  <<*Force numeric picture*>>
  74.     picstrg := replicate( '9',fldwid )
  75.     if flddec
  76.       picstrg[ fldwid-flddec ] := '.'
  77.     endif
  78.     gen( " PICTURE '",picstrg,"'" )
  79.   endif
  80. end <<*GenPicture*>>
  81.  
  82. <<*  Generate the range clauses for @...GETs *>>
  83.  
  84. Procedure GenRange
  85. begin
  86.   if fldran
  87.     gen(' RANGE ',fldran)
  88.   endif
  89. end     
  90.  
  91. <<*  Initialize memory variables *>>
  92.  
  93. Procedure Initmemory
  94. begin
  95.   forall fldget and (fldtyp $ 'CDLN')
  96.     if  fldals = "M"
  97.       if len(rtrim(fldini)) <> 0
  98.         genln(fldnam, " = ", fldini)
  99.       elsif fldtyp = 'C'
  100.         genln(fldnam, " = SPACE(" + str(fldwid) + ")")
  101.       elsif fldtyp = 'N'
  102.         genln(fldnam, " = 0.00") 
  103.       elsif fldtyp = 'D'
  104.         genln(fldnam, " = DATE()")
  105.       else
  106.         genln(fldnam, " = .F.")
  107.       endif
  108.     endif
  109.   endfor
  110. end
  111.  
  112. <<*  Create valid clauses for @...GETs *>>
  113.  
  114. Procedure GenValid
  115. begin
  116.   if fldval
  117.     gen(' VALID ',fldval)
  118.   endif
  119. end     
  120.  
  121. <<*  Display all @...GETs *>>
  122.  
  123. procedure DisplayRecord
  124. string var3 , hcolor
  125. integer tcount    
  126. begin
  127.     tcount:=64
  128.     <<*---Char, Date, Logical, Numeric & Memo fields---*>>
  129.     forall fldget and (fldtyp $ 'CDLNM')
  130.         if fldtyp = 'M' 
  131.             if upper(rtrim(fldusr)) = "OPEN"
  132.                 genln('    ACTIVATE WINDOW ',fldnam+'1')
  133.                 genln('    ACTIVATE SCREEN ')
  134.             endif    
  135.         endif
  136.         if fldhor  <<*field on the side of label*>>
  137.             gen( '    @ ',fldrow,',',fldcol + len(fldlab),' GET ',fldals+'->'+fldnam )
  138.         else  <<*field below label*>>
  139.             gen( '    @ ',fldrow + 1,',',fldcol,' GET ',fldals+'->'+fldnam )
  140.         endif
  141.         if fldtyp = 'M' 
  142.             if upper(rtrim(fldusr)) = "OPEN"
  143.                 gen(' OPEN WINDOW ',fldnam+'1')
  144.             endif    
  145.             if upper(rtrim(fldusr)) = "CLOSE"
  146.                 gen(' WINDOW ',fldnam+'1')
  147.            endif    
  148.         else
  149.             GenPicture
  150.             GenRange
  151.            GenValid
  152.         endif
  153.         hcolor := rtrim(atrcode(fldatr))
  154.         gen(' COLOR ,',hcolor)
  155.         genln  <<*Send CR/LF*>>
  156.     endfor
  157. end <<*DisplayRecord*>>
  158.  
  159. Procedure GenBrowseFormat
  160. begin
  161.     forall fldget and (fldtyp $ 'CDLNM')
  162.         if fldals <> 'M'
  163.            gen( '@ ','0',',','0',' GET ',fldals+'->'+fldnam )
  164.            GenPicture
  165.            GenRange
  166.            GenValid
  167.            genln
  168.         endif
  169.     endfor
  170. end <<*GenBrowseFormat*>>
  171.  
  172. <<* End Profrm.inc *>>
  173. #>>
  174.