home *** CD-ROM | disk | FTP | other *** search
/ Power CD-ROM!! 7 / POWERCD7.ISO / prgmming / clipper / tbprint.prg < prev    next >
Text File  |  1993-10-14  |  8KB  |  248 lines
  1. /*
  2.  * File......: TBPRINT.PRG
  3.  * Author....: Martin Colloby
  4.  * BBS.......: The Dark Knight Returns
  5.  * Net/Node..: 050/069
  6.  * User Name.: Martin Colloby
  7.  * Date......: 18/4/93
  8.  * Revision..: 1.0
  9.  *
  10.  * This is an original work by Martin Colloby and is placed in the public
  11.  * domain.
  12.  *
  13.  * Modification history:
  14.  * ---------------------
  15.  *
  16.  * $Log$
  17.  *
  18.  */
  19.  
  20.  
  21. /*  $DOC$
  22.  *  $FUNCNAME$
  23.  *      GT_PRINTTBROWSE()
  24.  *  $CATEGORY$
  25.  *      Printer
  26.  *  $ONELINER$
  27.  *      Print the contents of a TBrowse object
  28.  *  $SYNTAX$
  29.  *      GT_PrintTBrowse( oBrowse , cScope )
  30.  *  $ARGUMENTS$
  31.  *      oObject - TBrowse object
  32.  *      cScope  - Scope of TBrowse
  33.  *  $RETURNS$
  34.  *      NIL
  35.  *  $DESCRIPTION$
  36.  *      Prints the contents of the TBrowse object, using all of the TBrowse
  37.  *      whizzy bits like column headers and footers.
  38.  *  $EXAMPLES$
  39.  *
  40.  *  $SEEALSO$
  41.  *
  42.  *  $INCLUDE$
  43.  *      GT_LIB.CH
  44.  *  $END$
  45.  */
  46. *
  47. #include "GT_lib.ch"
  48.  
  49. FUNCTION GT_PrintTBrowse( oBrowse , cScope )
  50.  
  51. /*****************************************************************************
  52.  Purpose - Print the contents of the TBrowse object
  53.  Returns - None
  54.  Author  - Log
  55.  Created - 30/12/92
  56. ******************************************************************************
  57.  Parameters - oBrowse - TBrowse object
  58.               cScope  - First incidence of scope
  59.  Privates   - None
  60.  Locals     - None
  61.  Externals  - None
  62. *****************************************************************************/
  63.  
  64. LOCAL aColHeading := {}
  65. LOCAL aColumn     := {}
  66. LOCAL aWidths     := GT_ColWidth( oBrowse )
  67. LOCAL cBColSep    := IIF( oBrowse:colSep  == NIL , " " , oBrowse:colSep  )
  68. LOCAL cBFootSep   := IIF( oBrowse:footSep == NIL , " " , oBrowse:footSep )
  69. LOCAL cBHeadSep   := IIF( oBrowse:headSep == NIL , " " , oBrowse:headSep )
  70. LOCAL cColSep     := ""
  71. LOCAL cFootSep    := ""
  72. LOCAL cHeadSep    := ""
  73. LOCAL cLine       := ""
  74. LOCAL nColRows    := 0
  75. LOCAL nCount      := 0
  76. LOCAL nCount1     := 0
  77. LOCAL nLines      := 0
  78. LOCAL nMaxLines   := 0
  79. LOCAL oColumn
  80. LOCAL xValue
  81.  
  82. GT_NextRow( 1 , "" , 5 )
  83.  
  84. * Get the column headers
  85. FOR nCount := 1 TO oBrowse:colCount()
  86.     cColSep := IIF( oBrowse:getColumn( nCount ):colSep == NIL , cBColSep , oBrowse:getColumn( nCount ):colSep )
  87.     aColumn := GT_ColHead( oBrowse:getcolumn( nCount ):Heading(), aWidths[ nCount ] , cColSep )
  88.     AADD( aColHeading , aColumn )
  89.     nColRows := MAX( nColRows , LEN( aColumn ) )
  90. NEXT nCount
  91.  
  92. * Output the column titles
  93. FOR nCount := 1 TO nColRows
  94.     FOR nCount1 := 1 TO oBrowse:colCount()
  95.         cColSep := IIF( oBrowse:getColumn( nCount1 ):colSep == NIL , cBColSep , oBrowse:getColumn( nCount1 ):colSep )
  96.         cLine += IIF( LEN( aColHeading[ nCount1 ] ) >= nCount , ;
  97.                       aColHeading[ nCount1 , nCount ] , ;
  98.                       SPACE( aWidths[ nCount1 ] + LEN( cColSep ) ) )
  99.     NEXT nCount1
  100.     * Next two lines should print the column header, and clear the string
  101.     GT_NextRow( 1 , cLine , 5 )
  102.     cLine := ""
  103. NEXT nCount
  104.  
  105. * Output the column headings
  106. cLine := ""
  107. FOR nCount := 1 TO oBrowse:colCount()
  108.     cHeadSep := IIF( oBrowse:getColumn( nCount ):headSep == NIL , cBHeadSep , oBrowse:getColumn( nCount ):headSep )
  109.     cLine += REPLICATE( LEFT( cHeadSep , 1 ) , oBrowse:getColumn( nCount ):width ) + cHeadSep
  110. NEXT nCount
  111. cLine += RIGHT( cHeadSep , 1 )
  112. IF ALLTRIM( cLine ) != ""
  113.     GT_NextRow( 1 , cLine , 5 )
  114. ENDIF
  115.  
  116. * Go to the first record
  117. MovePos( "First" , cScope )
  118.  
  119. * Skip through the records in the TBrowse.
  120. DO WHILE .T.
  121.     * Build up a string containing the values
  122.     cLine := ""
  123.     FOR nCount := 1 TO oBrowse:colCount
  124.         cColSep := IIF( oBrowse:getColumn( nCount ):colSep == NIL , cBColSep , oBrowse:getColumn( nCount ):colSep )
  125.         cLine += IIF( nCount == 1 , " " , cColSep ) + ;
  126.                  GT_X2Char( EVAL( oBrowse:getColumn( nCount ):block ) , aWidths[nCount] )
  127.     NEXT nCount
  128.  
  129.     * Print this row
  130.     GT_NextRow( 1 , cLine , 5 )
  131.  
  132.     * Evaluate the skipblock for the browse by asking it to skip one record.
  133.     * If it returns a value other than 1, the pointer must be at the end of
  134.     * the scope.
  135.     IF EVAL( oBrowse:skipBlock , 1 ) != 1
  136.         EXIT
  137.     ENDIF
  138.  
  139. ENDDO
  140.  
  141. cLine := ""
  142. FOR nCount := 1 TO oBrowse:colCount()
  143.     cFootSep := IIF( oBrowse:getColumn( nCount ):footSep == NIL , cBFootSep , oBrowse:getColumn( nCount ):footSep )
  144.     cLine += REPLICATE( LEFT( cFootSep , 1 ) , oBrowse:getColumn( nCount ):width ) + cFootSep
  145. NEXT nCount
  146. cLine += RIGHT( cFootSep , 1 )
  147. IF ALLTRIM( cLine ) != ""
  148.     GT_NextRow( 1 , cLine , 5 )
  149. ENDIF
  150.  
  151. * Go back top the top of the browse
  152. oBrowse:goTop()
  153.  
  154. RETURN NIL
  155. *
  156. *!************************************************************
  157. *!             FUNCTION getColumnHead
  158. *!   Purpose : Create array for column header, storing seperate lines
  159. *!             of header (parts seperated by semicolons) in seperate
  160. *!             array elements, centering based on column width
  161. *!   In      : cHeading - column header which may contain semicolons.
  162. *!           : nColWidth - width for column, to be used for centering.
  163. *!   Out     : array for this column heading.
  164. *!************************************************************
  165. STATIC FUNCTION GT_ColHead( cHeading , nColWidth , cColSep )
  166.  
  167. LOCAL aColumn := {}     // array to be filled out and returned.
  168. LOCAL cChar   := ""     // temp. holder for each character.
  169. LOCAL cTemp   := ""     // temp. holder for each header element.
  170. LOCAL nCount  := 0      // counter
  171.  
  172. DO WHILE ++nCount <= LEN( cHeading )
  173.     cChar := SUBSTR( cHeading , nCount , 1 )
  174.     IF cChar == ";"
  175.         AADD( aColumn , PADC( cTemp , nColWidth + LEN( cColSep ) ) )
  176.         cTemp := ''
  177.     ELSE
  178.         cTemp += cChar
  179.     ENDIF
  180. ENDDO
  181.  
  182. * Pad the title with spaces to the right, so that the title will appear
  183. * at the left of the column
  184. AADD( aColumn , PADR( cTemp, nColWidth + LEN( cColSep ) ) )
  185.  
  186. RETURN aColumn
  187. *
  188. *!************************************************************
  189. *!             FUNCTION GetColumnLen
  190. *!   Purpose : Create array containing column widths for tbrowse,
  191. *!             determined by looking at column width, header, footer
  192. *!             and block length.
  193. *!   In      : oBrowse - tbrowse object
  194. *!   Out     : aLen - array containing width of each column in tbrowse.
  195. *!************************************************************
  196. STATIC FUNCTION GT_ColWidth( oBrowse )
  197.  
  198. LOCAL aLen     := {}    // array of widths to return.
  199. LOCAL nCount   := 0
  200. LOCAL nThisLen := 0     // variable to hold current column width.
  201.  
  202. FOR nCount := 1 TO oBrowse:colCount()
  203.     // get the Column Width
  204.     IF oBrowse:getcolumn( nCount ):width == NIL
  205.         // if column width not set by user column width is largest of
  206.         //  len of heading, len of footing, or len of eval( block )
  207.         nThisLen := MAX( LEN( GT_X2Char( EVAL( oBrowse:getcolumn( nCount ):Block() ) ) ) , ;
  208.                          MAX( HeadLen( oBrowse:getcolumn( nCount ):Heading() ) , ;
  209.                               HeadLen( oBrowse:getcolumn( nCount ):Footing() )   ;
  210.                              )                                              ;
  211.                         )
  212.     ELSE
  213.         nThisLen := oBrowse:getcolumn( nCount ):width
  214.     ENDIF
  215.  
  216.     AADD( aLen , nThisLen )
  217. NEXT nCount
  218.  
  219. RETURN aLen
  220. *
  221. *!************************************************************
  222. *!             FUNCTION HeadLen
  223. *!   Purpose : Returns max width of header which may contain semicolons.
  224. *!   In      : cHeading - header to determine max length of.
  225. *!   Out     : nMaxLen - maximum length of cHeading
  226. *!************************************************************
  227. STATIC FUNCTION HeadLen( cHeading )
  228.  
  229. LOCAL cChar   := ""     // current character
  230. LOCAL nCount  := 0      // loop counter
  231. LOCAL nLen    := 0      // current segment width.
  232. LOCAL nMaxLen := 0      // holder of max width found so far
  233.  
  234. DEFAULT cHeading TO ""
  235.  
  236. DO WHILE ++nCount <= LEN( cHeading )
  237.     cChar := SUBSTR( cHeading , nCount , 1 )
  238.     IF cChar == ';'
  239.         nMaxLen := MAX( nMaxLen , nLen )
  240.         nLen := 0
  241.     ELSE
  242.         nLen ++
  243.     ENDIF
  244. ENDDO
  245.  
  246. RETURN nMaxLen
  247. *
  248.