Binaryworld - Print Dialogbox without using Common Dialogbox ActiveX control ... [ VB -> Dialogbox ]

This code will show you use of PrintDialog API to show print dialogbox.

Step-By-Step Example

- Create a standard exe project
- Add one class module
- Rename it to clsPrnDlg
- Add one command button on form1
- Place the following code in form1

Click here to copy the following block

Private Sub Command1_Click()
   Dim PD As New cPrnDlg


   PD.PrintFlag(1) = PD_HIDEPRINTTOFILE
   PD.PrintFlag(2) = PD_NOCURRENTPAGE

   PD.MinPage = 2
   PD.MaxPage = 999
   PD.FromPage = 1
   PD.ToPage = 23

   If PD.ShowPrinterDialog Then

   End If
   PD.Free
   Set PD = Nothing
End Sub

Private Sub Form_Load()
  Command1.Caption = "Show Printer Dialog"
End Sub

- Add the following code in clsPrnDlg

clsPrn.Dlg.cls

Click here to copy the following block

' 26/6/01 JF cPrnDlg.cls
'       From KPD Code submitted by Code by Donald Grover
'
' Properties :
'
'   Parent   - (Form) Optional
'   Style    - (Enum) Printer or Setup
'   PrintFlag() - (Enum)
'   MinPage
'   MaxPage
'   FromPage
'   ToPage
'   Copies   -
'
' Usage :
'   Dim PD As New cPrnDlg
'   PD.MinPage = 1
'   PD.MaxPage = 999
'   PD.FromPage = 1
'   PD.ToPage = 999
'   PD.PrintFlag(1) = PD_HIDEPRINTTOFILE
'   PD.PrintFlag(2) = PD_NOCURRENTPAGE
'
'   If PD.ShowPrinterDialog Then
'
'   End If
'   PD.Free
'   Set PD = Nothing

Private Type TPRNPARAMS
  FromPage As Integer
  ToPage As Integer
  MinPage As Integer
  MaxPage As Integer
  Copies As Integer
End Type

Private Type TM
  ParentHWnd As Long
  PrintFlag(20) As Long
  PrnParams As TPRNPARAMS
  Style As Long
End Type

Private m As TM

' --- Constants ---
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
Private Const DM_DUPLEX = &H1000&
Private Const DM_ORIENTATION = &H1&
Private Const DM_COLLATE& = &H8000
Private Const DM_COPIES = &H100&

Private Const PD_PRINTSETUP = &H40

Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_ZEROINIT = &H40

' --- API Structures ---
Private Type PRINTDLG_TYPE
  lStructSize As Long
  hwndOwner As Long
  hDevMode As Long
  hDevNames As Long
  hDC As Long
  flags As Long
  PrnParams As TPRNPARAMS ' 5 integers
  '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

' --- API Declarations ---

Private Declare Function PrintDialog Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PRINTDLG_TYPE) As Long
'Private Declare Function PAGESETUPDLG Lib "comdlg32.dll" Alias "PageSetupDlgA" (pPagesetupdlg As PAGESETUPDLG) 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

' ##############################################################
'
'
Public Enum OptionFlags
  PD_ALLPAGES = &H0
  'PD_CAN_DRAW_DIB = &H1
  'PD_CAN_STRETCHDIB = &H2
  PD_COLLATE = &H10
  PD_CURRENTPAGE = &H400000
  PD_DISABLEPRINTTOFILE = &H80000
  'PD_ENABLEPRINTHOOK = &H1000
  'PD_ENABLEPRINTTEMPLATE = &H4000
  'PD_ENABLEPRINTTEMPLATEHANDLE = &H10000
  'PD_ENABLESETUPHOOK = &H2000
  'PD_ENABLESETUPTEMPLATE = &H8000
  'PD_ENABLESETUPTEMPLATEHANDLE = &H20000
  PD_EXCL_COPIESANDCOLLATE = &H40000 ' (DM_COPIES Or DM_COLLATE)
  'PD_EXCLUSIONFLAGS = &H1000000
  PD_HIDEPRINTTOFILE = &H100000
  PD_NOCURRENTPAGE = &H800000
  PD_NONETWORKBUTTON = &H200000
  PD_NOPAGENUMS = &H8
  PD_NOSELECTION = &H4
  PD_NOWARNING = &H80
  PD_PAGENUMS = &H2
  'PD_PRINTTOFILE = &H20
  'PD_RESULT_APPLY = 2
  'PD_RESULT_CANCEL = 0
  'PD_RESULT_PRINT = 1
  'PD_RETURNDC = &H100
  'PD_RETURNDEFAULT = &H400
  'PD_RETURNIC = &H200
  'PD_SELECTION = &H1
  'PD_SHOWHELP = &H800
  'PD_STRETCHDIB_1_1_OK = &H4
  'PD_STRETCHDIB_1_2_OK = &H8
  'PD_STRETCHDIB_1_N_OK = &H10
  'PD_USEDEVMODECOPIES = &H40000
  'PD_USEDEVMODECOPIESANDCOLLATE = &H40000
  'PD_USELARGETEMPLATE = &H10000000
