home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a070 / 3.ddi / FOXPRO / TEMPLGEN / GENFRM.INC < prev    next >
Encoding:
Text File  |  1989-07-30  |  2.5 KB  |  95 lines
  1. <<* Genfrm.inc *>>
  2. <<#pragma
  3.  
  4. function AtrCode( atr : integer ) : string
  5. string hilite,blink,hues,atrstrg
  6. integer hinib,lonib
  7. begin
  8.   hues := 'N ,BU,G ,BG,R ,BR,GR,W '
  9.   if (atr and 8) = 8
  10.     hilite := '+'
  11.   endif
  12.   if (atr and 128) = 128
  13.     blink := '*'
  14.   endif
  15.   lonib := (atr and 7)
  16.   hinib := ((atr shr 4) and 7)
  17.   atrstrg := rtrim( substr( hues,(lonib * 3) + 1,2 ) ) + blink + hilite + '/'
  18.   atrstrg := atrstrg + rtrim( substr( hues,(hinib * 3) + 1,2 ) )
  19.   RETURN atrstrg
  20. end <<*AtrCode*>>
  21.  
  22.  
  23. procedure DisplayFormat
  24. string box, hcolor
  25. begin
  26.   forall fldlab
  27.     if fldtyp = 'B'  <<*BOX Type*>>
  28.       box := fldlab  <<*Used to swap chars for Character box*>>
  29.       gen( '   @ ',fldrow,',',fldcol,',' )
  30.       gen( fldrow+flddec,',',fldcol+fldwid,' BOX "' )
  31.       gen( substr(box,1,3),box[5],box[8],box[7],box[6],box[4],'"' )
  32.     else  <<*All Fields and Text Objects*>>
  33.       gen( '   @ ',fldrow,',',fldcol,' SAY "',fldlab,'"' )
  34.       hcolor := atrcode(fldhue)
  35. <<*      if substr(upper(screencolor),1,at(',',screencolor)) <> upper(hcolor) *>>
  36.          gen(' COLOR ',hcolor)
  37. <<*      endif *>>
  38.     endif
  39.     genln  <<*Send CR/LF*>>
  40.   endfor
  41. end <<*DisplayFormat*>>
  42.  
  43.  
  44. procedure GenPicture
  45. string picstrg
  46. begin
  47.   if fldpic
  48.     gen( ' PICTURE "',fldpic,'"' )
  49.   elsif fldtyp = 'N'  <<*Force numeric picture*>>
  50.     picstrg := replicate( '9',fldwid )
  51.     if flddec
  52.       picstrg[ fldwid-flddec ] := '.'
  53.     endif
  54.     gen( ' PICTURE "',picstrg,'"' )
  55.   endif
  56. end <<*GenPicture*>>
  57.  
  58.  
  59. procedure DisplayRecord
  60. string var3 , hcolor
  61. integer tcount    
  62. begin
  63. tcount:=64
  64.   <<*---Only Char, Date, Logical, & Numeric fields---*>>
  65.   forall fldget and (fldtyp $ 'CDLN')
  66.         if fldhor  <<*field on the side of label*>>
  67.             gen( '   @ ',fldrow,',',fldcol + len(fldlab),' GET ',fldals+'->'+fldnam )
  68.         else  <<*field below label*>>
  69.             gen( '   @ ',fldrow + 1,',',fldcol,' GET ',fldals+'->'+fldnam )
  70.         endif
  71.     GenPicture
  72.     hcolor := rtrim(atrcode(fldatr))
  73. <<*    if substr(upper(screencolor),at(',',screencolor)+1,len(rtrim(screencolor))-at(',',screencolor)) <> upper(hcolor) *>>
  74.         gen(' COLOR ,',hcolor)
  75. <<*    endif *>>
  76.     genln  <<*Send CR/LF*>>
  77. endfor
  78. end <<*DisplayRecord*>>
  79.  
  80. function DefaultVal : string
  81. begin
  82.   if fldtyp = 'C'
  83.     RETURN 'SPACE( ' + str( fldwid ) + ' )'
  84.   elsif fldtyp = 'N'
  85.     RETURN '0.00'
  86.   elsif fldtyp = 'D'
  87.     RETURN 'DATE()'
  88.   else
  89.     RETURN '.F.'
  90.   endif
  91. end <<*DefaultVal*>>
  92.  
  93. <<* SIMUTIL.INC *>>
  94. #>>
  95.