Cannot locate FBWinPrint

[BasicCoder2]

Have been trying without success to use the printer.
The link to FBWinPrint seems to be broken?
http://www.freebasic.net/forum/viewtopic.php?t=9498

Paul Squires WinXPrint.bi and test program example compiles but doesn't print anything.
http://www.freebasic.net/forum/viewtopi ... =2&t=25162
I am using a HP Photosmart 7520 series (Network)
The printer has no problem with LPRINT or printing from other programs like WORD, PAINT, Notepad etc.
.

[PaulSquires]

I just tried printing using the testcode that I posted and it worked without any problem. (Of course, I first had to remove the erroneous "RSET" line of code that was just before the .DocEnd line).

I printed to a networked Lexmark laser printer.

Can you post the code you used?

[BasicCoder2]

When I run the test code below the console display is,
HP Photosmart 7520 series (Net
Done
No printing takes place.

save as WinXPrint.bi

Code: Select all

'************************************************************************
' WinXPrint - Paul Squires v0.1 
'
' Based on FBWinPrint - Windows Printing Library by Vincent DeCampo          
'
' --- CHANGES ---
' v0.1: - Consolidated a lot of code into proper class object thereby 
'         making the code easier to read and maintain.
'       - Removed OpenFile, SaveFile. Better to use FF Function versions
'         instead. 
'       - Changed the name of .Dialog to .ShowPrinterDialog
'       - Changed the name of .PrintWindow to .PPrintWindow
'************************************************************************

#Include Once "windows.bi"
#Include Once "win/commdlg.bi"
#Include Once "win/winspool.bi"


Type _MemoryDIB
   Private:
   Public:
      BIH   As BITMAPINFO
      hDIB  As hBITMAP
      hdc   As HDC
      pbits As Any Ptr
      Declare Destructor ()
End Type

Destructor _MemoryDIB()
   Dim pDIB As _MemoryDIB Ptr = @this
   DeleteDC(pDIB->hdc)
   DeleteObject(pDIB->hDIB)
End Destructor


'******** DEFINE PRINTER OBJECT ********
Type WinXPrint
   Private:
      _PrinterDC     As HDC
      _PrinterName   As String
      _FontName      As String = "Arial"
      _FontSize      As Long = 12
      _FontColor     As Long = RGBA(0,0,0,0)
      _FontBold      As Long 
      _FontUnderline As Long 
      _FontItalic    As Long 
      _DOCTitle      As ZString * 255
      _Xscale        As Single
      _yscale        As Single
      _DI            As DOCINFO
      _FULLPAGE      As Long = 10000
      
   Public:
      Declare Function ShowColorPicker() As Long
      Declare Function ShowFont( ByRef FontName As String = "Courier New", _
                                 ByRef FontSize As Long = 10, _
                                 ByRef FontBold As Long = False, _
                                 ByRef FontItalic As Long = False, _
                                 ByRef FontUnderline As Long = False) As String
      Declare Function ShowPageSetup() As Long
      Declare Function ShowPrinterDialog() As String 
      Declare Function RawDataToPrinter( lpData As LPBYTE, dwCount As Long ) As Long

      Declare Sub      ChangePrinter(pzPrinterName As ZString Ptr)
      Declare Sub      DocStart(DOCTitle As String = "Untitled")
      Declare Sub      PageStart()
      Declare Sub      PageEnd()
      Declare Sub      DocEnd()
      Declare Sub      DocAbort()
      Declare Sub      BltImageDC (srcDC As HDC, srcRECT As Rect Ptr, dstRECT As Rect Ptr)
      Declare Sub      PrintBMP (Filename As String, X As Long, Y As Long, dX As Long, dY As Long)
      Declare Sub      PPrint (X As Long, Y As Long, Text As String) 
      Declare Sub      XPrint (Y As Long, Text As String) 
      Declare Sub      ApplyText(hDc As hDC, _
                                 sText As String, _
                                 tRECT As Rect, _
                                 FontName As String = "Arial", _
                                 FontSize As Long, _
                                 FontBold As Long, _
                                 FontItalic As Long, _
                                 FontUnderline As Long, _
                                 clrfore As Long, _
                                 clrback As Long, _
                                 Transp As Long = 1, _
                                 Justify As Long = 0) 
      Declare Sub      SetFont( FontName As String, _
                                FontSize As Long, _
                                FontColor As Long, _
                                FontBold As Long = False, _
                                FontItalic As Long = False, _
                                FontUnderline As Long = False)
      Declare Sub      DrawBox( X1 As Long, Y1 As Long, X2 As Long, Y2 As Long, LineColor As Long, _
                                LineWidth As Long, RoundWidth As Long = 0, RoundHeight As Long = 0)
      Declare Sub      XDrawBox( X1 As Long, Y1 As Long, X2 As Long, Y2 As Long, LineColor As Long, _
                                 LineWidth As Long, RoundWidth As Long = 0, RoundHeight As Long = 0)
      Declare Sub      PPrintWindow (HWnd As HANDLE, X As Long, Y As Long, dX As Long, dY As Long)

      Declare Property PrinterDC() As HDC
      Declare Property PrinterName() As String
      Declare Property PrinterName( sPrinterName As String )     
      Declare Property PageWidth() As Long
      Declare Property PageHeight() As Long

      Declare Constructor()
End Type

''
''
Constructor WinXPrint()
   ' Attach the Windows default printer to the class
   Dim zPrinterName As ZString * MAX_PATH 
   Dim n As Long = MAX_PATH
   GetDefaultPrinter(@zPrinterName,@n)
   this.ChangePrinter(@zPrinterName)
End Constructor

''
''
Property WinXPrint.PrinterDC() As HDC
   Property = _PrinterDC
End Property

''
''
Property WinXPrint.PrinterName() As String
   Property = _PrinterName
End Property

Property WinXPrint.PrinterName( sPrinterName As String )     
   Dim zPrinterName As ZString * MAX_PATH 
   If Len(sPrinterName) > 0 Then
      zPrinterName = sPrinterName
      this.ChangePrinter(@zPrinterName)
   End If
End Property

''
''        
Property WinXPrint.PageWidth() As Long
   Property = GetDeviceCaps(_PrinterDC,HORZRES)
End Property

Property WinXPrint.PageHeight() As Long
   Property = GetDeviceCaps(_PrinterDC, VERTRES)
End Property

''
''
Sub WinXPrint.ChangePrinter(pzPrinterName As ZString Ptr) 
   If _PrinterDC Then DeleteDC _PrinterDC
   _PrinterDC   = CreateDC( Null, pzPrinterName, Null, Null )
   _PrinterName = *pzPrinterName
   _Xscale      = this.Pagewidth / this._FULLPAGE
   _Yscale      = this.Pageheight / this._FULLPAGE 
End Sub

''
''
Function WinXPrint.ShowColorPicker() As Long 
   Dim CustomColors(63) As Byte 
   Dim cc As ChooseColor

   With cc
      .lStructSize  = Len(cc)
      .hWndOwner    = Null
      .hInstance    = Null
      .lpCustColors = Cast(Any Ptr,@CustomColors(0))
      .flags = 0
   End With
   
   'Show the Select Color dialog
   If ChooseColor(@cc) <> 0 Then
      Return cc.rgbResult
   Else
      Return -1
  End If
End Function

''
''
Function WinXPrint.ShowFont( ByRef FontName      As String = "Courier New", _
                             ByRef FontSize      As Long = 10, _
                             ByRef FontBold      As Long = False, _
                             ByRef FontItalic    As Long = False, _
                             ByRef FontUnderline As Long = False _
                             ) As String

   Dim cf      As ChooseFont
   Dim lfont   As LOGFONT
   Dim hMem    As HANDLE
   Dim pMem    As LOGFONT Ptr
   Dim retval  As Long
   
   With lfont
      .lfHeight         = FontSize   ' determine default height
      .lfWidth          = 0  ' determine default width
      .lfEscapement     = 0  ' angle between baseline and escapement vector
      .lfOrientation    = 0  ' angle between baseline and orientation vector
      .lfWeight         = Iif(FontBold, FW_BOLD, FW_NORMAL)  ' normal weight i.e. not bold
      .lfUnderline      = FontUnderline
      .lfItalic         = FontItalic
      .lfCharSet        = DEFAULT_CHARSET 
      .lfOutPrecision   = OUT_DEFAULT_PRECIS
      .lfClipPrecision  = CLIP_DEFAULT_PRECIS 
      .lfQuality        = DEFAULT_QUALITY  
      .lfPitchAndFamily = DEFAULT_PITCH Or FF_ROMAN   ' default pitch, proportional with serifs
      .lfFaceName       = FontName  '"Times New Roman" & Chr(0)  ' string must be null-terminated
   End With
    
   ' Create the memory block which will act as the LOGFONT structure buffer.
   hMem = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(lfont))
   pMem = GlobalLock(hMem)  ' lock and get pointer
   CopyMemory( pMem, @lfont, Len(lfont))  ' copy structure's contents into block
    
    ' Initialize dialog box: Screen and printer fonts, point size between 10 and 72.
   With cf
      .lStructSize = Len(cf)  
      .hwndOwner   = Null          
      .hDC         = Null              ' device context of default printer 
      .lpLogFont   = pMem              ' pointer to LOGFONT memory block buffer
      .iPointSize  = 120               ' 12 point font (in units of 1/10 point)
      .flags       = CF_BOTH Or CF_EFFECTS Or CF_FORCEFONTEXIST Or CF_INITTOLOGFONTSTRUCT Or CF_LIMITSIZE
      .rgbColors   = Rgb(0, 0, 0)      ' black
      .nFontType   = REGULAR_FONTTYPE  ' regular font type i.e. not bold or anything
      .nSizeMin    = 10                ' minimum point size
      .nSizeMax    = 72                ' maximum point size
   End With
    
   ' Call the function. If successful, copy the LOGFONT structure back into the structure
   ' and then print out the attributes we mentioned earlier that the user selected.
   retval = ChooseFont(@cf)  ' open the dialog box
   If retval <> 0 Then  
      CopyMemory( @lfont, pMem, Len(lfont))  ' copy memory back
      ' Now make the fixed-length string holding the font name into a "normal" string.
      FontName      = lfont.lfFaceName
      FontSize      = (cf.iPointSize / 10)
      FontBold      = Iif( lfont.lfWeight > FW_BOLD, True, False)
      FontUnderline = lfont.lfUnderline 
      FontItalic    = lfont.lfItalic
      Return Trim(lfont.lfFaceName)
   End If
    
   ' Deallocate the memory block we created earlier.  Note that this must
   ' be done whether the function succeeded or not.
   GlobalUnlock(hMem)  ' destroy pointer, unlock block
   GlobalFree(hMem)    ' free the allocated memory
    
