Wiki Home

Xprg


Namespace: WIN_COM_API
* progrom testcf.prg

* #DEFINE ObjectHeight 6354.167  

#DEFINE ObjectFontName "Arial"
#DEFINE ObjectFontSize 10
#DEFINE ObjectFontStyle "N"

#DEFINE DisplayUnits 96 && 96 for Windows, 72 for MAC, 300 for printers
#DEFINE ReportUnits 10000

#DEFINE CRLF CHR(13)+CHR(10)
#DEFINE SQ "'"

CLOSE DATABASES
clear

? "webdings 6", FONTMETRIC(1, "webdings", 6, "N" )
? "arial 10", FONTMETRIC(1, "arial", 10, "N" )

* give the report something to chew on
CREATE CURSOR foo (cFid1 c(20))
INSERT INTO foo VALUES ( "" )

* Make a basic report 
CREATE REPORT CFbase from (DBF())
SELECT 0
USE cfbase.frx excl
* wack column title, page and date
DELETE FOR INLIST( Expr, '"Cfid1"', 'DATE()', '"Page "', '_PAGENO' )
* Shrink header and footer to 0
replace Height WITH 0 FOR ObjType = 9 AND INLIST( ObjCode, 1, 7 )
* Expand the size of the detail band size of to 10.5"
replace Height WITH 10.5 * 10000 FOR ObjType = 9 AND ObjCode = 4
* Grab a basic text object
locate FOR ObjType = 8 AND Expr = 'cfid1'
SCATTER MEMO NAME loTextObj
DELETE 
PACK
USE

* Setup the basic text object
WITH loTextObj
	.FontStyle = 0 && Normal
	.Mode = 0 && Opaque
	.FillRed = 0 && Backcollor = black
	.FillGreen = 0
	.FillBlue = 0
	.PenRed = 255 && Forecollor = white
	.PenGreen = 255
	.PenBlue = 255
ENDWITH

lnHeight = 3100.000  && Starting height (bit less than 2 lines)

WITH loTextObj

	* Keep making reports untill ^w is hit to exit a preview (esc for next preview)
	DO WHILE .t.

		* Make a page of text objects, each with a slightly larger height.
		SELECT * from cfbase.frx INTO TABLE cf.frx

		* drop down from the top (not sure why, 0,0 should be the top of the page???)
		.vpos = 5000
		DO whil .vpos + .Height < 10.5 * 10000 

			FOR .hpos = 0 TO 70000 STEP 8500

				.Height = lnHeight

				.Width = 1000 && 1/10"
				.FontFace  = "Webdings"
				.FontSize = 6
				.Expr = "chr(46) + CHR(13) + CHR(10) + CHR(46)"
				APPEND BLANK
				GATHER MEMO NAME loTextObj

				.hPos = .hPos + .Width + 100  && 1/100 between checker and numbers
				.Width = 6500 && 3/4"
				.FontFace  = ObjectFontName
				.FontSize = ObjectFontSize
				.Expr ="'H:" + TRANSFORM( lnHeight )  + "'+chr(13)+CHR(10)+'cf:" + TRANSFORM( ROUND( cf(lnHeight), 0 ) ) + "'"
				APPEND BLANK
				GATHER MEMO NAME loTextObj

				lnHeight = lnHeight + 25
			ENDFOR
			
			* Drop down below the tallest (last) textobject + .1"
			.vpos = .vpos + .Height + 100

		ENDdo
		USE IN cf
		
		SELECT foo
		MODIFY REPORT cf
		* REPORT FORM cf preview

		IF lastkey() <> 27
			EXIT
		endif

	enddo

ENDWITH

return

function cf( tnObjectHeight )
*-- How tall is one line
nLineHeight = FONTMETRIC(1, ObjectFontName, ObjectFontSize, ObjectFontStyle)

*-- How many lines will fit in this object
nLines = (tnObjectHeight + (1/DisplayUnits*ReportUnits)) / (nLineHeight/DisplayUnits*ReportUnits)

IF nLines = INT(nLines)
  *-- If an exact number of lines fit, use nLineHeight
  RETURN nLineHeight/DisplayUnits*ReportUnits
ELSE
  *-- Otherwise, Distribute the lines within the object height
  RETURN (tnObjectHeight - (1/DisplayUnits*ReportUnits)) / INT(nLines) + (1/DisplayUnits*ReportUnits)
ENDIF