'Note: I use a pdf printer driver to test printing. This saves wasting paper and ink
'Code copied to EB from IBPRO
'Also this code is just test stuff. I'm not sure if I used someone elses example and modified it, or I coded
'the whole lot. Anyhow it might be of help to someone

'peterpuk Jan09

autodefine "off"

'$include "windowssdk.inc"					'from Sapero

$undeclare PRTDIALOG255
'$UNDECLARE GETDEFAULTPRINTER255
global PRTDIALOG255
'GLOBAL GETDEFAULTPRINTER255

CONST PD_ALLPAGES = &H0
CONST PD_CAN_DRAW_DIB = &H1
CONST PD_CAN_STRETCHDIB = &H2
CONST PD_COLLATE = &H10
CONST PD_CURRENTPAGE = &H400000
CONST PD_DISABLEPRINTTOFILE = &H80000
CONST PD_ENABLEPRINTHOOK = &H1000
CONST PD_ENABLEPRINTTEMPLATE = &H4000
CONST PD_ENABLEPRINTTEMPLATEHANDLE = &H10000
CONST PD_ENABLESETUPHOOK = &H2000
CONST PD_ENABLESETUPTEMPLATE = &H8000
CONST PD_ENABLESETUPTEMPLATEHANDLE = &H20000
CONST PD_EXCLUSIONFLAGS = &H1000000
CONST PD_HIDEPRINTTOFILE = &H100000
CONST PD_NOCURRENTPAGE = &H800000
CONST PD_NONETWORKBUTTON = &H200000
CONST PD_NOPAGENUMS = &H8
CONST PD_NOSELECTION = &H4
CONST PD_NOWARNING = &H80
CONST PD_PAGENUMS = &H2
CONST PD_PRINTSETUP = &H40
CONST PD_PRINTTOFILE = &H20
CONST PD_RESULT_APPLY = 2
CONST PD_RESULT_CANCEL = 0
CONST PD_RESULT_PRINT = 1
CONST PD_RETURNDC = &H100
CONST PD_RETURNDEFAULT = &H400
CONST PD_RETURNIC = &H200
CONST PD_SELECTION = &H1
CONST PD_SHOWHELP = &H800
CONST PD_STRETCHDIB_1_1_OK = &H4
CONST PD_STRETCHDIB_1_2_OK = &H8
CONST PD_STRETCHDIB_1_N_OK = &H10
CONST PD_USEDEVMODECOPIES = &H40000
CONST PD_USEDEVMODECOPIESANDCOLLATE = &H40000
CONST PD_USELARGETEMPLATE = &H10000000

DECLARE EXTERN _fpreset()
DECLARE PRTDIALOG255(win as POINTER,vStart as INT BYREF,vEnd as INT BYREF,vCopies as INT BYREF,vCollate as INT BYREF),STRING
/*DECLARE GETDEFAULTPRINTER255(OPT printname as string), string

sub GetDEFAULTPRINTER255(OPT string pname), STRING	
	string printname
	word psize=254
	
	psize=GetDefaultPrinterA(printname,&psize)
	pname=printname
		
	return printname
endsub
*/
SUB PRTDIALOG255(win as POINTER,vStart as INT BYREF,vEnd as INT BYREF,vCopies as INT BYREF,vCollate as INT BYREF),STRING
ISTRING strPrinter[255]
	strPrinter[0] = NULL