End Function


''
''
Function WinXPrint.ShowPrinterDialog() As String 
   Dim zPrinterName As ZString * MAX_PATH 
   Dim n         As Long = MAX_PATH
   Dim PDlg      As PrintDlg
   Dim tDevMode  As DEVMODE
   Dim tDevName  As DEVNAMES
   Dim lpDevMode As Long Ptr
   Dim lpDevName As Long Ptr

   ' Use PrintDlg to get the handle to a memory block 
   ' with a DevMode and DevName structures
   PDlg.lStructSize = Len(PrintDlg)
   PDlg.hWndOwner   = GetForegroundWindow()
 
   ' Set the current orientation and duplex setting
   With tDevMode
      .dmSize        = Len(DEVMODE)
      .dmDeviceName  = ""
      .dmFields      = DM_ORIENTATION Or DM_DUPLEX
      .dmPaperWidth  = 0
      .dmOrientation = 0
      .dmPaperSize   = 0
      .dmDuplex      = 0
   End With
   
   ' Allocate memory for the initialization hDevMode structure
   ' and copy the settings gathered above into this memory
   PDlg.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Sizeof(DEVMODE))
   lpDevMode = GlobalLock(PDlg.hDevMode)
   If lpDevMode > 0 Then
     CopyMemory( lpDevMode, @tDevMode, Sizeof(DEVMODE))
     GlobalUnlock(PDlg.hDevMode)
   End If

   ' Call the print dialog up and let the user make changes
   If PrintDlg(@PDlg) <> 0 Then
      lpDevMode = GlobalLock(PDlg.hDevMode)
      If lpDevMode > 0 Then
        CopyMemory( @tDevMode,lpDevMode,Sizeof(DEVMODE))
        GlobalUnlock(PDlg.hDevMode)
      End If      
      zPrinterName = tDevMode.dmDeviceName
   EndIf

   If Len(zPrinterName) > 0 Then
      this.ChangePrinter(@zPrinterName)
   End If
   
   Return zPrinterName
   
