Print Picture and Text Contents

[Rudi]

That's it Leif...but what is a "w" between friends

[Leif]

A "w"? Surely a single "u" is the difference?

Or should that be "ewe"....

[Rudi]

Why didn't I see that one!!!

[D Willett]

Now now you pair... this is a serious topic ! behave

[Rudi]

Right Sarg ... back on track... print picture and text content was it...?

[D Willett]

lol..
Back to it. Using some code from Andrea's web site, I can get the default printer with the following:

Code: Select all

MS Windows API Function Prototypes
Private Declare Function GetProfileString Lib "kernel32.dll" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long

Module
'---------------------------------------------------------------
' Retreive the vb object "printer" corresponding to the window's
' default printer.
'---------------------------------------------------------------
'---------------------------------------------------------------
' Retreive the vb object "printer" corresponding to the window's
' default printer.
'---------------------------------------------------------------
Public Function GetDefaultPrinter() As Printer
    Dim strBuffer As String * 254
    Dim iRetValue As Long
    Dim strDefaultPrinterInfo As String
    Dim tblDefaultPrinterInfo() As String
    Dim objPrinter As Printer

    ' Retreive current default printer information
    iRetValue = GetProfileString("windows", "device", ",,,", strBuffer, 254)
    strDefaultPrinterInfo = Left(strBuffer, InStr(strBuffer, Chr(0)) - 1)
    tblDefaultPrinterInfo = Split(strDefaultPrinterInfo, ",")
    For Each objPrinter In Printers
        If objPrinter.DeviceName = tblDefaultPrinterInfo(0) Then
            MsgBox objPrinter.DeviceName
            Exit For
        End If
    Next
    MsgBox "not found"
    If objPrinter.DeviceName <> tblDefaultPrinterInfo(0) Then
        Set objPrinter = Nothing
    End If
    Set GetDefaultPrinter = objPrinter
End Function

This returns the correct default printer when called using: GetDefaultPrinter
So I'm assuming (not tried yet) I can use this function somewhere at the beginning of my code before I select the label printer to hold the default printer as a variable.

Code: Select all

Private Sub Command1_Click()
  
    cd.CancelError = True
    On Error GoTo PrintImageFromFileError

    Dim x      As Long
    Dim sFileToPrint As String

'GET DEFAULT PRINTER BEFORE IT IS CHANGED:
GetDefaultPrinter

    With cd
        cd.ShowPrinter
    
    End With

    sFileToPrint = "L:\MMPDF\ConsoleFiles\" & Me.txtEST.Text & "\" & "QR.jpg"
    
    Dim lngOption As Long

    x = PrintImageFromFile(sFileToPrint, True)
    ' x = PrintImageFromFile(sFileToPrint, 1, False, False)

'RETURN DEFAULT PRINTER AS IT WAS BEFORE THIS FILE WAS PRINTED
    
Unload Me
    Exit Sub

PrintImageFromFileError:
    Select Case Err.Number
        Case 32755
            'Do Nothing
        Case Else
            MsgBox "Error " & Err.Number & " - " & _
                   Err.Description, vbOKOnly, "Error raised"
            End
    End Select
End Sub

The question is, how would I reset the default printer back to the original as highlited in the code above.?

[HansV]

Copy the following code into a module:

Code: Select all

Public Sub SetDefaultPrinter(PrinterName As String)
    Dim p As printer
    For Each p In Printers
        If UCase(p.DeviceName) = UCase(PrinterName) Then
            Set printer = p
            Exit For
        End If
    Next p
End Sub

Public Function GetDefaultPrinter() As String
    GetDefaultPrinter = printer.DeviceName
End Function

Use like this in Command1_Click:

Code: Select all

    Dim strPrinter As String
    ' Store default printer name in variable
    strPrinter = GetDefaultPrinter
    ...
    ...
    ' Restore default printer
    SetDefaultPrinter strPrinter

[D Willett]

Just the job, Thanks Hans.
Asking for help always makes me a little 'Sheepish'

[HansV]

Like this?

6654.gif

[D Willett]

..

[Rudi]

Baaa....is this the q'ewe' to allow us to go all scuttlebutt again...

BTW: I think hans meant:

Code: Select all

...If EweCase(p.DeviceName) = EweCase(PrinterName) Then...

[HansV]

Only if you have sufficient RAM.

[D Willett]