PRINTDLG pd
POINTER pString,pTemp
	ZeroMemory(pd,LEN(PRINTDLG))
	pd.lStructSize = LEN(PRINTDLG)
	pd.nMinPage = vStart
	pd.nMaxPage = vEnd
	pd.nFromPage = vStart
	pd.nToPage = vEnd
	pd.nCopies = vCopies
	pd.Flags = PD_ALLPAGES | PD_USEDEVMODECOPIES | PD_HIDEPRINTTOFILE | PD_NOSELECTION 
	IF vCollate
		pd.Flags |= PD_COLLATE
	ENDIF
	IF win <> 0
		pd.hwndOwner = #<WINDOW>win.hwnd
	ENDIF
	IF PrintDlg(pd) <> 0
		_fpreset()
		vStart = pd.nFromPage
		vEnd = pd.nToPage
		vCopies = pd.nCopies
		if(pd.Flags & PD_COLLATE) THEN vCollate = 1 ELSE vCollate = 0
		IF pd.hDevNames
			pString = GlobalLock(pd.hDevNames)
			pTemp = pString
			pString += #<DEVNAMES>pString.wOutputOffset
			strPrinter = #<STRING>pString
			if(strPrinter[0] <> "\\")
				pTemp += #<DEVNAMES>pTemp.wDeviceOffset
				strPrinter = #<STRING>pTemp
			endif
			GlobalFree(pd.hDevNames)		
		ENDIF
		IF pd.hDevMode
			GlobalFree(pd.hDevMode)
		ENDIF
	ENDIF
	_fpreset()
RETURN strPrinter
ENDSUB

$DEFINE PRINT_ITALICS 1
$DEFINE PRINT_UNDERLINE 2
$DEFINE PRINT_STRIKEOUT 4

$DEFINE PRINTER_UNIT_PIXEL 0
$DEFINE PRINTER_UNIT_INCH 1
$DEFINE PRINTER_UNIT_MM 2

TYPE POINTF	'Sapero called it a POINTFLOAT
	FLOAT X
	FLOAT Y
endtype

TYPE DOCINFO
	INT cbSize
	POINTER lpszDocName
	POINTER lpszOutput
	POINTER lpszDatatype
	INT fwType
ENDTYPE

DOCINFO doc

doc.cbSize = sizeof(DOCINFO)

INT printerDC, printer_unit = PRINTER_UNIT_PIXEL
INT xdpi,ydpi,pagewidth,pageheight,font_height
FLOAT ppwin,pphin
INT poffsetx,poffsety

INT vStart,vEnd,vCopies,vCollate
STRING printer_name,DocumentName
HPEN printerPen
HBRUSH printerBrush
INT printerFont

sub GETDEFAULTPRINTER255(),STRING
   string printname
   word psize=254
   psize=GetDefaultPrinterA(printname,&psize)
   return printname
endsub

sub SetDocumentName(string text),int
	doc.lpszDocName = text
	DocumentName = text
return 1
endsub

sub SelectPrinter(OPT string DefPrinter=""),string
	string pname

	'---------------------------------
	'>>>>>> CHOOSE A PRINTER  <<<<<<<<
	'---------------------------------
	if ucase$(DefPrinter)="DEFAULT"
		printer_name = GetDefaultPrinter255()
	else
		printer_name = PrtDialog255(0, vStart, vEnd, vCopies, vCollate)
	endif

	IF printer_name <> "" THEN
		'--------------------------------------------------------------
		'>>>>>> CREATE A PRINTER DC TO WRITE TO FOR THIS PRINTER <<<<<<
		'--------------------------------------------------------------

		printerDC=CreateDCA(0,printer_name,0,0)	'CreateDC

		'-----------------------------------------------------
		'>>>>>> GET SOME INFORMATION ABOUT THIS PRINTER <<<<<<
		'-----------------------------------------------------
		xdpi=GetDeviceCaps(printerDC,LOGPIXELSX)
		ydpi=GetDeviceCaps(printerDC,LOGPIXELSY)
		pagewidth=GetDeviceCaps(printerDC,HORZRES)
		pageheight=GetDeviceCaps(printerDC,VERTRES)
		poffsetx=GetDeviceCaps(printerDC,PHYSICALOFFSETX)
		poffsety=GetDeviceCaps(printerDC,PHYSICALOFFSETY)
		ppwin=GetDeviceCaps(printerDC,PHYSICALWIDTH)/xdpi
		pphin=GetDeviceCaps(printerDC,PHYSICALHEIGHT)/ydpi
		
		SetPenColor(RGB(0,0,0), 0.001)			'start with a black pen
		SetBrushColor(RGB(255,255,255))			'start with white brush
		SetPrinterFont("Times New Roman", 12) 'and Arial 12 pt font

		'---------------------------------
		'------- START THE DOCUMENT ------
		'---------------------------------
		StartDocA(printerDC,doc)

		'-----------------------------
		'------- START THE PAGE ------
		'-----------------------------
		StartPage(printerDC)

		pname=printer_name
	else
		pname=""
	endif

	return pname