End Enum

' ##############################################################
'
'
Public Enum enSetupStyle
  cpdPrintDialog = 0
  cpdPrintSetup = 1
End Enum

' --- Initialize
Private Sub Class_Initialize()
  m.PrnParams.MinPage = 1
  m.PrnParams.MaxPage = 9999
End Sub

' --- Properties ---

Public Property Let Parent(Value As Form)
  m.ParentHWnd = 0
  If Not Value Is Nothing Then
    m.ParentHWnd = Value.hwnd
  End If
End Property

Public Property Let Style(Value As enSetupStyle)
  m.Style = Value
End Property

Public Property Get Style() As enSetupStyle
  Style = m.Style
End Property

' ---
Public Property Let PrintFlag(Index&, Value As OptionFlags)
  m.PrintFlag(Index) = Value
End Property

Public Property Get PrintFlag(Index&) As OptionFlags
  PrintFlag = m.PrintFlag(Index)
End Property

' ---
Public Property Let FromPage(Value%)
  m.PrnParams.FromPage = Value
End Property

Public Property Get FromPage%()
  FromPage = m.PrnParams.FromPage
End Property

' ---
Public Property Let ToPage(Value%)
  m.PrnParams.ToPage = Value
End Property

Public Property Get ToPage%()
  ToPage = m.PrnParams.ToPage
End Property

' ---
Public Property Let MinPage(Value%)
  m.PrnParams.MinPage = Value
End Property

Public Property Get MinPage%()
  MinPage = m.PrnParams.MinPage
End Property

' ---
Public Property Let MaxPage(Value%)
  m.PrnParams.MaxPage = Value
End Property

Public Property Get MaxPage%()
  MaxPage = m.PrnParams.MaxPage
End Property

' ---
Public Property Let Copies(Value%)
  m.PrnParams.Copies = Value
End Property

Public Property Get Copies%()
  Copies = m.PrnParams.Copies
End Property

' ##############################################################
'
'
Public Function ShowPrinterDialog() As Boolean
  '-> Code by Donald Grover
  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
  Dim objPrinter As Printer
  Dim NewPrinterName As String
  Dim L9&

  Dim ActiveForms As Collection
  Dim F As Form
  ' --- If no Parent then Disable All Forms
  If m.ParentHWnd = 0 Then
    Set ActiveForms = New Collection
    For Each F In Forms
      If F.Visible Then
       If F.Enabled Then
         ActiveForms.Add F
         F.Enabled = False
       End If
      End If
    Next
  End If

  ShowPrinterDialog = False

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

  PrintDlg.lStructSize = Len(PrintDlg)
  PrintDlg.hwndOwner = m.ParentHWnd

  PrintDlg.flags = 0
  If m.Style = cpdPrintSetup Then
    PrintDlg.flags = PD_PRINTSETUP
  Else
    For L9 = 0 To UBound(m.PrintFlag)
      PrintDlg.flags = PrintDlg.flags Or m.PrintFlag(L9)
    Next
  End If

  PrintDlg.PrnParams = m.PrnParams

  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
    ' locate the correct printer
    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
    m.PrnParams = PrintDlg.PrnParams
    ShowPrinterDialog = True

  End If
  ' --- Re-Enable Forms
  If m.ParentHWnd = 0 Then
    For Each F In ActiveForms
      F.Enabled = True
    Next
    Set ActiveForms = Nothing
  End If

End Function

Public Sub Free()
'
End Sub