VB and VBA Users Source Code: Show the "Select Printer" Common Dialog via API calls
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Show the "Select Printer" Common Dialog via API calls
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Friday, June 03, 2005
Hits:
4194
Category:
Windows API
Article:
The code below shows to select printer common dialog and sets the application printer to the printer selected by the user. Option Explicit Private Const PD_PRINTSETUP = &H40 Private Const PD_DISABLEPRINTTOFILE = &H80000 Private Const CCHDEVICENAME = 32, CCHFORMNAME = 32 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 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 'Purpose : Shows the printer common dialog. 'Inputs : [lOwnerForm] The handle to the owner form. ' [lPrintFlags] Any printer flags. 'Outputs : Returns the email address of the specified outlook message. 'Author : Andrew Baker 'Date : 25/03/2000 'Notes : Public Sub ShowPrinter(Optional lOwnerForm As Long = 0, Optional lPrintFlags As Long = PD_PRINTSETUP) Const GMEM_MOVEABLE = &H2, GMEM_ZEROINIT = &H40 Const DM_DUPLEX = &H1000&, DM_ORIENTATION = &H1& Dim tPrinterDialog As PRINTDLG Dim tDevMode As DEVMODE Dim tDevName As DEVNAMES Dim lDevModePtr As Long, lDevNamePtr As Long Dim sNewPrinterName As String Dim prnTestPrinter As Printer tPrinterDialog.lStructSize = Len(tPrinterDialog) tPrinterDialog.hWndOwner = lOwnerForm tPrinterDialog.flags = lPrintFlags 'Get the current orientation and duplex setting tDevMode.dmDeviceName = Printer.DeviceName tDevMode.dmSize = Len(tDevMode) tDevMode.dmFields = DM_ORIENTATION Or DM_DUPLEX tDevMode.dmPaperWidth = Printer.Width tDevMode.dmOrientation = Printer.Orientation tDevMode.dmPaperSize = Printer.PaperSize tDevMode.dmDuplex = Printer.Duplex 'Copy settings into type tPrinterDialog.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(tDevMode)) lDevModePtr = GlobalLock(tPrinterDialog.hDevMode) If lDevModePtr > 0 Then CopyMemory ByVal lDevModePtr, tDevMode, Len(tDevMode) Call GlobalUnlock(tPrinterDialog.hDevMode) End If 'Set driver, device, and port name With tDevName .wDriverOffset = 8 .wDeviceOffset = .wDriverOffset + 1 + Len(Printer.DriverName) .wOutputOffset = .wDeviceOffset + 1 + Len(Printer.Port) .wDefault = 0 .extra = Printer.DriverName & Chr(0) & Printer.DeviceName & Chr(0) & Printer.Port & Chr(0) End With 'Allocate memory for the initial hDevName structure 'and copy the settings gathered above into this memory tPrinterDialog.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(tDevName)) lDevNamePtr = GlobalLock(tPrinterDialog.hDevNames) If lDevNamePtr > 0 Then CopyMemory ByVal lDevNamePtr, tDevName, Len(tDevName) Call GlobalUnlock(lDevNamePtr) End If 'Call the print dialog up and let the user make changes If PrintDialog(tPrinterDialog) <> 0 Then 'First get the tDevName structure. lDevNamePtr = GlobalLock(tPrinterDialog.hDevNames) CopyMemory tDevName, ByVal lDevNamePtr, 45 Call GlobalUnlock(lDevNamePtr) GlobalFree tPrinterDialog.hDevNames 'Next get the tDevMode structure and set the printer properties appropriately lDevModePtr = GlobalLock(tPrinterDialog.hDevMode) CopyMemory tDevMode, ByVal lDevModePtr, Len(tDevMode) Call GlobalUnlock(tPrinterDialog.hDevMode) GlobalFree tPrinterDialog.hDevMode sNewPrinterName = UCase$(Left(tDevMode.dmDeviceName, InStr(tDevMode.dmDeviceName, Chr$(0)) - 1)) If Printer.DeviceName <> sNewPrinterName Then 'Find the new printer For Each prnTestPrinter In Printers 'Note, the API only supports 32 character long printer names (was a 16 bit windows API call) If Left$(UCase$(prnTestPrinter.DeviceName), Len(sNewPrinterName)) = sNewPrinterName Then 'Found matching printer Set Printer = prnTestPrinter Exit For End If Next End If 'Set printer object properties according to selections made by user On Error Resume Next Printer.Copies = tDevMode.dmCopies Printer.Duplex = tDevMode.dmDuplex Printer.Orientation = tDevMode.dmOrientation Printer.PaperSize = tDevMode.dmPaperSize Printer.PrintQuality = tDevMode.dmPrintQuality Printer.ColorMode = tDevMode.dmColor Printer.PaperBin = tDevMode.dmDefaultSource On Error GoTo 0 End If End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