endsub

sub PrinterPageWidth(),Float
	return ppwin
endsub

sub PrinterPageHeight(),FLoat
	return pphin
end sub

sub PrintableWidth(),FLOAT
	FLOAT w

	if xdpi=0
		w=0
	else
		select printer_unit
			case 0
				w = pagewidth
			case 1
				w = pagewidth/flt(xdpi)
			default
				w = (pagewidth/flt(xdpi))*25.4
		endselect
	endif

	return w
endsub

sub PrintableHeight(),FLOAT
	float h

	if ydpi=0
		h=0
	else
		select printer_unit
			case 0
				h = pageheight
			case 1
				h = (pageheight/FLT(ydpi))
			default
				h = (pageheight/ydpi)*25.4
		endselect
	endif

	return h
endsub

Sub NewPage()
	'-------------------------------
	'------- END OF THIS PAGE ------
	'-------------------------------
	_EndPage(printerDC)
	
endsub

Sub EndPrint()
	'---------------------------------
	'------- END OF THE DOCUMENT -----
	'---------------------------------

	_EndPage(printerDC)

   EndDoc(printerDC)

	'----------------------------------------------------
	'--- TIDY UP BY DELETING CREATED OBJECTS AND DC -----
	'----------------------------------------------------

	DeleteObject(printerPen)
	DeleteObject(printerBrush)
	DeleteObject(printerFont)
	DeleteDC(printerDC)

endsub

sub PrintBMP(STRING bmp_filename, float x, float y, float w, OPT float h=0.0)
	HBITMAP bmpSource
	HDC hdcSource
	BITMAP bmpInfo	
	int p_x,p_y,p_w,p_h

	p_x = GetPosX(x)
	p_y = GetPosY(y)
	p_w = GetDistX(w)
	p_h = GetDistY(h)

	bmpSource = LoadImage(bmp_filename, @IMGBITMAP)
	hdcSource = CreateCompatibleDC(printerDC)

	GetObject(bmpSource, sizeof(bmpInfo), &bmpInfo)

	SelectObject(hdcSource, bmpSource)

	if p_h = 0
		p_h = p_w * bmpInfo.bmHeight / bmpInfo.bmWidth	
	endif

	StretchBlt(printerDC, p_x, p_y, p_w, p_h, hdcSource, 0, 0, bmpInfo.bmWidth, bmpInfo.bmHeight, SRCCOPY)

	Deleteimage bmpSource, @IMGBITMAP
	DeleteDC(hdcSource)
endsub

sub SetPrinterUnits(int pu)
	printer_unit = pu
endsub

sub SetTransparentMode()
	
	SetBkMode (printerDC, TRANSPARENT)
	
endsub

sub SetOpaqueMode()

	SetBkMode (printerDC, OPAQUE)

endsub

sub PrintPolygon(POINTF points[], int cnt, COLORREF bColor, float bWidth, COLORREF fColor, OPT int Transp=0)
	POINT pts[100]
	int i	

	for i = 0 to cnt-1
		pts[i].x = GetPosX(points[i].x)
		pts[i].y = GetPosY(points[i].y)
	next i

	SetPenColor(bColor,bWidth)
	SetBrushColor(fColor,Transp)

	Polygon(printerDC,&pts, cnt)
endsub

sub PrintRectangle(float StartX, float StartY, float EndX, float EndY, INT bColor, float bWidth, Int fColor, OPT float nWidth=0, OPT float nHeight=0, OPT int Transp=0)
	int p_sx, p_sy, p_ex, p_ey, p_aw, p_ah	
	
	p_sx = GetPosX(StartX)
	p_sy = GetPosY(StartY)
	p_ex = GetPosX(EndX)
	p_ey = GetPosY(EndY)			
	p_aw = GetDistX(nWidth)
	p_ah = GetDistY(nHeight)

	SetBrushColor(fColor,Transp)
	SetPenColor(bColor, bWidth)
	
	RoundRect(printerDC, p_sx, p_sy, p_ex, p_ey, p_aw, p_ah)