Cheers Rudi, the change in code works but the printings a little woolly !
( I think we're going to get moderated very very soon !! )

[Rudi]

Hans, "Stewy", Leif and Claude will have our chops

[D Willett]

Can all of you stop high jacking my thread, this is Baaaaaa-d practice and may cause one of us to have our membership fleeced !!
Thank Ewe

[Rudi]

This is pun....

[D Willett]

Hi Hans
Just wondered if you would check this.

Code: Select all

Private Sub Command1_Click()
  Dim strPrinter As String
    cd.CancelError = True
    On Error GoTo PrintImageFromFileError

    Dim x      As Long
    Dim sFileToPrint As String
    
    ' Store default printer name in variable
    strPrinter = GetDefaultPrinter
    MsgBox strPrinter
    
    
    With cd
        cd.ShowPrinter
    
    End With

    sFileToPrint = "L:\MMPDF\ConsoleFiles\" & Me.txtEST.Text & "\" & "QR.jpg"
    
    Dim lngOption As Long

    x = PrintImageFromFile(sFileToPrint, True)
    ' x = PrintImageFromFile(sFileToPrint, 1, False, False)

    ' Restore default printer
    SetDefaultPrinter strPrinter
    MsgBox strPrinter

    Unload Me
    Exit Sub

PrintImageFromFileError:
    Select Case Err.Number
        Case 32755
            'Do Nothing
        Case Else
            MsgBox "Error " & Err.Number & " - " & _
                   Err.Description, vbOKOnly, "Error raised"
            End
    End Select
End Sub

I've added two msgbox instances to test this and see what happens. They both fire and return the name of the default printer, or so I think.

msgbox 1 returns: HP LaserJet 100 color MFP M175 PCL6

I then select the label printer to output the label.

msgbox 2 returns: HP LaserJet 100 color MFP M175 PCL6

So I think the printer has been reset back as it was before the label printer.
However, when I check in control panel the default printer is the label printer.

Have I applied the code correctly?

Cheers

[HansV]

It looks OK, but I don't have VB6 so I cannot test the code, sorry.

[D Willett]

Ok Hans, Cheers.

[D Willett]

Ok, got this now. Others may want to use this so I'll put the solution here.

I did have one Hiccup, I had a duplicate instance of POINTAPI which I changed to POINTAPI2 just for this instance and any relation to the form.
I'm not sure if this will cause me any issues elsewhere inthe project, hopefully I will be informed of this by the members as good advice.
Cheers


Thank you to Andy Hughes:
http://www.planetsourcecode.com/vb/scri ... 1&lngWId=1

Module:

Code: Select all

'This project needs 6 command buttons
Option Explicit
Public Const FW_NORMAL = 400
Public Const DEFAULT_CHARSET = 1
Public Const OUT_DEFAULT_PRECIS = 0
Public Const CLIP_DEFAULT_PRECIS = 0
Public Const DEFAULT_QUALITY = 0
Public Const DEFAULT_PITCH = 0
Public Const FF_ROMAN = 16
Public Const CF_PRINTERFONTS = &H2
Public Const CF_SCREENFONTS = &H1
Public Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
Public Const CF_EFFECTS = &H100&
Public Const CF_FORCEFONTEXIST = &H10000
Public Const CF_INITTOLOGFONTSTRUCT = &H40&
Public Const CF_LIMITSIZE = &H2000&
Public Const REGULAR_FONTTYPE = &H400
Public Const LF_FACESIZE = 32
Public Const CCHDEVICENAME = 32
Public Const CCHFORMNAME = 32
Public Const GMEM_MOVEABLE = &H2
Public Const GMEM_ZEROINIT = &H40
Public Const DM_DUPLEX = &H1000&
Public Const DM_ORIENTATION = &H1&
Public Const PD_PRINTSETUP = &H40
Public Const PD_DISABLEPRINTTOFILE = &H80000

Public Type POINTAPI
    x As Long
    y As Long
End Type

Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Public Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Public Type PAGESETUPDLG
    lStructSize As Long
    hwndOwner As Long
    hDevMode As Long
    hDevNames As Long
    flags As Long
    ptPaperSize As POINTAPI
    rtMinMargin As RECT
    rtMargin As RECT
    hInstance As Long
    lCustData As Long
    lpfnPageSetupHook As Long
    lpfnPagePaintHook As Long
    lpPageSetupTemplateName As String
    hPageSetupTemplate As Long
End Type

Public Type CHOOSECOLOR
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    rgbResult As Long
    lpCustColors As String
    flags As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Public Type LOGFONT
        lfHeight As Long
        lfWidth As Long
        lfEscapement As Long
        lfOrientation As Long
        lfWeight As Long
        lfItalic As Byte
        lfUnderline As Byte
        lfStrikeOut As Byte
        lfCharSet As Byte
        lfOutPrecision As Byte
        lfClipPrecision As Byte
        lfQuality As Byte
        lfPitchAndFamily As Byte
        lfFaceName As String * 31
End Type

Public Type CHOOSEFONT
        lStructSize As Long
        hwndOwner As Long          '  caller's window handle
        hDC As Long                '  printer DC/IC or NULL
        lpLogFont As Long          '  ptr. to a LOGFONT struct
        iPointSize As Long         '  10 * size in points of selected font
        flags As Long              '  enum. type flags
        rgbColors As Long          '  returned text color
        lCustData As Long          '  data passed to hook fn.
        lpfnHook As Long           '  ptr. to hook function
        lpTemplateName As String     '  custom template name
        hInstance As Long          '  instance handle of.EXE that
                                       '    contains cust. dlg. template
        lpszStyle As String          '  return the style field here
                                       '  must be LF_FACESIZE or bigger
        nFontType As Integer          '  same value reported to the EnumFonts
                                       '    call back with the extra FONTTYPE_
                                       '    bits added
        MISSING_ALIGNMENT As Integer
        nSizeMin As Long           '  minimum pt size allowed &
        nSizeMax As Long           '  max pt size allowed if
                                       '    CF_LIMITSIZE is used
End Type

Public Type PRINTDLG_TYPE
    lStructSize As Long
    hwndOwner As Long
    hDevMode As Long
    hDevNames As Long
    hDC As Long
    flags As Long
    nFromPage As Integer
    nToPage As Integer
    nMinPage As Integer
    nMaxPage As Integer
    nCopies As Integer
    hInstance As Long
    lCustData As Long
    lpfnPrintHook As Long
    lpfnSetupHook As Long
    lpPrintTemplateName As String
    lpSetupTemplateName As String
    hPrintTemplate As Long
    hSetupTemplate As Long
End Type

Public Type DEVNAMES_TYPE
    wDriverOffset As Integer
    wDeviceOffset As Integer
    wOutputOffset As Integer
    wDefault As Integer
    extra As String * 100
End Type

Public Type DEVMODE_TYPE
    dmDeviceName As String * CCHDEVICENAME
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integer
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName As String * CCHFORMNAME
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
End Type

Public Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Declare Function PrintDialog Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PRINTDLG_TYPE) As Long
Public Declare Function PAGESETUPDLG Lib "comdlg32.dll" Alias "PageSetupDlgA" (pPagesetupdlg As PAGESETUPDLG) As Long
Public Declare Function CHOOSEFONT Lib "comdlg32.dll" Alias "ChooseFontA" (pChoosefont As CHOOSEFONT) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Public Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Dim OFName As OPENFILENAME
Dim CustomColors() As Byte

