Attribute VB_Name = "modPrinterSet"
''Option Compare Database
Option Explicit
'************************
' Printer setup module
' Set/retrieves the default printer - originaly for VB6
' Works for A97/a2000
' This is minimal code.
' Albert D.Kallal - 01/13/2002
' Rev history: Date Who notes
' 01/13/2002 Albert D. kallal
'
' I wrote this after looking at some the code on the net. Some of the routines
' to change a printer were approaching 500 + of lines of code. Just the printer
' constant defs was over 100 lines of code! Yikes!
' I use only TWO API's (the 3rd one is optional). There is a total of only 4 functions!
' KISS is the word. Keep it simple stupid. I don't care about device drivers, or the
' port number. All these routines just work with the simple printer name. If you do
' actually care about the device driver and port stuff..then use the one of many
' examples available on the net. Those other examples also deal with margins, orientation
' etc.
'
' You can paste this code into a module..and away you go
'
'************************
' How to use
' To get the default printer
' debug.print GetDefaultPrinter
' To set the default printer
' debug.print SetDefaultPrinter("HP Laser JET")
' above returns true if success.
' To get a list of printers suitable for a listbox, or combo
' debug.print GetPrinters
'
' that is all there folks!
'
' Thus, when printing a report, you can:
'
' 1) save the default printer into a string
' strCurrentPtr = GetDefaultPrinter
' 2) switch to your report printer
' SetDefaultPrinter strReportsPtr
' 3) print report
' 4) switch back to the default printer
' SetDefaultPrinter strCurrentPtr
'
Private Const HWND_BROADCAST As Long = &HFFFF&
Private Const WM_WININICHANGE As Long = &H1A
' The following code allows one to read, and write to the WIN.INI files
' In win 2000 the printer settings are actually in the registry. However, windows
' handles this correctly
'
Private Declare Function GetProfileString Lib "kernel32" _
Alias "GetProfileStringA" _
(ByVal lpAppName As String, _
ByVal lpKeyName As String, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long) As Long
Private Declare Function WriteProfileString Lib "kernel32" _
Alias "WriteProfileStringA" _
(ByVal lpszSection As String, _
ByVal lpszKeyName As String, _
ByVal lpszString As String) As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lparam As Any) As Long
Private Function fstrDField(mytext As String, delim As String, groupnum As Integer) As String
' this is a standard delimiter routine that every developer I know has.
' This routine has a million uses. This routine is great for splitting up
' data fields, or sending multiple parms to a openargs of a form
'
' Parms are
' mytext - a delimited string
' delim - our delimiter (usually a , or / or a space)
' groupnum - which of the delimited values to return
'
Dim startpos As Integer, endpos As Integer
Dim groupptr As Integer, chptr As Integer
chptr = 1
startpos = 0
For groupptr = 1 To groupnum - 1
chptr = InStr(chptr, mytext, delim)
If chptr = 0 Then
fstrDField = ""
Exit Function
Else
chptr = chptr + 1
End If
Next groupptr
startpos = chptr
endpos = InStr(startpos + 1, mytext, delim)
If endpos = 0 Then
endpos = Len(mytext) + 1
End If
fstrDField = Mid$(mytext, startpos, endpos - startpos)
End Function
'-------------------
Function SetDefaultPrinter(strPrinterName As String) As Boolean
'-------------------
Dim strDeviceLine As String
Dim strBuffer As String
Dim lngbuf As Long
' get the full device string
'
strBuffer = Space(1024)
lngbuf = GetProfileString("PrinterPorts", strPrinterName, "", strBuffer, Len(strBuffer))
'Write out this new printer information in
' WIN.INI file for DEVICE item
If lngbuf > 0 Then
strDeviceLine = strPrinterName & "," & _
fstrDField(strBuffer, Chr(0), 1) & "," & _
fstrDField(strBuffer, Chr(0), 2)
Call WriteProfileString("windows", "Device", strDeviceLine)
SetDefaultPrinter = True
' Below is optional, and should be done. It updates the existing windows
' so the "default" printer icon changes. If you don't do the below..then
' you will often see more than one printer as the default! The reason *not*
' to do the SendMessage is that many open applications will now sense the change
' in printer. I vote to leave it in..but your case you might not want this.
'
'Call SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, ByVal "windows")
Else
SetDefaultPrinter = False
End If
End Function
'-------------------
Function GetDefaultPrinter() As String
'-------------------
Dim strDefault As String
Dim lngbuf As Long
strDefault = String(255, Chr(0))
lngbuf = GetProfileString("Windows", "Device", "", strDefault, Len(strDefault))
If lngbuf > 0 Then
GetDefaultPrinter = fstrDField(strDefault, ",", 1)
Else
GetDefaultPrinter = ""
End If
End Function
Public Sub ListPrinters()
Debug.Print GetDefaultPrinter
Debug.Print "------------"
Debug.Print GetPrinters
End Sub
'-------------------
Function GetPrinters() As String
'-------------------
' this routine returns a list of printers, separated by
' a ";", and thus the results are suitable for stuffing into a combo box
Dim strBuffer As String
Dim strOnePtr As String
Dim intPos As Integer
Dim lngChars As Long
strBuffer = Space(2048)
lngChars = GetProfileString("PrinterPorts", vbNullString, "", strBuffer, Len(strBuffer))
If lngChars > 0 Then
intPos = InStr(strBuffer, Chr(0))
Do While intPos > 1
strOnePtr = Left(strBuffer, intPos - 1)
strBuffer = Mid(strBuffer, intPos + 1)
If GetPrinters <> "" Then GetPrinters = GetPrinters & vbCrLf
'Debug.Print strOnePtr
GetPrinters = GetPrinters & strOnePtr
intPos = InStr(strBuffer, Chr(0))
Loop
Else
GetPrinters = ""
End If
End Function
'-------------------
Public Sub PrinterSides(ByVal pyNum As Byte)
'-------------------
'acPRDPSimplex = 1
'acPRDPHorizontal = 2
'acPRDPVertical = 3
Select Case pyNum
Case "": 'nothing to do
Case 1
rpt.Printer.Duplex = acPRDPSimplex
Case 2
rpt.Printer.Duplex = acPRDPHorizontal
Case 3
rpt.Printer.Duplex = acPRDPVertical
End Select
Printer.Duplex = pyNum
End Sub
Public Sub PrinterOrient()
'If CommonDialog1.Orientation = cdlLandscape Then
' Printer.Orientation = cdlLandscape '2
'Else
' Printer.Orientation = cdlPortrait '1
'End If
End Sub