Endsub

Sub PrintEllipse(float X, float Y, float Width, float Height, int bColor, float nWidth, int fColor, OPT int Transp=0)
	int p_sx, p_sy, p_ex, p_ey	
	
	p_sx = GetDistX(X-(Width/2))
	p_sy = GetDistY(Y-(Height/2))
	p_ex = GetDistX(X+(Width/2))
	p_ey = GetDistY(Y+(Height/2))			

	SetBrushColor(fColor,Transp)
	SetPenColor(bColor, nWidth)

	_Ellipse(printerDC, p_sx, p_sy, p_ex, p_ey)

endsub

sub PrintLine(float StartX, float StartY, float EndX, float EndY)
	int res
	int p_sx, p_sy, p_ex, p_ey
	
	p_sx = GetPosX(StartX)
	p_sy = GetPosY(StartY)
	p_ex = GetPosX(EndX)
	p_ey = GetPosY(EndY)				

	res=MoveToEx(printerDC, p_sx, p_sy, NULL)
	
	res = _LineTo(printerDC, p_ex, p_ey)

endsub

sub PrintLineTo(float EndX, float EndY)
	int res
	int p_ex, p_ey
	
	p_ex = GetPosX(EndX)
	p_ey = GetPosY(EndY)

	res = _LineTo(printerDC, p_ex, p_ey)

endsub

sub PrinterTextColor(COLORREF textcolor)
	
	SetTextColor(printerDC,textcolor)

endsub

sub SetPenColor(COLORREF pColor, float pWidth)	'sets pen color and width
	int p_bw
	
	p_bw = GetDistX(pWidth)

	if printerPen then
		DeleteObject(printerPen)	'if pen is in use, release to create a new one
	endif
	
	printerPen = CreatePen (PS_SOLID, p_bw, pColor)  'create new pen

	if printerPen
		SelectObject(printerDC, printerPen)		'set it to device	
	endif

endSub

sub SetBrushColor(COLORREF pColor,OPT int Transp=0)	'sets brush color

	if printerBrush then
		DeleteObject(printerBrush)	'if brush is in use, release to create a new one
	endif
	
	if Transp<>0
		SelectObject(printerDC, GetStockObject(NULL_BRUSH))		'set it to device
	else
		printerBrush = CreateSolidBrush (pColor)  'create new pen

		if printerBrush
			SelectObject(printerDC, printerBrush)		'set it to device
		endif
	endif
endSub


sub SetPrinterFont(string name,int pointa, OPT int angle=0, OPT int font_weight = 400, opt int DoStyle=0),int
	$ifdef UNICODE
		LOGFONTW fnt
		ZeroMemory(fnt,LEN(fnt))
		fnt.lfFaceName = S2W(name)
	$else
		LOGFONTA fnt
		ZeroMemory(fnt,LEN(fnt))
		fnt.lfFaceName = name
	$ENDIF

	int ret
		
	if printerFont
		DeleteObject(printerFont)
	endif

	font_height = pointa*(ydpi/72)	

   fnt.lfHeight = font_height
	fnt.lfEscapement = Angle

   'Optional, use 1 to set any of these

   if (DoStyle & PRINT_ITALICS) = PRINT_ITALICS
      fnt.lfItalic = 1
   else
      fnt.lfItalic = 0
   endif

	if (DoStyle & PRINT_UNDERLINE) = PRINT_UNDERLINE
		fnt.lfUnderline = 1
	else
		fnt.lfUnderline = 0
	endif

	if (DoStyle & PRINT_STRIKEOUT) = PRINT_STRIKEOUT
		fnt.lfStrikeOut = 1
	else
		fnt.lfStrikeOut = 0
	endif

	fnt.lfWeight=font_weight	

   printerFont = CreateFontIndirect(fnt)

	ret = SelectObject(printerDC, printerFont) 'select font

	return ret
EndSub