Form and Command:

Code: Select all

Option Explicit

'**************************************
' Only changes printer for the current job being printed
'
Public Function SetDefaultPrinter(ByVal DeviceName As String) As Boolean

    'This bit modified from original code from Duncan Jones

    Dim prThis As Printer

    If Printers.Count > 0 Then                  '\\ Iterate through all the installed printers
        For Each prThis In Printers             '\\ If the desired one is found
            If prThis.DeviceName = DeviceName Then
                Set Printer = prThis
                SetDefaultPrinter = True        '\\ Stop searching
                Exit For
            End If
        Next prThis
    End If
    
End Function
Public Function ShowPrinter(Optional PrintFlags As Long)
        
    '-> ShowPrinter Code by Donald Grover

    Dim PrintDlg As PRINTDLG_TYPE
    Dim DevMode As DEVMODE_TYPE
    Dim DevName As DEVNAMES_TYPE
    Dim lpDevMode As Long
    Dim lpDevName As Long
    Dim bReturn As Integer
    Dim objPrinter As Printer
    Dim NewPrinterName As String

    ' Use PrintDialog to get the handle to a memory block with a DevMode and DevName structures

    PrintDlg.lStructSize = Len(PrintDlg)
    PrintDlg.hwndOwner = Me.hWnd

    PrintDlg.flags = PrintFlags
    On Error Resume Next
    
    'Set the current orientation and duplex setting
    DevMode.dmDeviceName = Printer.DeviceName
    DevMode.dmSize = Len(DevMode)
    DevMode.dmFields = DM_ORIENTATION Or DM_DUPLEX
    DevMode.dmPaperWidth = Printer.Width
    DevMode.dmOrientation = Printer.Orientation
    DevMode.dmPaperSize = Printer.PaperSize
    DevMode.dmDuplex = Printer.Duplex
    On Error GoTo 0

    'Allocate memory for the initialization hDevMode structure and copy the settings gathered above into this memory
    PrintDlg.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(DevMode))
    lpDevMode = GlobalLock(PrintDlg.hDevMode)
    If lpDevMode > 0 Then
        CopyMemory ByVal lpDevMode, DevMode, Len(DevMode)
        bReturn = GlobalUnlock(PrintDlg.hDevMode)
    End If

    'Set the current driver, device, and port name strings
    With DevName
        .wDriverOffset = 8
        .wDeviceOffset = .wDriverOffset + 1 + Len(Printer.DriverName)
        .wOutputOffset = .wDeviceOffset + 1 + Len(Printer.Port)
        .wDefault = 0
    End With

    With Printer
        DevName.extra = .DriverName & Chr(0) & .DeviceName & Chr(0) & .Port & Chr(0)
    End With

    'Allocate memory for the initial hDevName structure and copy the settings gathered above into this memory
    PrintDlg.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(DevName))
    lpDevName = GlobalLock(PrintDlg.hDevNames)
    
    If lpDevName > 0 Then
        CopyMemory ByVal lpDevName, DevName, Len(DevName)
        bReturn = GlobalUnlock(lpDevName)
    End If

    'Call the print dialog up and let the user make changes
    If PrintDialog(PrintDlg) <> 0 Then                          'First get the DevName structure.
        lpDevName = GlobalLock(PrintDlg.hDevNames)
        CopyMemory DevName, ByVal lpDevName, 45
        bReturn = GlobalUnlock(lpDevName)
        GlobalFree PrintDlg.hDevNames

        'Next get the DevMode structure and set the printer properties appropriately
        lpDevMode = GlobalLock(PrintDlg.hDevMode)
        CopyMemory DevMode, ByVal lpDevMode, Len(DevMode)
        bReturn = GlobalUnlock(PrintDlg.hDevMode)
        GlobalFree PrintDlg.hDevMode
        NewPrinterName = UCase$(Left(DevMode.dmDeviceName, InStr(DevMode.dmDeviceName, Chr$(0)) - 1))
        If Printer.DeviceName <> NewPrinterName Then
            For Each objPrinter In Printers
                If UCase$(objPrinter.DeviceName) = NewPrinterName Then
                    Set Printer = objPrinter
                    'set printer toolbar name at this point
                End If
            Next
        End If

        On Error Resume Next
        'Set printer object properties according to selections made by user
        Printer.Copies = DevMode.dmCopies
        Printer.Duplex = DevMode.dmDuplex
        Printer.Orientation = DevMode.dmOrientation
        Printer.PaperSize = DevMode.dmPaperSize
        Printer.PrintQuality = DevMode.dmPrintQuality
        Printer.ColorMode = DevMode.dmColor
        Printer.PaperBin = DevMode.dmDefaultSource
        On Error GoTo 0
    End If
    
    ShowPrinter = NewPrinterName
    
End Function

Private Sub Command1_Click()

    'ShowPrinter
    SetDefaultPrinter (ShowPrinter)     ' this bit calls the Printer Common Dialog Box and sets the new printer
                                        ' temporarily for this print job.
                                        
    ' This bit below is where you would put your print routine, I have left a demo for you to see
    
    ' this bit sets up default settings
    Printer.Orientation = 1         ' 1-portrait, 2-landscape
    Printer.ScaleMode = vbCentimeters
    
    ' Initalise Printer
    Printer.Print "";
    
    'set printer current x,y settings
    Printer.CurrentX = 5
    Printer.CurrentY = 5
    
    'print some text
    Printer.Print "TEST";
    
    'finish the document
    Printer.EndDoc

    ' if you need more help with print routines or any other VB6 Problems please feel free to
    ' mail me at andy@andythughes.co.uk as I have written extensive routines for many application
    ' ranging from Mail, Print, FTP and kermit routines.
    '
End Sub