Hi guys,
This post is a response to a thread I started back on 3/2/06 on how the VB
CommonDialog control sets the Windows Default printer to the one chosen ..
which is something nobody really wants.
Mile Wilson posted some great code but I had trouble with it on a couple of
network printers. I discover now that the devicenames of those network
printers were longer than 30 characters and somewhere the APIPrinter Dialog
code truncates the NewPrinterName variable to only 30 characters. The code
that Mike posted is at the bottom of this post.
---------------------------------------------------------------
Mike,
An update...
As you can see in the code below I added a messagebox to display the
NewPrinterName and objPrinter.DeviceName. It appears that the NewPrinterName
is being truncated at 30 characters and so the comparison does not work. My
guess that the longer device names presented a problem was correct.
Why are they being truncated? I don't know yet.

  If UCase(Printer.DeviceName) <> NewPrinterName Then
    For Each objPrinter In Printers

      MsgBox "Selected: " + NewPrinterName + vbCrLf + "Device  : " +
objPrinter.DeviceName

      If UCase$(objPrinter.DeviceName) = NewPrinterName Then
        Set Printer = objPrinter
      End If
    Next
  End If
--------------------------------------------------
Just thought you might like to know what I had discovered. Maybe it's in the
code that pulls the NewPrinterName from the DevMode.dmDeviceName.
--------------------------------------------------

NewPrinterName = UCase$(Left(DevMode.dmDeviceName, _
    InStr(DevMode.dmDeviceName, Chr$(0)) - 1))
-----------------------------------------------

Also I see Len(DevMode) used a lot.

Anyway thanks for the help.
I can probably just make the comparison of the first 30 characters of the
device names and the code would work in 99.9% of the cases.

-----------------------------------------------------------
----------------------------------------------------------
Option Explicit
Private Const OUT_DEFAULT_PRECIS = 0
Private Const CLIP_DEFAULT_PRECIS = 0
Private Const DEFAULT_QUALITY = 0
Private Const DEFAULT_PITCH = 0
Private Const FF_ROMAN = 16
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_ZEROINIT = &H40
Private Const DM_DUPLEX = &H1000&
Private Const DM_ORIENTATION = &H1&
Private Const DM_PAPERSIZE = &H2&
Private Const PD_PRINTSETUP = &H40
Private Const PD_RETURNDC = &H100
Private Const PD_DISABLEPRINTTOFILE = &H80000
Private Const PHYSICALOFFSETX As Long = 112
Private Const PHYSICALOFFSETY As Long = 113
Private Const OPAQUE = 0
Private Const TRANSPARENT = 1
Private Type POINTAPI
  x As Long
  y As Long
End Type
Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
Private 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
Private Type DEVNAMES_TYPE
  wDriverOffset As Integer
  wDeviceOffset As Integer
  wOutputOffset As Integer
  wDefault As Integer
  extra As String * 100
End Type
Private 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
Private Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hdc As Long, ByVal nindex As Long) As Long
Private Declare Function PrintDialog Lib "comdlg32.dll" _
  Alias "PrintDlgA" (pPrintdlg As PRINTDLG_TYPE) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias _
  "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, _
  ByVal cbCopy As Long)
