'@~~~~~~~~~~~ DEVMODE ~~~~~~~~~~~@
' I have removed all of the NT only and
' Windows 9X (2000 as well) only elements
Private Type DEVMODE
dmDeviceName As String * 32
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 * 32
dmLogPixels As Integer
dmBitsPerPel As Long
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Private Type PRINTER_DEFAULTS
pDatatype As String
pDevMode As Long
DesiredAccess As Long
End Type
Private Declare Function OpenPrinter Lib _
"winspool.drv" Alias "OpenPrinterA" _
(ByVal pPrinterName As String, phPrinter As Long, _
pDefault As PRINTER_DEFAULTS) As Long
Private Declare Function SetPrinter Lib _
"winspool.drv" Alias "SetPrinterA" _
(ByVal hPrinter As Long, ByVal Level As Long, _
pPrinter As Any, ByVal Command 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
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (hpvDest As Any, _
hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function ClosePrinter Lib _
"winspool.drv" (ByVal hPrinter As Long) As Long
Private Declare Function DocumentProperties Lib _
"winspool.drv" Alias "DocumentPropertiesA" _
(ByVal hwnd As Long, ByVal hPrinter As Long, _
ByVal pDeviceName As String, ByVal _
pDevModeOutput As Any, ByVal pDevModeInput As Any, _
ByVal fMode As Long) As Long
'The Procedure that does the change
Public Sub SetOrientation(strPrnName As String, intOrient As Integer)
Dim udtPD As PRINTER_DEFAULTS
Dim udtDEVMODE As DEVMODE
Dim lngBuffer() As Long
Dim lngPrnHndle As Long
Dim lngRetVal As Long
Dim lngDMpntr As Long
Dim lngRet As Long
udtPD.pDatatype = vbNullString
udtPD.pDevMode = 0&
'The next call is NT security, it
'Has no adverse affect on Windows 9X or 2000
udtPD.DesiredAccess = PRINTER_ALL_ACCESS
'The pointer (7th element of the array) to the DEVMODE
lngDMpntr = lngBuffer(7)
'Public to Private and vice-versa
Call CopyMemory(udtDEVMODE, ByVal lngDMpntr, Len(udtDEVMODE))
'Mark the bit and Change the orientation
udtDEVMODE.dmFields = DM_ORIENTATION
udtDEVMODE.dmOrientation = intOrient