End Function

''
'' 
Function WinXPrint.ShowPageSetup() As Long
   Dim PSD As PageSetupDlg

   With PSD
      .lStructSize = Len(PSD)
      .hWndOwner   = GetForegroundWindow()     
      .hInstance   = Null   
      .flags       = PSD_DISABLEPRINTER
   End With
   
   'Show the pagesetup dialog
   If PageSetupDlg(@PSD) Then
     Return 0
   Else
     Return -1
   End If
End Function

''
''
Sub WinXPrint.DocStart( DOCTitle As String = "Untitled")
   _DOCTitle       = DOCTitle
   _DI.cbSize      = Len(DOCINFO)
   _DI.lpszDocName = @_DOCTitle
   StartDoc _PrinterDC, @_DI
End Sub

Sub WinXPrint.DocEnd()
   EndDoc _PrinterDC
End Sub

Sub WinXPrint.PageStart()
   StartPage _PrinterDC
End Sub

Sub WinXPrint.PageEnd()
   EndPage _PrinterDC
End Sub

Sub WinXPrint.DocAbort()
   AbortDoc _PrinterDC
End Sub

''
''
Sub WinXPrint.BltImageDC (srcDC As HDC, srcRECT As Rect Ptr, dstRECT As Rect Ptr)
   Dim tDIB    As _MemoryDIB
   Dim pDIB    As _MemoryDIB Ptr
   Dim BIH     As BITMAPINFO
   Dim pBIH    As BITMAPINFO Ptr
   Dim NewSize As Rect

   NewSize.Top    = 0
   NewSize.Left   = 0
   NewSize.Bottom = dstRECT[0].Bottom - dstRECT[0].Top
   NewSize.Right  = dstRECT[0].Right  - dstRECT[0].Left

   pDIB = @tDIB

   With BIH.bmiHeader
      .biWidth         = NewSize.Right
      .biHeight        = NewSize.Bottom
      .biSizeImage     = .biWidth * .biHeight * 3
      .biSize          = Sizeof(BIH.bmiHeader)
      .biPlanes        = 1
      .biBitCount      = 24
      .biCompression   = BI_RGB
      .biClrUsed       = 0
      .biXPelsPerMeter = 0
      .biYPelsPerMeter = 0
   End With
   
   pBIH = @BIH

   With pDIB[0]
      MoveMemory( @.BIH, pBIH, Sizeof(BITMAPINFO) )
      .hdc = CreateCompatibleDC(0)
      .hDIB = CreateDIBSection(.hdc, @.BIH, DIB_RGB_COLORS, @.pbits, 0, 0)      
      If SelectObject(.hdc, .hDIB) = 0 Then
         DeleteDC(.hdc)
         DeleteObject(.hDIB)
      End If
   End With

   
   SetStretchBltMode tDIB.hdc, COLORONCOLOR
   StretchBlt tDIB.hdc, 0, 0, NewSize.Right, NewSize.Bottom, _
              srcDC, srcRECT[0].Left, srcRECT[0].top, srcRECT[0].Right, srcRECT[0].bottom, SRCCOPY 

   BitBlt _PrinterDC,dstRECT[0].Left, dstRECT[0].top, dstRECT[0].Right, dstRECT[0].bottom, _
          tDIB.hdc, srcRECT[0].Left, srcRECT[0].top, SRCCOPY
   
   With pDIB[0]
      DeleteDC(.hdc)
      DeleteObject(.hDIB)
   End With
   
