home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a046 / 5.img / TEMPLATE / GENPRINT.INC < prev    next >
Encoding:
Text File  |  1992-04-01  |  5.5 KB  |  241 lines
  1. <<* GENPRINT.INC *>>
  2. <<* (C) 1991 SHEN YANG WHITE HORSE SOFTWART COMPANY  *>>
  3. <<#
  4. function GetIndexNames( indexchoice : integer ) : string
  5. string ndxnames
  6. begin
  7.   <<*--Start with selected index--*>>
  8.   select index indexchoice
  9.   filespec( ndxnam,fpath,fname,fext )
  10.   ndxnames := fname + '.IDX'
  11.   forall indexes
  12.     if ndxcount <> indexchoice
  13.       filespec( ndxnam,fpath,fname,fext )
  14.       ndxnames := ndxnames + ',' + fname + '.IDX'
  15.     endif
  16.   endfor
  17.   RETURN ndxnames
  18. end GetIndexNames
  19.  
  20.  
  21. function GenCtrlSeq( seq : string; cp,seqlen : integer ) : integer
  22. string  ch
  23. logical isprevctrl
  24. integer chcount
  25. begin
  26.   chcount := 0
  27.   isprevctrl := false
  28.   while (cp <= seqlen) and (chcount < 50)
  29.     chcount := chcount + 1
  30.     ch := seq[cp]
  31.     if (ch < ' ') or (ch = '"')    <<*Control char or '"'*>>
  32.       if not isprevctrl
  33.         gen( '"' )
  34.         isprevctrl := true
  35.       endif
  36.       gen( '+CHR(',ord(ch),')' )
  37.     else
  38.       if isprevctrl
  39.         gen( '+"' )
  40.         isprevctrl := false
  41.       endif
  42.       gen( ch )
  43.     endif
  44.     cp := cp + 1
  45.   endwhile
  46.   if isprevctrl
  47.     gen( '+"' )
  48.   endif
  49.   RETURN cp
  50. end <<*GenCtrlSeq*>>
  51.  
  52. procedure PrintSay( Prow : string; col : integer; strg : string )
  53. integer nextcol,cp,strglen
  54. begin
  55.   if ( fldtyp = 'T' )
  56.     if isctrl( strg )
  57.       cp := 1
  58.       strglen := len( strg )
  59.       nextcol := col
  60.       while cp <= strglen
  61.         gen( '@ ',Prow,',',str(nextcol,3),' SAY "' )
  62.         cp := GenCtrlSeq( strg,cp,strglen )
  63.         genln( '"' )
  64.         nextcol := col + cp - 1
  65.       endwhile
  66.     else
  67.       genln( '@ ',Prow,',',str(col,3),' SAY "',strg,'"' )
  68.     endif
  69.   else
  70.     genln( '@ ',Prow,',',str(col,3),' SAY ',strg )
  71.   endif
  72. end <<* PrintSay *>>
  73.  
  74. procedure ssbprintfmt
  75. string Prow,strg,picstrg
  76. integer row,cp,wid,recline
  77. integer headobject,booyobject,tailobject
  78. integer precol,bascol,col
  79.  
  80. begin
  81. #>>
  82. PRIVATE recnumb,TABPAGE
  83. set talk off
  84. create view intfile from environment all
  85. <<forall databases>>
  86. * ---Open database file.
  87.   <<filespec( dbfnam,fpath,fname,fext )>>
  88.   <<strg := chr( dbfcount + 64 )>>
  89. SELECT {strg}
  90. IF .NOT. FILE( {"}{fname}.DBF{"} )
  91.    ? [{"}{fname}.DBF{"} not found]
  92.    WAIT
  93.    QUIT
  94. ENDIF
  95.   <<if dbfals = ''>>
  96. USE {fname}
  97.   <<else>>
  98. USE {fname} ALIAS {dbfals}
  99.   <<endif>>
  100.   <<if ndxtotal > 0>>
  101. *
  102. * ---Open INDEX file(s).
  103.     <<forall indexes>>
  104.       <<filespec( ndxnam,fpath,fname,fext )>>
  105.       <<fname := fname + '.IDX'>>
  106. IF .NOT. FILE( {"}{fname}{"} )
  107.    ? [Creating index {"}{fname}{"}...]
  108.    INDEX ON {ndxkey} TO {fname}
  109. ENDIF
  110.     <<endfor>>
  111.     <<genln( 'SET INDEX TO ',GetIndexNames(1) )>>
  112.   <<endif>>
  113. <<endfor>>
  114. <<select all>>
  115. <<if reltotal > 0>>   <<*Any relations in entire system?*>>
  116. *
  117. * ---SET RELATION(s).
  118. <<#
  119.   forall databases
  120.     if reltotal > 0
  121.       genln( 'SELECT ',chr( dbfcount+64 ) )
  122.     endif
  123.       forall relations
  124.         if forcount = 1
  125.           genln( 'SET RELATION TO ',relkey,' INTO ',relals )
  126.         else
  127.           genln( 'SET RELATION TO ',relkey,' INTO ',relals,' ADDITIVE' )
  128.         endif
  129.       endfor
  130.   endfor
  131. endif
  132. #>>
  133. CLEAR
  134. @5,32 SAY "╫╝▒╕║├┤≥╙í╗·"
  135. @9,32 SAY "░┤╚╬╥╗╝ⁿ╝╠╨°..."
  136. WAIT " "
  137. CLEAR
  138. @5,32 SAY "╒²╘┌┤≥╙í..."
  139. SET DEVICE TO PRINT
  140. SET PRINT ON
  141. TABPAGE = 0
  142. DO WHILE .NOT. EOF()
  143.    TABPAGE=TABPAGE+1
  144.    recnumb = 0
  145. <<#
  146.   select all
  147.   forall fields
  148.     if ( fldtyp = '1' )
  149.        headobject := fldwid
  150.     elsif ( fldtyp = '2' )
  151.        booyobject := fldwid
  152.     elsif ( fldtyp = '3' )
  153.        tailobject := fldwid
  154.     endif
  155.   end
  156.   recline := ( 60 - headobject - tailobject ) / booyobject
  157.   select all fields
  158.   row := fldrow
  159.   col := fldcol
  160.   bascol := 0
  161.   precol := 0
  162.   while not eof()
  163.     if ( row < fldrow )
  164.        Prow := 'PROW()+1'
  165.     else
  166.        Prow := 'PROW()'
  167.     endif
  168.     if ( row = fldrow )
  169.        if ( fldcol < precol ) or ( fldwid > 80 )
  170.           if ( fldwid < 80 )
  171.              bascol := bascol + 80
  172.           else
  173.              bascol := bascol + 160
  174.           endif
  175.        endif
  176.        col := fldcol + bascol
  177.     else
  178.        col := fldcol
  179.        bascol := 0
  180.     endif
  181.     precol := fldcol
  182.     pushmargin(1)
  183.     if ( fldtyp = 'T' )
  184.        PrintSay( Prow,col,fldlab )
  185.     elsif ( fldtyp $ 'CDLN' )
  186.        if ( fldtyp $ 'CDLN' ) and fldini
  187.          strg := fldini
  188.        elsif ( fldtyp $ 'CDLN' ) and ( fldals $ 'AM' )
  189.          strg := fldnam
  190.        elsif ( fldtyp $ 'CDLN' )
  191.          strg := fldals + '->' + fldnam
  192.        endif
  193.        if fldpic
  194.          strg := strg + '   PICTURE "' + fldpic + '"'
  195.        elsif fldtyp = 'N'
  196.          picstrg :=  replicate('9',fldwid)
  197.          if flddec
  198.            picstrg[ fldwid - flddec ] := '.'
  199.          endif
  200.          strg := strg + '   PICTURE "' + picstrg + '"'
  201.       endif
  202.       PrintSay( Prow,col,strg )
  203.     endif
  204.     popmargin
  205.     if ( fldtyp = '1' )
  206.        Prow := 'PROW()+1,'
  207.        pushmargin(1)
  208.        genln( 'DO WHILE .NOT.EOF() .AND. recnumb < ', recline )
  209.     endif
  210.     if ( fldtyp = '2' )
  211.        skip
  212.        Prow := 'PROW()+1'
  213.        pushmargin(1)
  214.        genln( 'SKIP' )
  215.        genln( 'recnumb = recnumb + 1' )
  216.        genln( 'IF .NOT.EOF() .AND. recnumb < ', recline )
  217.        pushmargin(1)
  218.        PrintSay( Prow,fldcol,fldlab )
  219.        popmargin
  220.        genln( 'ELSE' )
  221.     endif
  222.     row := fldrow
  223.     skip
  224.   end
  225.   genln( '   EJECT' )
  226.   genln( 'ENDIF' )
  227.   popmargin
  228.   genln( 'ENDDO' )
  229.   popmargin
  230.   genln( 'ENDDO' )
  231. #>>
  232. @ PROW()+1, 1 SAY "  "
  233. CLOSE DATABASES
  234. set view to intfile
  235. erase infile
  236. SET DEVICE TO SCREEN
  237. SET PRINT OFF
  238. << end >><<*ssbprintfmt*>>
  239.  
  240. <<* EOF: GENPRINT.INC *>>
  241.