Kieran,
See below for code, lifted from Karl's Printer Info code to only return the
colour mode.
NickHK
Kieran H said:
Nick,
Many thanks for your research, the class you described sounds exactly
what I need.
As for whether its worth it ?- It looks good on screen or printed in
colour but looks crap if printed in bw (the grey is too dark)
Poor code that still works may be criticised by my peers but with poor
presentation eveyone's a critic!
Thanks again
Kieran
----------- CUT ----
< Workbook code >
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim PrtInfo As cPrtInfo
Set PrtInfo = New cPrtInfo
MsgBox "Colour printer = " &
CStr(PrtInfo.ColorMode(FixPrinterName(ActivePrinter)) =
PrinterColourModes.Colour)
'Decide what to do
'...etc
End Sub
Private Function FixPrinterName(ByVal ExcelPrinterName As String) As String
Dim OnMarker As Long
OnMarker = InStr(1, ExcelPrinterName, " on ")
If OnMarker > 0 Then
FixPrinterName = Left(ExcelPrinterName, OnMarker - 1)
Else
FixPrinterName = ExcelPrinterName
End If
End Function
</ Workbook code >
< cPrtInfo.cls
'Based on code from Karl's PrinterInfo class
'
' *************************************************************************
' Copyright ©2001 Karl E. Peterson
' All Rights Reserved,
http://www.mvps.org/vb
' *************************************************************************
' You are free to use this code within your own applications, but you
' are expressly forbidden from selling or otherwise distributing this
' source code, non-compiled, without prior written consent.
' *************************************************************************
' Win32 API declares
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory"
(Destination As Any, Source As Any, ByVal Length As Long)
' Values used to define DEVMODE structure
Private Const CCHDEVICENAME As Long = 32
Private Const CCHFORMNAME As Long = 32
' Structure used to cache values
Private Type DevMode
dmDeviceName As String * CCHDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer ' not exposed
dmDriverExtra As Integer ' not exposed
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
dmLogPixels As Integer
dmBitsPerPel As Long
dmPelsWidth As Long
dmPelsHeight As Long
dmNup As Long ' union with dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
' Color enable/disable for color printers
Private Const DMCOLOR_MONOCHROME = 1
Private Const DMCOLOR_COLOR = 2
Public Enum PrinterColourModes
Unknown = 0
BW = DMCOLOR_MONOCHROME
Colour = DMCOLOR_COLOR
End Enum
' Win32 API declares
Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA"
(ByVal pPrinterName As String, phPrn As Long, pDefault As Any) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrn As
Long) As Long
Private Declare Function GetPrinter Lib "winspool.drv" Alias "GetPrinterA"
(ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, ByVal cbBuf
As Long, pcbNeeded As Long) As Long
' The data area passed to a system call is too small.
Private Const ERROR_INSUFFICIENT_BUFFER As Long = 122
' Structure used to obtain the data from Windows.
Private Type PRINTER_INFO_2
pServerName As Long
pPrinterName As Long
pShareName As Long
pPortName As Long
pDriverName As Long
pComment As Long
pLocation As Long
pDevMode As Long 'DEVMODE
pSepFile As Long
pPrintProcessor As Long
pDatatype As Long
pParameters As Long
pSecurityDescriptor As Long 'SECURITY_DESCRIPTOR
Attributes As Long
Priority As Long
DefaultPriority As Long
StartTime As Long
UntilTime As Long
Status As Long
cJobs As Long
AveragePPM As Long
End Type
' Member variables
Private m_DM As DevMode
Private m_PrtInfo As PRINTER_INFO_2
Private m_PrtInfoNull As PRINTER_INFO_2
' *********************************************
' Initialize/Terminate
' *********************************************
Private Sub Class_Initialize()
'
End Sub
Private Sub Class_Terminate()
'
End Sub
'We are only exposing the Color capability of the printer, although you
'you can add more of the DEVMODE's members
Public Property Get ColorMode(ByVal PrinterName As String) As Long
Dim pi2 As PRINTER_INFO_2
Dim hPrn As Long
Dim Buffer() As Byte
Dim BytesNeeded As Long
Dim BytesUsed As Long
Dim slash As Long
'Zero out cached values
m_PrtInfo = m_PrtInfoNull
'Get handle to printer.
Call OpenPrinter(PrinterName, hPrn, ByVal 0&)
If hPrn Then
'Call once to get proper buffer size.
Call GetPrinter(hPrn, 2, ByVal 0&, 0, BytesNeeded)
If Err.LastDllError = ERROR_INSUFFICIENT_BUFFER Then
' Size buffer and get printer data.
ReDim Buffer(0 To BytesNeeded - 1) As Byte
If GetPrinter(hPrn, 2, Buffer(0), BytesNeeded, BytesUsed) Then
' Fill local structure with data/pointers.
Call CopyMemory(pi2, Buffer(0), Len(pi2))
' Copy two sub-structure pointers.
m_PrtInfo.pDevMode = pi2.pDevMode
' Fill DEVMODE substructure
Initialize m_PrtInfo.pDevMode
End If
'm_GetPrinterError = 0 'clear error value
Else
'ColorMode = Err.LastDllError
ColorMode = 0
End If
Call ClosePrinter(hPrn)
End If
ColorMode = m_DM.dmColor
End Property
'Helper functions
'
Private Sub Initialize(ByVal lpDevMode As Long)
' Just a simple copy to fill cache.
If lpDevMode Then
Call CopyMemory(m_DM, ByVal lpDevMode, Len(m_DM))
End If
End Sub
</ cPrtInfo.cls