End Sub

''
''
Sub WinXPrint.SetFont( FontName      As String, _
                       FontSize      As Long, _
                       FontColor     As Long, _
                       FontBold      As Long = False, _
                       FontItalic    As Long = False, _
                       FontUnderline As Long = False)
                       
   Dim Convert(3) As Byte

   'Convert Font RGBA color to COLORREF for DRAWTEXT function
   MoveMemory( @Convert(0), @FontColor, 4 )
   Swap Convert(2), Convert(0)
   MoveMemory( @FontColor, @Convert(0), 4 )

   _FontName  = FontName
   _FontSize  = FontSize
   _FontColor = FontColor 
   _FontBold  = FontBold
   _FontUnderline = FontUnderline
   _FontItalic = FontItalic
   
End Sub

''
''
Sub WinXPrint.PPrint (X As Long, Y As Long, Text As String)
   Dim tRECT As Rect

   tRECT.Left = X*_xscale
   tRECT.Top  = Y*_yscale
   this.ApplyText( _PrinterDC, Text, tRECT, _FontName, _FontSize, _
                   _FontBold, _FontItalic, _FontUnderline, _FontColor, 0, 1, 0 )
End Sub

''
''
Sub WinXPrint.XPrint (Y As Long, Text As String)
   Dim tRECT As Rect
   Dim X     As Long = 300

   Y = Y * (_FontSize * 13)
    
   tRECT.Left = X*_xscale
   tRECT.Top  = Y*_yscale
   this.ApplyText( _PrinterDC, Text, tRECT, _FontName, _FontSize, _
                   _FontBold, _FontItalic, _FontUnderline, _FontColor, 0, 1, 0 )
