#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 String ' текущая строка
  tempcurS As String ' временная строка
  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(SourseText As String,Font As window9.FontPrint Ptr=0,color_BK As COLORREF=0,color_T As COLORREF=0) 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
  EndIf
  if obj.FLY1 > obj.FLY2 then
    obj.SCY = obj.FLY1 / obj.FLY2
  else
    obj.SCY = obj.FLY2 / obj.FLY1
  EndIf
  ' загружаем или присваиваем шрифт
  Dim font_ As window9.FontPrint Ptr=Font
  If Font=0 Then
    obj.hf=LoadFont("Arial",10*obj.SCX)
  Else
    obj.hf=LoadFont(font_->Name_,font_->size*obj.SCX,,font_->BOLD,font_->italic,font_->Underline,font_->StrikeOut)
  EndIf
  ' загружаем шрифт в контекст
  SelectObject(obj.pd.hDC,Cast(HGDIOBJ,obj.hf))
  ' загружаем цвета в контекст
  If color_BK<>0 Then
    SetBkColor(obj.pd.hDC,color_BK)
  EndIf
  If color_T<>0 Then
    SetTextColor(obj.pd.hDC,color_T)
  EndIf
  ' узнаем размеры области печати
  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
            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
          If obj.tempcount=obj.count Then
            If obj.curS="" Then obj.curS=obj.tempcurS
            If StartPage (obj.pd.hDC)>0 Then
              DrawText (obj.pd.hDC,obj.curS,Len(obj.curS) ,@obj.r,0)
              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
            DrawText (obj.pd.hDC,obj.curS,Len(obj.curS) ,@obj.r,0)
            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




