#include once "window9.bi"

#ifndef CLRF
	#define CLRF  !"\n\r"
#EndIf
'Общая структура для печати
Type All
	LenS As Integer 'общая длина всей строки
	lencurS As Integer ' длина текущей строки
	count As Integer ' кол-во строк в области печати
	tempcount As Integer=1  ' счетчик для строк
	find As Integer  ' поисковая переменная
	curS As USTRING ' текущая строка
	tempcurS As USTRING ' временная строка
	lpsize As SIZE ' структура для GetTextExtentPoint32
	FLX3 As Integer ' размер области печати по оси X без учета отступов
	FLY3 As Integer ' размер области печати по оси Y без учета отступов
	FLX4 As Integer ' размер области печати по оси X с учетом отступов
	FLY4 As Integer ' размер области печати по оси Y с учетом отступов
	frameL As Integer ' отступ слева
	frameR As Integer ' отступ справа
	frameT As Integer ' отступ сверху
	frameB As Integer ' отступ снизу
	FLX1 As Single ' размер десктопа по оси X в логических координатах
	FLY1 As Single ' размер десктопа по оси Y в логических координатах
	FLX2 As Single ' размер области печати по оси X в логических координатах
	FLY2 As Single ' размер области печати по оси Y в логических координатах
	SCX As Single  ' соотношение десктопа и области печати по оси X
	SCY As Single  ' соотношение десктопа и области печати по оси Y
	hDesktopDC As HDC ' контекст десктопа
	hf As HFONT   ' шрифт текста печати
	pd As PrintDlg  ' структура диалога PRINTDLG
	psd As PAGESETUPDLG  ' структура диалога PAGESETUPDLG
	di As DOCINFO  ' структура диалога DOCINFO
	R As RECT ' структура координат области печати
End Type