End Sub

''
''
Sub WinXPrint.XDrawBox( X1 As Long, Y1 As Long, X2 As Long, Y2 As Long, _
                        LineColor As Long, LineWidth As Long, _
                        RoundWidth As Long = 0, RoundHeight As Long = 0)
   Dim hRPen As HANDLE
   Dim Convert(3) As Byte

   Y1 = Y1 * (_FontSize * 13)
   Y2 = Y2 * (_FontSize * 13)

   'Convert Font RGBA color to COLORREF for DRAWTEXT function
   MoveMemory( @Convert(0), @LineColor, 4 )
   Swap Convert(2), Convert(0)
   MoveMemory( @LineColor, @Convert(0), 4 )

   X1*= _xscale:  X2*= _xscale:  Y1*= _yscale:  Y2*= _yscale
    
   hRPen = CreatePen(PS_SOLID, LineWidth, LineColor)
   DeleteObject SelectObject(_PrinterDC, hRPen)
   RoundRect _PrinterDC, X1, Y1, X2, Y2, RoundWidth, RoundHeight
   DeleteObject hRPen
End Sub


''
''
Sub WinXPrint.DrawBox( X1 As Long, Y1 As Long, X2 As Long, Y2 As Long, _
                       LineColor As Long, LineWidth As Long, _
                       RoundWidth As Long = 0, RoundHeight As Long = 0)
   Dim hRPen As HANDLE
   Dim Convert(3) As Byte

   ' Convert Font RGBA color to COLORREF for DRAWTEXT function
   MoveMemory( @Convert(0), @LineColor, 4 )
   Swap Convert(2), Convert(0)
   MoveMemory( @LineColor, @Convert(0), 4 )

   X1*= _xscale:  X2*= _xscale:  Y1*= _yscale:  Y2*= _yscale
    
   hRPen = CreatePen(PS_SOLID, LineWidth, LineColor)
   DeleteObject SelectObject(_PrinterDC, hRPen)
   RoundRect _PrinterDC, X1, Y1, X2, Y2, RoundWidth, RoundHeight
   DeleteObject hRPen
End Sub

