#define FORM_A4 9  
 #define PS_SOLID 0  
 #define RGB( nR,nG,nB ) ( nR + ( nG * 256 ) + ( nB * 256 * 256 ) )  
 #define BLACK RGB( 0x0 ,0x0 ,0x0 )  
  
 procedure Main 
   local cFile 
   local nSelect 
  
   REQUEST HB_CODEPAGE_RU866  
   HB_CDPSELECT( "RU866" ) 
  
   cFile = "winprint.txt" 
  
   nSelect = Alert( 'Печатаем?', {"Крупно", "Мелко", "Аборт"} ) 
   do case 
     case nSelect == 1 
       WinPrintFile(cFile, .F.) 
     case nSelect == 2 
       WinPrintFile(cFile, .T.) 
     otherwise 
       quit 
   endcase 
  
 return 
  
 procedure WinPrintFile(cFile, lCompressed, cPrinter) 
   WinPrintText(MemoRead(cFile), lCompressed, cPrinter) 
 return 
  
 procedure WinPrintText(cText, lCompressed, cPrinter) 
   local oPrinter 
   local cDelim := chr(10)+chr(13) 
   local nLineCount, nLineIndex, cLineText 
   local I 
  
   if Empty(lCompressed)  
     lCompressed := .F. 
   endif 
  
   if Empty(cPrinter)  
     cPrinter := win_PrinterGetDefault() 
   endif 
  
   oPrinter := Win_Prn():New(cPrinter)  
   IF !oPrinter:Create()  
     Alert("Cannot Create Printer")  
   ELSE  
  
     oPrinter:Landscape := .F.  
     oPrinter:FormType := FORM_A4  
     oPrinter:Copies := 1  
    
     IF !oPrinter:startDoc('Krab printing')  
       Alert("StartDoc() failed")  
     ELSE  
       oPrinter:SetPen(PS_SOLID, 1, BLACK)  
  
       if lCompressed  
 //        oPrinter:SetFont('Courier New', 8,{3,-50}) 
         oPrinter:SetFont('Lucida Console',8,{3,-50}) 
       else 
         oPrinter:SetFont('Courier New', 10,{4,-47}) 
       endif 
  
       oPrinter:Charset(255) 
  
       nLineCount = numtoken( cText, cDelim ) 
       nLineIndex = 1 
       while nLineIndex <= nLineCount 
         cLineText := token( cText, cDelim, nLineIndex ) 
         I := At(chr(12), cLineText) 
         if I == 0  
           oPrinter:NewLine()  
           oPrinter:TextOut(cLineText)  
         else 
           while I > 0 
             if I > 1  
               oPrinter:NewLine()  
               oPrinter:TextOut(SubStr(cLineText, 1, I-1)) 
             endif 
             oPrinter:NewPage() 
             cLineText := Right(cLineText, Len(cLineText) - I) 
             I := At(chr(12), cLineText) 
           enddo 
           if .not. cLineText == "" 
             oPrinter:NewLine()  
             oPrinter:TextOut(cLineText) 
           endif 
         endif 
         ++nLineIndex 
       enddo 
  
       oPrinter:EndDoc()  
     ENDIF  
     oPrinter:Destroy()  
   ENDIF 
  
 return