Dim Shared obj As All
Sub TextPrinter(byref SourseText As USTRING, byval Font As window9.FontPrint Ptr, byval color_BK As COLORREF, byval color_T As COLORREF) Export
	'Получаем общую длину строки
	obj.LenS=Len(SourseText)
	' подготавливаем структуру для диалога PrintDlg
	obj.pd.lStructSize = SIZEOF(PrintDlg)
	obj.pd.Flags = PD_RETURNDC
	'выводим диалог
	IF PrintDlg(@obj.pd)=0 Then Exit Sub
	' получаем контекст десктопа и его размеры в логических пикселях
	obj.hDesktopDC = GetDC( 0 )
	obj.FLX1 = GetDeviceCaps( obj.hDesktopDC, LOGPIXELSX)
	obj.FLY1 = GetDeviceCaps( obj.hDesktopDC, LOGPIXELSY)
	ReleaseDC( 0, obj.hDesktopDC)
	' получаем размеры области печати в логических пикселях
	obj.FLX2 = GetDeviceCaps(obj.pd.hDC, LOGPIXELSX)
	obj.FLY2 = GetDeviceCaps(obj.pd.hDC, LOGPIXELSY)
	' получаем соотношение десктопа и области печати
	if obj.FLX1 > obj.FLX2 then
		obj.SCX = obj.FLX1 / obj.FLX2
	else
		obj.SCX = obj.FLX2 / obj.FLX1
	End If
	if obj.FLY1 > obj.FLY2 then
		obj.SCY = obj.FLY1 / obj.FLY2
	else
		obj.SCY = obj.FLY2 / obj.FLY1
	End If
	' загружаем или присваиваем шрифт
	Dim font_ As window9.FontPrint Ptr=Font
	If Font=0 Then
		obj.hf=cast(HFONT,LoadFont("Arial",10*obj.SCX))
	Else
		obj.hf=cast(HFONT,LoadFont(font_->Name_,font_->size*obj.SCX,,font_->BOLD,font_->italic,font_->Underline,font_->StrikeOut))
	End If
	' загружаем шрифт в контекст
	SelectObject(obj.pd.hDC,Cast(HGDIOBJ,obj.hf))
	' загружаем цвета в контекст
	If color_BK<>0 Then SetBkColor(obj.pd.hDC,color_BK)
	If color_T<>0 Then SetTextColor(obj.pd.hDC,color_T)
	
	' узнаем размеры области печати
	obj.FLX3 = GetDeviceCaps( obj.pd.hDC, HORZRES)
	obj.FLY3 = GetDeviceCaps( obj.pd.hDC, VERTRES)
	' подготавливаем структуру PAGESETUPDLG для диалога вывода свойств страницы
	obj.psd.Flags = PSD_MARGINS
	obj.psd.lStructSize=SizeOf(PAGESETUPDLG)
	obj.psd.rtMargin.left=1000:obj.psd.rtMargin.right=1000
	obj.psd.rtMargin.top=1000:obj.psd.rtMargin.bottom=1000
	' выводим диалог
	PageSetupDlg(@obj.psd)
	' получаем отступы текста страницы
	obj.frameL=(obj.psd.rtMargin.left\100):obj.frameR=(obj.psd.rtMargin.right\100)
	obj.frameT=(obj.psd.rtMargin.top\100):obj.frameB=(obj.psd.rtMargin.bottom\100)
	' устанавливаем прямоугольник для печати текста
	obj.r.left=obj.frameL*obj.SCX
	obj.r.right=obj.FLX3-obj.frameR*obj.SCX
	obj.r.top=obj.frameT*obj.SCY
	obj.r.bottom=obj.FLY3-obj.frameB*obj.SCY
	'---------узнаем кол-во строк в области печати----------
	GetTextExtentPoint32(obj.pd.hDC,"TEST",4,@obj.lpsize)
	obj.count=(obj.FLY3-obj.frameT*obj.SCY-obj.frameB*obj.SCY)\obj.lpsize.cy
	' получаем действительную часть области печати
	obj.FLX4=obj.FLX3-obj.frameL*obj.SCX-obj.frameR*obj.SCX
	obj.FLY4=obj.FLY3-obj.frameT*obj.SCY-obj.frameB*obj.SCY
	
	For b As Integer =1 To obj.pd.nCopies
		If StartDoc (obj.pd.hDC, @obj.di)>0 Then
			If obj.LenS<>0 then
				For n As Integer=0 To obj.LenS-1
					If SourseText[n]=13 Then
						SourseText[n]=32
						obj.tempcurS+=" "
					ElseIf SourseText[n]=10 Then
						SourseText[n]=0
					Else
						#ifdef UNICODE
							dim as USTRING sTemp = obj.tempcurS+wCHR(SourseText[n])
							GetTextExtentPoint32(obj.pd.hDC,*sTemp,Len(sTemp),@obj.lpsize)
							If obj.lpsize.cx>=obj.FLX4 Then
								obj.find=InStrRev(obj.tempcurS,Any " .,;" & Chr(34))
								n=n-(Len(obj.tempcurS)-obj.find+1)
								obj.curS =obj.curS + LEFT(obj.tempcurS,obj.find)+CLRF
								obj.tempcurS=""
								obj.tempcount+=1
							Else
								obj.tempcurS+=WChr(SourseText[n])
							EndIf							
						#else	
							GetTextExtentPoint32(obj.pd.hDC,obj.tempcurS+CHR(SourseText[n]),Len(obj.tempcurS+Chr(SourseText[n])),@obj.lpsize)
							If obj.lpsize.cx>=obj.FLX4 Then
								obj.find=InStrRev(obj.tempcurS,Any " .,;" & Chr(34))
								n=n-(Len(obj.tempcurS)-obj.find+1)
								obj.curS =obj.curS + LEFT(obj.tempcurS,obj.find)+CLRF
								obj.tempcurS=""
								obj.tempcount+=1
							Else
								obj.tempcurS+=Chr(SourseText[n])
							EndIf							
						#EndIf
						
					EndIf
					If obj.tempcount=obj.count Then
						If obj.curS="" Then obj.curS=obj.tempcurS
						If StartPage (obj.pd.hDC)>0 Then
							#ifdef UNICODE
								DrawText (obj.pd.hDC,*(obj.curS),Len(obj.curS) ,@obj.r,0)
							#else	
								DrawText (obj.pd.hDC,obj.curS,Len(obj.curS) ,@obj.r,0)
							#EndIf							
							EndPage obj.pd.hDC
							obj.tempcount=1
							obj.curS=""
							obj.tempcurS=""
						EndIf
					EndIf
				Next
				obj.curS+=obj.tempcurS
				If obj.curS<>"" Then
					If StartPage (obj.pd.hDC)>0 Then
						#ifdef UNICODE
							DrawText (obj.pd.hDC,*(obj.curS),Len(obj.curS) ,@obj.r,0)
						#else
							DrawText (obj.pd.hDC,obj.curS,Len(obj.curS) ,@obj.r,0)							
						#EndIf
						EndPage obj.pd.hDC
						obj.tempcount=1
					EndIf
				EndIf
			EndIf
			EndDoc obj.pd.hDC
		endif
	Next
	DeleteDC obj.pd.hDC
	DeleteObject(obj.hf)
End Sub