''
''
Sub WinXPrint.ApplyText( hDc           As hDC, _
                         sText         As String, _
                         tRECT         As Rect, _
                         FontName      As String = "Arial", _
                         FontSize      As Long, _ 
                         FontBold      As Long, _
                         FontItalic    As Long, _
                         FontUnderline As Long, _
                         clrfore       As Long, _
                         clrback       As Long, _
                         Transp        As Long = 1, _
                         Justify       As Long = 0) 
    
   Dim pLOGFONT  As LOGFONT
   Dim hOldFont  As HANDLE
   Dim hFont     As HANDLE
   Dim ScaleSize As Long
        
   ScaleSize = -MulDiv(FontSize, GetDeviceCaps(hDc, LOGPIXELSY), 72) 
   hFont = CreateFont( ScaleSize, _      ' height
                       0, _              ' width
                       0, _              ' nEscapement 
                       0, _              ' orientation
                       Iif(FontBold, FW_BOLD, FW_NORMAL), _  ' weight
                       FontItalic, _     ' italic
                       FontUnderline, _  ' underline
                       0, _              ' strikeout
                       DEFAULT_CHARSET, OUT_OUTLINE_PRECIS, 0, ANTIALIASED_QUALITY, 0, Strptr(FontName))
    
   hOldFont = SelectObject(hDc, hFont)
        
   SetBkMode    hDc, Transp
   SetTextColor hDc, clrfore
   SetBkColor   hDc, clrback
    
   DrawText (hDc, Strptr(sText), Len(sText), @tRECT, DT_NOCLIP + Justify) 
    
   hFont = SelectObject(hDc, hOldFont)
   DeleteObject hFont
    
End Sub

''
''
Sub WinXPrint.PPrintWindow( HWnd As HANDLE, X As Long, Y As Long, dX As Long, dY As Long)
   Dim wndDC As HDC
   Dim wndRECT As Rect
   Dim dstRECT As Rect
   
   If HWnd > 0 Then
      wndDC = GetWindowDC(HWnd)
      GetWindowRect(HWnd, @wndRECT)
      dstRECT.Left   = X*_Xscale
      dstRECT.Top    = Y*_Yscale
      dstRECT.Right  = (X+dX)*_XScale
      dstRECT.Bottom = (Y+dY)*_YScale
      this.BltImageDC(wndDC, @wndRECT, @dstRECT) 
   End If
End Sub


' RawDataToPrinter - sends binary data directly to a printer
'
' Params:
'   szPrinterName - NULL terminated string specifying printer name
'   lpData        - Pointer to raw data bytes
'   dwCount       - Length of lpData in bytes
'
' Returns: TRUE for success, FALSE for failure.
'
Function WinXPrint.RawDataToPrinter( lpData As LPBYTE, dwCount As Long ) As Long
   Dim szPrinterName As LPSTR = Strptr(_PrinterName)
   Dim hPrinter As HANDLE
   Dim As DOC_INFO_1 DocInfo
   Dim As Long dwJob, dwBytesWritten

   '' Need a handle to the printer.
   If OpenPrinter( szPrinterName, @hPrinter, Null ) = 0 Then Return False
   
   ' Fill in the structure with info about this "document."
   DocInfo.pDocName = @"My Document"
   DocInfo.pOutputFile = Null
   DocInfo.pDatatype = @"RAW"
   
   ' Inform the spooler the document is beginning.
   dwJob = StartDocPrinter( hPrinter, 1, Cast(Byte Ptr, @DocInfo) )
   If dwJob = 0 Then
      ClosePrinter( hPrinter )
      Return False
   End If
      
   ' Start a page.
   If StartPagePrinter( hPrinter ) = 0 Then
      EndDocPrinter( hPrinter )
      ClosePrinter( hPrinter )
      Return False
   End If
      
   ' Send the data to the printer.
   If WritePrinter( hPrinter, lpData, dwCount, @dwBytesWritten ) =0 Then
      EndPagePrinter( hPrinter )
      EndDocPrinter( hPrinter )
      ClosePrinter( hPrinter )
      Return False
   End If
      
   ' End the page.
   If EndPagePrinter( hPrinter ) = 0 Then
      EndDocPrinter( hPrinter )
      ClosePrinter( hPrinter )
      Return False
   End If
      
   ' Inform the spooler that the document is ending.
   If EndDocPrinter( hPrinter ) = 0 Then
      ClosePrinter( hPrinter )
      Return False
   End If
      
   ' Tidy up the printer handle.
   ClosePrinter( hPrinter )

   ' Check to see if correct number of bytes were written.
   If dwBytesWritten <> dwCount Then
      Return False
   End If

   Return True

End Function