sub TextSizeEx(Istring text[], float length, int nchar byref, float width byref, float height byref)
	BOOL ret=0
	SIZE strSize
	int len_to_fit, test_length

	ZeroMemory(&strSize, len(strSize))

	test_length = GetDistX(length)

	ret = GetTextExtentExPointA(printerDC, text, len(text), test_length, len_to_fit, 0, &strSIZE)

	if ret
		nchar = len_to_fit

		select printer_unit
			case 0
				width = strSize.cx
				height = strSize.cy

			case 1
				width = strSize.cx/flt(xdpi)
				height = strSize.cy/flt(ydpi)

			default
				width = (strSize.cx/flt(xdpi))*25.4
				height = (strSize.cy/flt(ydpi))*25.4
		endselect
	endif	
endsub

sub PrintFilledText(float sx, float sy, string text, OPT string align="L")
	BeginPath(printerDC)
	PrintText(sx, sy,text, align)
	EndPath(printerDC)
	StrokeAndFillPath(printerDC)
endsub

Sub TextSize(String text, float width byref, float height byref)
	SIZE strSize
	int ret

	ret = GetTextExtentPoint32A(printerDC, text, len(text), &strSize)	
	
	if ret>0
		
		select printer_unit
			case 0
				width = strSize.cx
				height = strSize.cy				
				
			case 1
				width = strSize.cx/FLT(xdpi)
				height = strSize.cy/FLT(ydpi)
				
			default
				width = (strSize.cx/xdpi)*25.4
				height = (strSize.cy/ydpi)*25.4
				
		endselect
	else
		messagebox 0,str$(ret),"ERROR"
		width = 0
		height = 0
	endif
endsub

sub PrintText(float x,float y,string text,OPT string align="L")	'x and y are in printer pixels. Use xci(x) and yci(y) to change from inch to pixel
																	'e.i.  TextDraw(xci(0.5), yci(5.125), "Print this", "C")
																	'center text at 1/2" over and 5 1/8" down from top left of page
	'TA_BOTTOM=8
	'TA_TOP=0
	'TA_CENTER 6
	'TA_LEFT 0
	'TA_RIGHT 2
	'TA_NOUPDATECP 0
	string alignU
	int ta=0
	int p_x, p_y

	p_x = GetPosX(x)
	p_y = GetPosY(y)
   alignU=ucase$(align)
   if instr(alignU,"B") then ta=ta+8
   if instr(alignU,"C") then ta=ta+6
   if instr(alignU,"R") then ta=ta+2
   SetTextAlign(printerDC,ta)
   TextOutA(printerDC,p_x,p_y,text,len(text))
EndSub

sub xci(float in), int
	return in*xdpi-poffsetx
EndSub

sub yci(float in), int
	return in*ydpi-poffsety
EndSub

sub xcm(FLOAT mm), int
	return (mm/25.4)*xdpi-poffsetx
EndSub

sub ycm(FLOAT mm), int
	return (mm/25.4)*ydpi-poffsety
EndSub

sub GetPosX(float value),int
	int ret
	select printer_unit
		case PRINTER_UNIT_PIXEL			
			ret = int(value)
		case PRINTER_UNIT_INCH
			ret = xci(value)
		default
			ret = xcm(value)
	endselect
	return ret
endsub

sub GetPosY(float value),int
	int ret
	
	select printer_unit
		case PRINTER_UNIT_PIXEL			
			ret = int(value)
		case PRINTER_UNIT_INCH
			ret = yci(value)
		default
			ret = ycm(value)
	endselect
	return ret
endsub

sub GetDistX(float value),int
	int ret
	select printer_unit
		case PRINTER_UNIT_PIXEL			
			ret = int(value)
		case PRINTER_UNIT_INCH
			ret = int(value*xdpi)	
		default
			ret = int((value/25.4)*xdpi)
	endselect
	return ret
endsub

sub GetDistY(float value),int
	int ret
	select printer_unit
		case PRINTER_UNIT_PIXEL			
			ret = int(value)
		case PRINTER_UNIT_INCH
			ret = int(value*ydpi)	
		default
			ret = int((value/25.4)*ydpi)
	endselect
	return ret
endsub