Private Declare Function GlobalLock Lib "kernel32" _
  (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" _
  (ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" _
  (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" _
  (ByVal hMem As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" _
  (ByVal hdc As Long, ByVal nBkMode As Long) As Long

Private Sub SetPrinterOrigin(x As Single, y As Single)
With Printer
  .ScaleLeft = .ScaleX(GetDeviceCaps(.hdc, PHYSICALOFFSETX), _
    vbPixels, .ScaleMode) - x
  .ScaleTop = .ScaleY(GetDeviceCaps(.hdc, PHYSICALOFFSETY), _
    vbPixels, .ScaleMode) - y
  .CurrentX = 0
  .CurrentY = 0
End With
End Sub

Private Function PrintReport(frmOwner As Form, Optional _
  InitialPrinter As String, Optional PrintFlags As Long) _
  As Boolean
Dim PrintDlg As PRINTDLG_TYPE
Dim DevMode As DEVMODE_TYPE
Dim DevName As DEVNAMES_TYPE
Dim lpDevMode As Long, lpDevName As Long
Dim bReturn As Integer, OriginalPrinter As String
Dim objPrinter As Printer, NewPrinterName As String
PrintDlg.lStructSize = Len(PrintDlg)
PrintDlg.hwndOwner = frmOwner.hWnd
PrintDlg.flags = PrintFlags
On Error Resume Next
' save the current VB printer device name in case the user
' presses cancel and we need to restore it
OriginalPrinter = Printer.DeviceName
' Set the initial printer in the dialog
If Len(InitialPrinter) > 0 Then
  For Each objPrinter In Printers
    If InStr(1, objPrinter.DeviceName, InitialPrinter, _
        vbTextCompare) > 0 Then
      Set Printer = objPrinter
      Exit For
    End If
  Next
End If
'
DevMode.dmDeviceName = Printer.DeviceName
DevMode.dmSize = Len(DevMode)
' Must set the appropriate flag in the dmFields entry for
' any setting you wish to use (there are loads of 'em, see
' API Viewer)
DevMode.dmFields = DM_ORIENTATION Or DM_PAPERSIZE
'DevMode.dmPaperWidth = Printer.Width
DevMode.dmOrientation = Printer.Orientation 'vbPRORLandscape
DevMode.dmPaperSize = Printer.PaperSize 'vbPRPSEnv10
'DevMode.dmDuplex = Printer.Duplex
On Error GoTo 0
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
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
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
If PrintDialog(PrintDlg) <> 0 Then
  DoEvents ' allow the dialog to remove itself from the display
  Me.Refresh
  PrintReport = True
  lpDevName = GlobalLock(PrintDlg.hDevNames)
  CopyMemory DevName, ByVal lpDevName, 45
  bReturn = GlobalUnlock(lpDevName)
  GlobalFree PrintDlg.hDevNames
  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 UCase(Printer.DeviceName) <> NewPrinterName Then
    For Each objPrinter In Printers
      If UCase$(objPrinter.DeviceName) = NewPrinterName Then
        Set Printer = objPrinter
      End If
    Next
  End If
'
  On Error Resume Next
  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
  '
  ' Mike's Note: One or other of the above printer settings
  ' is setting the printer font to opaque (even though the
  ' value of Printer.FontTransparent remains True). This might
  ' not happen on all printers, but it needs fixing anyway so
  ' I have now added the following line to set the font back
  ' to transparent.
  SetBkMode Printer.hdc, TRANSPARENT
  '
  On Error GoTo 0
Else
  PrintReport = False ' user cancelled
  For Each objPrinter In Printers
    If objPrinter.DeviceName = OriginalPrinter Then
      Set Printer = objPrinter
      Exit For
    End If
  Next
  GlobalFree PrintDlg.hDevNames
  GlobalFree PrintDlg.hDevMode
End If
End Function

Private Sub Command1_Click()
' Display a printer dialog which starts off with any
' initial printer we wish. In this example we use the
' first Epson printer that we find. If the specified
' printer is not found then the dialog opens showing
' the current default printer (If you want to start
' showing the default then you can either modify the
' routine so as to cause the first For Each loop is not
' executed or, more simply, use something like:
' PrintReport, Me, "start with the default printer"
If PrintReport(Me, "Epson") = False Then
' If PrintReport(Me, "Epson", PD_RETURNDC) = False Then
  Caption = "cancelled"
  Exit Sub ' user cancelled
End If
' ******** Print your document here ********
' The following line sets the origin (0, 0) to the top left
' corner of the physical page on all printers instead of to
' the top left corner of the "printable area" (the default).
' This enables you to position stuff accurately on the page
' whatever printer you are using.
Printer.ScaleMode = vbInches
SetPrinterOrigin 0, 0
'
Printer.Font.Name = "Times New Roman"
Printer.Font.Size = 12
' set the line thickness to about 3 thousandths of an inch
Printer.DrawWidth = Printer.ScaleX(0.003, vbInches, vbPixels)
' draw a 1 x 4 inch rectangle at location (1, 1)
Printer.Line (1, 1)-(1 + 4, 1 + 1), , B
' Draw some text at location (1, 3)
Printer.CurrentX = 1: Printer.CurrentY = 3
Printer.Print "Whisky and Coke®"
Printer.EndDoc
End Sub

This is a limitation of Windows. Bottom line, don't name printers longer
than the max.

#define CCHDEVICENAME 32

Const CCDEVICENAME As Long = 32

Thanks Randy....

I didn't name the printer. This is the name supplied by the manufacturer (or
maybe Microsoft itself) when the printer and driver was installed on the
various PCs in the default manner, which is how 99.9% of the printers are
installed at our customer sites. I supplied shorter Share names for the
printers, but the printers insist on showing themselves with the full name.

Do you have a suggestion around this... especially in a network environment
where the DeviceName is prefixed by the Network path?

Also the printer DeviceNames that have a problem actually are 32 characters
long. That's why I was wondering why they are truncated to 30 by the API
Dialog.

Thanks mucho

Show quoteHide quote

I know of no workaround. I suspect the truncation is to allow for trailing
nulls at the end of the C string.

Show quoteHide quote

Any known problems running VB6 application with Intel Centrino Duo
Windows or VB problem - Please help
MMTimer, DirectSound, and For..Next
Hidden treasures...
VBnet 2005?
vb6 and iso 8601 date format
Access table grid component.
error making function call with multiple parameters to dll
click on a menu
Commondialog1.Filter