''
''
Sub WinXPrint.PrintBMP( Filename As String, X As Long, Y As Long, dX As Long, dY As Long)
   Dim tempDIB  As _MemoryDIB
   Dim ptempDIB As _MemoryDIB Ptr = @tempDIB
   Dim srcRECT  As Rect
   Dim dstRECT  As Rect
   Dim BIH      As BITMAPINFO
   Dim pBIH     As BITMAPINFO Ptr
   Dim BFH      As BITMAPFILEHEADER
   Dim iData()  As Byte
   Dim BIHSize  As Long
   Dim hFile    As Long
   Dim Ext      As String
   Dim hMem     As HANDLE
   Dim pMem     As Any Ptr
   Dim imgSize  As Long
   Dim iWidth   As Long
   Dim iHeight  As Long
   
   ' Load the image      
   If Dir(Filename) = "" Then Print "Can't load bmp" : Exit Sub

   With BIH.bmiHeader
      hFile = Freefile
      Open Filename For Binary As #hFile
         Get #hFile, , BFH
         Get #hFile, , BIH
         Seek #hFile, BFH.bfOffBits + 1
                  
         .biSizeImage = .biWidth * .biHeight * (.biBitCount/8)
         imgSize = .biSizeImage
         
         If imgSize < 1 Then Print "Can't load bmp" : Exit Sub
         
         ReDim iData(imgSize - 1)
         Get #hFile, , iData()
         Close #hFile         
         
         pBIH = @BIH
         
         With ptempDIB[0]
            MoveMemory( @.BIH, pBIH, Sizeof(BITMAPINFO) )
            .hdc = CreateCompatibleDC(0)
            .hDIB = CreateDIBSection(.hdc, @.BIH, DIB_RGB_COLORS, @.pbits, 0, 0)      
            If SelectObject(.hdc, .hDIB) = 0 Then
               DeleteDC(.hdc)
               DeleteObject(.hDIB)
            End If
         End With

         If ptempDIB[0].pBits > 0 Then    
            MoveMemory( ptempDIB[0].pBits, @iData(0), imgSize )
            srcRECT.Left    = 0
            srcRECT.top     = 0
            srcRECT.Right   = tempDIB.BIH.bmiHeader.biWidth
            srcRECT.bottom  = tempDIB.BIH.bmiHeader.biHeight
            
            dstRECT.Left    = X*_Xscale
            dstRECT.Top     = Y*_yscale
            dstRECT.Right   = (X+dX)*_xscale
            dstRECT.Bottom  = (Y+dY)*_Yscale
            
            this.BltImageDC(tempDIB.hdc, @srcRECT, @dstRECT)
         
            DeleteDC(ptempDIB->hdc)
            DeleteObject(ptempDIB->hDIB)
         End If    
   End With
   
End Sub

Couldn't find the bitmap in the original example so had to make my own,
"AnneKlein.bmp", it is a 255x255 24bit image

save as WinXPrintTest.bas

Code: Select all

#Include Once "WinXPrint.bi"

'--------------------------------------------------------------------------------
Sub PrintTest()

 Dim PO       As WinXPrint
 Dim Bedrijf  As String = "Holland Meel"
 Dim Datum    As String 
 Dim gBlad    As String = "1  "

 Dim LNr      As Long        

 Datum = "2015-10-22"  '

 With PO
 
    '***********************************************
    '* Dialog Usage and Graphics Functions Example *
    '***********************************************
     
     If .ShowPrinterDialog = "" Then Exit Sub ' <- Shows Dialog (Not necessary if using default printer and settings)

? .PrinterName

     .DocStart

     .DrawBox (100,100,9900,9900,RGBA(255,0,0,0), 20, 150, 150)

     .SetFont ("Courier New", 30, RGBA (255, 0, 0, 0), 1, 1, 0)

     .PPrint (300,200,"Holland Meel B.V. ")

     .SetFont ("Verdana", 8, RGBA (0, 0, 255, 0))

     .XPrint (6, "Oosteinde 304 ")                 '  700
     .XPrint (7, "7671 AG  Vriezenveen ")          '  800
     .XPrint (8, "Tel: 0546-5561501 ")             '  900
     .XPrint (9, "Fax: 0546-564024 ")              ' 1000
     .XPrint (10,"info@somemeial.nl ")           ' 1100

     .PrintBMP ("AnneKlein.bmp", 8000,300,1200,800)          ' Logo = 3/2   (1500,1000)

     .PPrint (300,9700,"IBAN: NL37 ABNA 0437 2738 57 - BIC ABNANL2A - BTW nr. NL800484022B01 - KvK nr. 06066849 ")

     .SetFont ("Courier New", 11, RGBA (0, 0, 0, 0), 0, 0, 0)       

     Lnr  = 9

     .XDrawBox (300, Lnr, 9700, Lnr + 3, RGBA (255,0,0,0), 10, 100, 100)          ' Red Line

     .DocEnd
  
 End With
End Sub

PrintTest    

Print "Done"
Sleep

[PaulSquires]

Interesting. Your code seems okay compared to the code I'm using. When you run the program a dialog window should open asking you to select your printer. When a printer is selected the dialog closes and the document is created. Your console window should print the name of the chosen printer and "Done" showing that the print job was created and sent to the printer via Windows print spooler. Are you able to see that the print job was created? It should be called "Untitled". If you have a "pdf printer driver" set up on your computer try printing to that instead as a test. If it creates the pdf document then at least we know the issue may be your specific type of printer. Not 100% sure at this point.

You could also try removing everything but the bare minimum to see if it prints. For example:

Code: Select all

#Include Once "WinXPrint.bi"

'--------------------------------------------------------------------------------
Sub PrintTest()

 Dim PO       As WinXPrint
 
 With PO
     If .ShowPrinterDialog = "" Then Exit Sub ' <- Shows Dialog (Not necessary if using default printer and settings)

? .PrinterName

     .DocStart
     .SetFont ("Courier New", 30, RGBA (255, 0, 0, 0) )
     .PPrint (300,200,"This is a simple test document")
     .DocEnd
  
 End With
End Sub

PrintTest    

Print "Done"
Sleep

[BasicCoder2]

In your last example code the Print window appeared as it did with the previous test code with the desired printer in the Select Printer list but again nothing was printed after selecting the [PRINT] button all that happened was,
HP Photosmart 7520 series (Net
Done
was printed on the console window.

This post being written in Notepad printed fine with File menu > Print ...
.

[D.J.Peters]

Run this short test inside the fltk-c-1.3.3 folder and report the error message if any.

The point are the error message (if any) not you have to use FLTK.

Joshy

Code: Select all

#include once "fltk-c.bi"
sub ButtonCB cdecl (byval wgt as Fl_Widget ptr,byval win as any ptr)
  dim as Fl_Printer ptr prt = Fl_PrinterNew()
  if prt then
    if Fl_PrinterStartJob(prt,1)=0 then
      if Fl_PrinterStartPage(prt)=0 then
        Fl_PrinterPrintWindow prt,win
        Fl_PrinterEndPage prt
      else
        beep:print "Fl_PrinterStartPage() failed"
      end if
      Fl_PrinterEndJob prt
    else
      beep:print "Fl_PrinterStartJob() failed"
    end if
    Fl_PrinterDelete prt
  else
    beep:print "Fl_PrinterNew() failed"
  end if
end sub
'
' main
'
var win = Fl_WindowNew(320,240)
Fl_WidgetSetCallbackArg Fl_ButtonNew(10,10,300,220,"print window"),@ButtonCB,win
Fl_WindowShow win
Fl_Run

[BasicCoder2]

Run this short test inside the fltk-c-1.3.3 folder and report the error message if any.

The program worked fine, no error messages, printing an image of the window as seen on the computer screen.
.

[PaulSquires]

I wonder if adding the StartPage / EndPage combination will correct your issue:

Code: Select all

#Include Once "WinXPrint.bi"

'--------------------------------------------------------------------------------
Sub PrintTest()

 Dim PO       As WinXPrint
 
 With PO
     If .ShowPrinterDialog = "" Then Exit Sub ' <- Shows Dialog (Not necessary if using default printer and settings)

? .PrinterName

     .DocStart
     .PageStart
     .SetFont ("Courier New", 30, RGBA (255, 0, 0, 0) )
     .PPrint (300,200,"This is a simple test document")
     .PageEnd
     .DocEnd
  
 End With
End Sub

PrintTest    

Print "Done"
Sleep

[BasicCoder2]

I wonder if adding the StartPage / EndPage combination will correct your issue:

No change in behavior.
Looks like I might have to learn to use the FLTK library if I decide I need that functionality.
.