Private Sub cmdChangePrinterOrient_Click()
If optPort.Value = True Then
ChngPrinterOrientationPortrait Me
ElseIf optLand.Value = True Then
ChngPrinterOrientationLandscape Me
End If
End Sub
orient:
'Constants used in the DevMode structure
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
'Constants for NT security
Private Const STANDARD_RIGHTS_REQUIRED = & HF0000
Private Const PRINTER_ACCESS_ADMINISTER = & H4
Private Const PRINTER_ACCESS_USE = & H8
Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)
'Constants used to make changes to the values contained in the DevMode
Private Const DM_MODIFY = 8
Private Const DM_IN_BUFFER = DM_MODIFY
Private Const DM_COPY = 2
Private Const DM_OUT_BUFFER = DM_COPY
Private Const DM_DUPLEX = & H1000&
Private Const DMDUP_SIMPLEX = 1
Private Const DMDUP_VERTICAL = 2
Private Const DMDUP_HORIZONTAL = 3
Private Const DM_ORIENTATION = & H1&
Private PageDirection As Integer
'------USER DEFINED TYPES
'The DevMode structure contains printing parameters.
'Note that this only represents the PUBLIC portion of the DevMode.
' The full DevMode also contains a variable length PRIVATE section
' which varies in length and content between printer drivers.
'NEVER use this User Defined Type directly with any API call.
' Always combine it into a FULL DevMode structure and then send the
' full DevMode to the API call.
Private Type DEVMODE
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
dmLogPixels As Integer
dmBitsPerPel As Long
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
dmICMMethod As Long ' // Windows 95 only
dmICMIntent As Long ' // Windows 95 only
dmMediaType As Long ' // Windows 95 only
dmDitherType As Long ' // Windows 95 only
dmReserved1 As Long ' // Windows 95 only
dmReserved2 As Long ' // Windows 95 only
End Type
Private Type PRINTER_DEFAULTS
'Note:
' The definition of Printer_Defaults in the VB5 API viewer is incorrect.
' Below, pDevMode has been corrected to LONG.
pDatatype As String
pDevMode As Long
DesiredAccess As Long
End Type
'------DECLARATIONS
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
'The following is an unusual declaration of DocumentProperties:
' pDevModeOutput and pDevModeInput are usually declared ByRef. They are declared
' ByVal in this program because we're using a Printer_Info_2 structure.
' The pi2 structure contains a variable of type LONG which contains the address
' of the DevMode structure (this is called a pointer). This LONG variable must
' be passed ByVal.
' Normally this function is called with a BYTE ARRAY which contains the DevMode
' structure and the Byte Array is passed ByRef.
If optPort.Value = True Then
ChngPrinterOrientationPortrait Me
ElseIf optLand.Value = True Then
ChngPrinterOrientationLandscape Me
End If
End Sub
orient:
'Constants used in the DevMode structure
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
'Constants for NT security
Private Const STANDARD_RIGHTS_REQUIRED = & HF0000
Private Const PRINTER_ACCESS_ADMINISTER = & H4
Private Const PRINTER_ACCESS_USE = & H8
Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)
'Constants used to make changes to the values contained in the DevMode
Private Const DM_MODIFY = 8
Private Const DM_IN_BUFFER = DM_MODIFY
Private Const DM_COPY = 2
Private Const DM_OUT_BUFFER = DM_COPY
Private Const DM_DUPLEX = & H1000&
Private Const DMDUP_SIMPLEX = 1
Private Const DMDUP_VERTICAL = 2
Private Const DMDUP_HORIZONTAL = 3
Private Const DM_ORIENTATION = & H1&
Private PageDirection As Integer
'------USER DEFINED TYPES
'The DevMode structure contains printing parameters.
'Note that this only represents the PUBLIC portion of the DevMode.
' The full DevMode also contains a variable length PRIVATE section
' which varies in length and content between printer drivers.
'NEVER use this User Defined Type directly with any API call.
' Always combine it into a FULL DevMode structure and then send the
' full DevMode to the API call.
Private Type DEVMODE
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
dmLogPixels As Integer
dmBitsPerPel As Long
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
dmICMMethod As Long ' // Windows 95 only
dmICMIntent As Long ' // Windows 95 only
dmMediaType As Long ' // Windows 95 only
dmDitherType As Long ' // Windows 95 only
dmReserved1 As Long ' // Windows 95 only
dmReserved2 As Long ' // Windows 95 only
End Type
Private Type PRINTER_DEFAULTS
'Note:
' The definition of Printer_Defaults in the VB5 API viewer is incorrect.
' Below, pDevMode has been corrected to LONG.
pDatatype As String
pDevMode As Long
DesiredAccess As Long
End Type
'------DECLARATIONS
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
'The following is an unusual declaration of DocumentProperties:
' pDevModeOutput and pDevModeInput are usually declared ByRef. They are declared
' ByVal in this program because we're using a Printer_Info_2 structure.
' The pi2 structure contains a variable of type LONG which contains the address
' of the DevMode structure (this is called a pointer). This LONG variable must
' be passed ByVal.
' Normally this function is called with a BYTE ARRAY which contains the DevMode
' structure and the Byte Array is passed ByRef.
Private Sub SetOrientation(NewSetting As Long, chng As Integer, ByVal frm As Form)
Dim PrinterHandle As Long
Dim PrinterName As String
Dim pd As PRINTER_DEFAULTS
Dim MyDevMode As DEVMODE
Dim Result As Long
Dim Needed As Long
Dim pFullDevMode As Long
Dim pi2_buffer() As Long 'This is a block of memory for the Printer_Info_2 structure
'If you need to use the Printer_Info_2 User Defined Type, the
' definition of Printer_Info_2 in the API viewer is incorrect.
' pDevMode and pSecurityDescriptor should be defined As Long.
PrinterName = Printer.DeviceName
If PrinterName = "" Then
Exit Sub
End If
pd.pDatatype = vbNullString
pd.pDevMode = 0&
'Printer_Access_All is required for NT security
pd.DesiredAccess = PRINTER_ALL_ACCESS
Result = OpenPrinter(PrinterName, PrinterHandle, pd)
'The first call to GetPrinter gets the size, in bytes, of the buffer needed.
'This value is divided by 4 since each element of pi2_buffer is a long.
Result = GetPrinter(PrinterHandle, 2, ByVal 0& , 0, Needed)
ReDim pi2_buffer((Needed \ 4))
Result = GetPrinter(PrinterHandle, 2, pi2_buffer(0), Needed, Needed)
'The seventh element of pi2_buffer is a Pointer to a block of memory
' which contains the full DevMode (including the PRIVATE portion).
pFullDevMode = pi2_buffer(7)
'Copy the Public portion of FullDevMode into our DevMode structure
Call CopyMemory(MyDevMode, ByVal pFullDevMode, Len(MyDevMode))
'Make desired changes
MyDevMode.dmDuplex = NewSetting
MyDevMode.dmFields = DM_DUPLEX Or DM_ORIENTATION
MyDevMode.dmOrientation = chng
'Copy our DevMode structure back into FullDevMode
Call CopyMemory(ByVal pFullDevMode, MyDevMode, Len(MyDevMode))
'Copy our changes to "the PUBLIC portion of the DevMode" into "the PRIVATE portion of the DevMode"
Result = DocumentProperties(frm.hwnd, PrinterHandle, PrinterName, ByVal pFullDevMode, ByVal pFullDevMode, DM_IN_BUFFER Or DM_OUT_BUFFER)
'Update the printer's default properties (to verify, go to the Printer folder
' and check the properties for the printer)
Result = SetPrinter(PrinterHandle, 2, pi2_buffer(0), 0& )
Call ClosePrinter(PrinterHandle)
'Note: Once "Set Printer = " is executed, anywhere in the code, after that point
' changes made with SetPrinter will ONLY affect the system-wide printer --
' -- the changes will NOT affect the VB printer object.
' Therefore, it may be necessary to reset the printer object's parameters to
' those chosen in the devmode.
Dim p As Printer
For Each p In Printers
If p.DeviceName = PrinterName Then
Set Printer = p
Exit For
End If
Next p
Printer.Duplex = MyDevMode.dmDuplex
End Sub
Public Sub ChngPrinterOrientationLandscape(ByVal frm As Form)
PageDirection = 2
Call SetOrientation(DMDUP_SIMPLEX, PageDirection, frm)
End Sub
Public Sub ResetPrinterOrientation(ByVal frm As Form)
If PageDirection = 1 Then
PageDirection = 2
Else
PageDirection = 1
End If
Call SetOrientation(DMDUP_SIMPLEX, PageDirection, frm)
End Sub
Public Sub ChngPrinterOrientationPortrait(ByVal frm As Form)
PageDirection = 1
Call SetOrientation(DMDUP_SIMPLEX, PageDirection, frm)
End Sub
先取得你打印机的DC(资源)，用POSTSCRIPT_IDENTIFY来知道你的打印机是不是支持PostScript(老的不支持)，然后使用
Public Declare Function ExtEscape Lib "gdi32" Alias "ExtEscape" (ByVal hdc As Long, ByVal nEscape As Long, ByVal cbInput As Long, ByVal lpszInData As String, ByVal cbOutput As Long, ByVal lpszOutData As String) As Long
就可以了。参考：GET_PS_FEATURESETTING
谢谢你的代码，但我要的是Win2k,NT下面设定自定义纸张，而不是改变打印方向，请看清题目。shark_s()：
Sorry，我看不出你提供的方案跟我的题目有何关系，能否详细解释一下，最好能提供一段验证过的代码，谢谢！
这个吧：调用： SetDefaultPrinterOrientation 2, 4000, 3000
2是指设为纵式，相应的则为横式
4000是指将长设为：4000
3000是指将宽设为：3000 将下面的代码放在模块中
Option Explicit
Public Enum PrinterOrientationConstants
OrientPortrait = 1
OrientLandscape = 2
End Enum
'Printer.PaperSize = vbPRPSA3
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
dmUnusedPadding As Integer
dmBitsPerPel As Integer
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 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
pSepFile As Long
pPrintProcessor As Long
pDataType As Long
pParameters As Long
pSecurityDescriptor As Long
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 TypePrivate Const DC_PAPERNAMES = 16
Private Const DC_PAPERS = 2
Private Const DC_PAPERSIZE = 3Private Const DM_IN_BUFFER = 8
Private Const DM_OUT_BUFFER = 2
Private Const DM_ORIENTATION = &H1
Private Const DM_PAPERSIZE = &H2&
Private Const DM_PaperLength = &H4
Private Const DM_PaperWidth = &H8&
Private Const DMPAPER_A3 = 8 ' A3 297 x 420 mm
Private Const DMPAPER_A4 = 9 ' A4 210 x 297 mmPrivate Const PRINTER_ACCESS_ADMINISTER = &H4
Private Const PRINTER_ACCESS_USE = &H8
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)Private Declare Function OpenPrinter Lib "winspool.drv" Alias _
"OpenPrinterA" (ByVal pPrinterName As String, phPrinter As _
Long, pDefault As Any) As LongPrivate Declare Function ClosePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As LongPrivate Declare Function DocumentProperties Lib "winspool.drv" _
Alias "DocumentPropertiesA" (ByVal hwnd As Long, ByVal hPrinter As Long, _
ByVal pDeviceName As String, pDevModeOutput As Any, pDevModeInput As Any, _
ByVal fMode As Long) As LongPrivate 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 LongPrivate Declare Function SetPrinter Lib "winspool.drv" _
Alias "SetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _
pPrinter As Any, ByVal Command As Long) As LongPrivate Declare Function DeviceCapabilities Lib "winspool.drv" _
Alias "DeviceCapabilitiesA" (ByVal lpDeviceName As String, ByVal lpPort As String, _
ByVal iIndex As Long, ByVal lpOutput As String, lpDevMode As DEVMODE) As LongFunction SetDefaultPrinterOrientation(ByVal eOrientation As _
PrinterOrientationConstants, ByVal strPaperLength As Integer, ByVal strPaperWidth As Integer) As Boolean
'eOrientation:方向
'strPaperLength:长
'strPaperWidth:宽
Dim bDevMode() As Byte
Dim bPrinterInfo2() As Byte
Dim hPrinter As Long
Dim lResult As Long
Dim nSize As Long
Dim sPrnName As String
Dim dm As DEVMODE
Dim pd As PRINTER_DEFAULTS
Dim pi2 As PRINTER_INFO_2 ' Get device name of default printer
sPrnName = Printer.DeviceName
' PRINTER_ALL_ACCESS required under
' NT, because we're going to call
' SetPrinter
pd.DesiredAccess = PRINTER_ALL_ACCESS
' Get a handle to the printer.
If OpenPrinter(sPrnName, hPrinter, pd) Then
' Get number of bytes requires for
' PRINTER_INFO_2 structure
Call GetPrinter(hPrinter, 2&, 0&, 0&, nSize)
' Create a buffer of the required size
ReDim bPrinterInfo2(1 To nSize) As Byte
' Fill buffer with structure
lResult = GetPrinter(hPrinter, 2, bPrinterInfo2(1), _
nSize, nSize)
' Copy fixed portion of structure
' into VB Type variable
Call CopyMemory(pi2, bPrinterInfo2(1), Len(pi2)) ' Get number of bytes requires for
' DEVMODE structure
nSize = DocumentProperties(0&, hPrinter, sPrnName, _
0&, 0&, 0)
' Create a buffer of the required size
ReDim bDevMode(1 To nSize) ' If PRINTER_INFO_2 points to a DEVMODE
' structure, copy it into our buffer
If pi2.pDevMode Then
Call CopyMemory(bDevMode(1), ByVal pi2.pDevMode, Len(dm))
Else
' Otherwise, call DocumentProperties
' to get a DEVMODE structure
Call DocumentProperties(0&, hPrinter, sPrnName, _
bDevMode(1), 0&, DM_OUT_BUFFER)
End If ' Copy fixed portion of structure
' into VB Type variable
Call CopyMemory(dm, bDevMode(1), Len(dm))
With dm
.dmPaperSize = 0
.dmPaperLength = strPaperLength
.dmPaperWidth = strPaperWidth
.dmOrientation = eOrientation
.dmFields = DM_ORIENTATION + DM_PAPERSIZE + DM_PaperLength + DM_PaperWidth
End With
' Copy our Type back into buffer
Call CopyMemory(bDevMode(1), dm, Len(dm))
' Set new orientation
Call DocumentProperties(0&, hPrinter, sPrnName, _
bDevMode(1), bDevMode(1), DM_IN_BUFFER Or _
DM_OUT_BUFFER) ' Point PRINTER_INFO_2 at our
' modified DEVMODE
pi2.pDevMode = VarPtr(bDevMode(1))
' Set new orientation system-wide
lResult = SetPrinter(hPrinter, 2, pi2, 0&) ' Clean up and exit
Call ClosePrinter(hPrinter)
SetDefaultPrinterOrientation = True
Else
SetDefaultPrinterOrientation = False
End If
End Function
mike_sun(漠风)，谢谢你的代码，不过我还是看不懂，我存下来慢慢研究。http://support.microsoft.com/default.aspx?scid=kb;EN-US;q282474
'Step-by-Step Example:
'
'1. Set a local printer as the default printer. To do this, follow these steps:
'
'a. On the Start menu, point to Settings, and then click Printers.
'
'b. Right-click the icon for a local printer, and then click "Set as default".
'
'2. Start a new Standard EXE project in Visual Basic. Form1 is created by
'default.
'
'3. Add three CommandButtons and a ListBox control to Form1.
'
'4. Paste the following code into the module of Form1:Option ExplicitPrivate Sub Command1_Click()
Dim FormName As String
FormName = "MyCustomForm" ' Use special, user-defined form.
UseForm FormName
End SubPrivate Sub Command2_Click()
Dim FormName As String
' Get FormName from the ListBox.
On Error GoTo ListBoxERR ' Trap for no selection.
FormName = Mid(List1.Text, 1, InStr(1, List1.Text, " -") - 1)
On Error GoTo 0 ' Turn off Error trap.
UseForm FormName
Exit Sub
ListBoxERR:
MsgBox "Select a printer from the ListBox before using this option.", _
vbExclamation
End SubPrivate Sub Command3_Click()
Dim RetVal As Long
Dim PrinterHandle As Long ' Handle to printer
Dim PrinterName As String
Dim FormName As String
Dim Continue As Long
' Delete form that is selected in ListBox.
PrinterName = Printer.DeviceName ' Current printer
If OpenPrinter(PrinterName, PrinterHandle, 0&) Then
On Error GoTo ListBoxERR ' Trap for no selection.
FormName = Mid(List1.Text, 1, InStr(1, List1.Text, " -") - 1)
On Error GoTo 0 ' Turn off Error trap.
Continue = MsgBox("Are you sure you want to permanently remove " & _
FormName & " from " & PrinterName & "?", vbYesNo)
If Continue = vbYes Then
RetVal = DeleteForm(PrinterHandle, FormName & Chr(0))
If RetVal <> 0 Then ' DeleteForm succeeded.
List1.Clear ' Reflect the deletion in the ListBox.
Form_Load ' Rebuild the list.
MsgBox FormName & " deleted!", vbInformation, "Success!"
Else
MsgBox FormName & " not deleted!" & vbCrLf & vbCrLf & _
"Error code: " & Err.LastDllError, vbInformation, "Failure!"
End If
End If
ClosePrinter (PrinterHandle)
End If
Exit Sub
ListBoxERR:
MsgBox "Select a printer from the ListBox before using this option.", _
vbExclamation
ClosePrinter (PrinterHandle)
End SubPrivate Sub Form_Load()
Dim NumForms As Long, I As Long
Dim FI1 As FORM_INFO_1
Dim aFI1() As FORM_INFO_1 ' Working FI1 array
Dim Temp() As Byte ' Temp FI1 array
Dim BytesNeeded As Long
Dim PrinterName As String ' Current printer
Dim PrinterHandle As Long ' Handle to printer
Dim FormItem As String ' For ListBox
Dim RetVal As Long
Dim FormSize As SIZEL ' Size of desired form
PrinterName = Printer.DeviceName ' Current printer
If OpenPrinter(PrinterName, PrinterHandle, 0&) Then
With FormSize ' Desired page size
.cx = 214000
.cy = 216000
End With
ReDim aFI1(1)
RetVal = EnumForms(PrinterHandle, 1, aFI1(0), 0&, BytesNeeded, _
NumForms)
ReDim Temp(BytesNeeded)
ReDim aFI1(BytesNeeded / Len(FI1))
RetVal = EnumForms(PrinterHandle, 1, Temp(0), BytesNeeded, _
BytesNeeded, NumForms)
Call CopyMemory(aFI1(0), Temp(0), BytesNeeded)
For I = 0 To NumForms - 1
With aFI1(I)
' List name and size including the count (index).
FormItem = PtrCtoVbString(.pName) & " - " & .Size.cx / 1000 & _
" mm X " & .Size.cy / 1000 & " mm (" & I + 1 & ")"
List1.AddItem FormItem
End With
Next I
ClosePrinter (PrinterHandle)
End If
End SubPrivate Sub UseForm(FormName As String)
Dim RetVal As Integer
RetVal = SelectForm(FormName, Me.hwnd)
Select Case RetVal
Case FORM_NOT_SELECTED ' 0
' Selection failed!
MsgBox "Unable to retrieve From name", vbExclamation, _
"Operation halted!"
Case FORM_SELECTED ' 1
' Selection succeeded!
PrintTest ' Comment this line to avoid printing
Case FORM_ADDED ' 2
' Form added and selected.
List1.Clear ' Reflect the addition in the ListBox
Form_Load ' by rebuilding the list.
End Select
End Sub
'
'6. Paste the following code into Module1:Option ExplicitPublic Declare Function EnumForms Lib "winspool.drv" Alias "EnumFormsA" _
(ByVal hPrinter As Long, ByVal Level As Long, ByRef pForm As Any, _
ByVal cbBuf As Long, ByRef pcbNeeded As Long, _
ByRef pcReturned As Long) As LongPublic Declare Function AddForm Lib "winspool.drv" Alias "AddFormA" _
(ByVal hPrinter As Long, ByVal Level As Long, pForm As Byte) As LongPublic Declare Function DeleteForm Lib "winspool.drv" Alias "DeleteFormA" _
(ByVal hPrinter As Long, ByVal pFormName As String) As LongPublic Declare Function OpenPrinter Lib "winspool.drv" _
Alias "OpenPrinterA" (ByVal pPrinterName As String, _
phPrinter As Long, ByVal pDefault As Long) As LongPublic Declare Function ClosePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As LongPublic Declare Function DocumentProperties Lib "winspool.drv" _
Alias "DocumentPropertiesA" (ByVal hwnd As Long, _
ByVal hPrinter As Long, ByVal pDeviceName As String, _
pDevModeOutput As Any, pDevModeInput As Any, ByVal fMode As Long) _
As LongPublic Declare Function ResetDC Lib "gdi32" Alias "ResetDCA" _
(ByVal hdc As Long, lpInitData As Any) As LongPublic Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)Public Declare Function lstrcpy Lib "KERNEL32" Alias "lstrcpyA" _
(ByVal lpString1 As String, ByRef lpString2 As Long) As Long' Optional functions not used in this sample, but may be useful.
Public Declare Function GetForm Lib "winspool.drv" Alias "GetFormA" _
(ByVal hPrinter As Long, ByVal pFormName As String, _
ByVal Level As Long, pForm As Byte, ByVal cbBuf As Long, _
pcbNeeded As Long) As LongPublic Declare Function SetForm Lib "winspool.drv" Alias "SetFormA" _
(ByVal hPrinter As Long, ByVal pFormName As String, _
ByVal Level As Long, pForm As Byte) As Long' Constants for DEVMODE
Public Const CCHFORMNAME = 32
Public Const CCHDEVICENAME = 32
Public Const DM_FORMNAME As Long = &H10000
Public Const DM_ORIENTATION = &H1&' Constants for PRINTER_DEFAULTS.DesiredAccess
Public Const PRINTER_ACCESS_ADMINISTER = &H4
Public Const PRINTER_ACCESS_USE = &H8
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)' Constants for DocumentProperties() call
Public Const DM_MODIFY = 8
Public Const DM_IN_BUFFER = DM_MODIFY
Public Const DM_COPY = 2
Public Const DM_OUT_BUFFER = DM_COPY' Custom constants for this sample's SelectForm function
Public Const FORM_NOT_SELECTED = 0
Public Const FORM_SELECTED = 1
Public Const FORM_ADDED = 2Public Type RECTL
Left As Long
Top As Long
Right As Long
Bottom As Long
End TypePublic Type SIZEL
cx As Long
cy As Long
End TypePublic Type SECURITY_DESCRIPTOR
Revision As Byte
Sbz1 As Byte
Control As Long
Owner As Long
Group As Long
Sacl As Long ' ACL
Dacl As Long ' ACL
End Type' The two definitions for FORM_INFO_1 make the coding easier.
Public Type FORM_INFO_1
Flags As Long
pName As Long ' String
Size As SIZEL
ImageableArea As RECTL
End TypePublic Type sFORM_INFO_1
Flags As Long
pName As String
Size As SIZEL
ImageableArea As RECTL
End TypePublic Type DEVMODE
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 Long
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End TypePublic Type PRINTER_DEFAULTS
pDatatype As String
pDevMode As Long ' DEVMODE
DesiredAccess As Long
End TypePublic Type PRINTER_INFO_2
pServerName As String
pPrinterName As String
pShareName As String
pPortName As String
pDriverName As String
pComment As String
pLocation As String
pDevMode As DEVMODE
pSepFile As String
pPrintProcessor As String
pDatatype As String
pParameters As String
pSecurityDescriptor As 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
Public Function GetFormName(ByVal PrinterHandle As Long, _
FormSize As SIZEL, FormName As String) As Integer
Dim NumForms As Long, I As Long
Dim FI1 As FORM_INFO_1
Dim aFI1() As FORM_INFO_1 ' Working FI1 array
Dim Temp() As Byte ' Temp FI1 array
Dim FormIndex As Integer
Dim BytesNeeded As Long
Dim RetVal As Long
FormName = vbNullString
FormIndex = 0
ReDim aFI1(1)
' First call retrieves the BytesNeeded.
RetVal = EnumForms(PrinterHandle, 1, aFI1(0), 0&, BytesNeeded, NumForms)
ReDim Temp(BytesNeeded)
ReDim aFI1(BytesNeeded / Len(FI1))
' Second call actually enumerates the supported forms.
RetVal = EnumForms(PrinterHandle, 1, Temp(0), BytesNeeded, BytesNeeded, _
NumForms)
Call CopyMemory(aFI1(0), Temp(0), BytesNeeded)
For I = 0 To NumForms - 1
With aFI1(I)
If .Size.cx = FormSize.cx And .Size.cy = FormSize.cy Then
' Found the desired form
FormName = PtrCtoVbString(.pName)
FormIndex = I + 1
Exit For
End If
End With
Next I
GetFormName = FormIndex ' Returns non-zero when form is found.
End FunctionPublic Function AddNewForm(PrinterHandle As Long, FormSize As SIZEL, _
FormName As String) As String
Dim FI1 As sFORM_INFO_1
Dim aFI1() As Byte
Dim RetVal As Long
With FI1
.Flags = 0
.pName = FormName
With .Size
.cx = FormSize.cx
.cy = FormSize.cy
End With
With .ImageableArea
.Left = 0
.Top = 0
.Right = FI1.Size.cx
.Bottom = FI1.Size.cy
End With
End With
ReDim aFI1(Len(FI1))
Call CopyMemory(aFI1(0), FI1, Len(FI1))
RetVal = AddForm(PrinterHandle, 1, aFI1(0))
If RetVal = 0 Then
If Err.LastDllError = 5 Then
MsgBox "You do not have permissions to add a form to " & _
Printer.DeviceName, vbExclamation, "Access Denied!"
Else
MsgBox "Error: " & Err.LastDllError, "Error Adding Form"
End If
AddNewForm = "none"
Else
AddNewForm = FI1.pName
End If
End FunctionPublic Function PtrCtoVbString(ByVal Add As Long) As String
Dim sTemp As String * 512, x As Long
x = lstrcpy(sTemp, ByVal Add)
If (InStr(1, sTemp, Chr(0)) = 0) Then
PtrCtoVbString = ""
Else
PtrCtoVbString = Left(sTemp, InStr(1, sTemp, Chr(0)) - 1)
End If
End FunctionPublic Function SelectForm(FormName As String, ByVal MyhWnd As Long) _
As Integer
Dim nSize As Long ' Size of DEVMODE
Dim pDevMode As DEVMODE
Dim PrinterHandle As Long ' Handle to printer
Dim hPrtDC As Long ' Handle to Printer DC
Dim PrinterName As String
Dim aDevMode() As Byte ' Working DEVMODE
Dim FormSize As SIZEL
PrinterName = Printer.DeviceName ' Current printer
hPrtDC = Printer.hdc ' hDC for current Printer
SelectForm = FORM_NOT_SELECTED ' Set for failure unless reset in code.
' Get a handle to the printer.
If OpenPrinter(PrinterName, PrinterHandle, 0&) Then
' Retrieve the size of the DEVMODE.
nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, 0&, _
0&, 0&)
' Reserve memory for the actual size of the DEVMODE.
ReDim aDevMode(1 To nSize)
' Fill the DEVMODE from the printer.
nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, _
aDevMode(1), 0&, DM_OUT_BUFFER)
' Copy the Public (predefined) portion of the DEVMODE.
Call CopyMemory(pDevMode, aDevMode(1), Len(pDevMode))
' If FormName is "MyCustomForm", we must make sure it exists
' before using it. Otherwise, it came from our EnumForms list,
' and we do not need to check first. Note that we could have
' passed in a Flag instead of checking for a literal name.
If FormName = "MyCustomForm" Then
' Use form "MyCustomForm", adding it if necessary.
' Set the desired size of the form needed.
With FormSize ' Given in thousandths of millimeters
.cx = 214000 ' width
.cy = 216000 ' height
End With
If GetFormName(PrinterHandle, FormSize, FormName) = 0 Then
' Form not found - Either of the next 2 lines will work.
'FormName = AddNewForm(PrinterHandle, FormSize, "MyCustomForm")
AddNewForm PrinterHandle, FormSize, "MyCustomForm"
If GetFormName(PrinterHandle, FormSize, FormName) = 0 Then
ClosePrinter (PrinterHandle)
SelectForm = FORM_NOT_SELECTED ' Selection Failed!
Exit Function
Else
SelectForm = FORM_ADDED ' Form Added, Selection succeeded!
End If
End If
End If
' Change the appropriate member in the DevMode.
' In this case, you want to change the form name.
pDevMode.dmFormName = FormName & Chr(0) ' Must be NULL terminated!
' Set the dmFields bit flag to indicate what you are changing.
pDevMode.dmFields = DM_FORMNAME
' Copy your changes back, then update DEVMODE.
Call CopyMemory(aDevMode(1), pDevMode, Len(pDevMode))
nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, _
aDevMode(1), aDevMode(1), DM_IN_BUFFER Or DM_OUT_BUFFER)
nSize = ResetDC(hPrtDC, aDevMode(1)) ' Reset the DEVMODE for the DC.
' Close the handle when you are finished with it.
ClosePrinter (PrinterHandle)
' Selection Succeeded! But was Form Added?
If SelectForm <> FORM_ADDED Then SelectForm = FORM_SELECTED
Else
SelectForm = FORM_NOT_SELECTED ' Selection Failed!
End If
End FunctionPublic Sub PrintTest()
' Print two test pages to confirm the page size.
Printer.Print "Top of Page 1."
Printer.NewPage
' Spacing between lines should reflect the chosen page height.
Printer.Print "Top of Page 2. - Check the page Height (Length.)"
Printer.EndDoc
MsgBox "Check Printer " & Printer.DeviceName, vbInformation, "Done!"
End Sub'7. Run the project. The ListBox shows all of the forms that the current printer
'supports.
'
'8. Click Command1. This adds "MyCustomForm - 214 mm X 216 mm (xxx)" to the end
'of the list, where "xxx" is the number that is assigned to the new form.
'
'9. Click a form in the ListBox, and then click Command2. This prints a test page
'to the current printer using the selected form.
'
'10. Click the new custom form in the ListBox, and then click Command3. You are
'prompted to confirm the deletion of the form. If you click Yes, it removes
'the custom form. If you try this with a predefined form, it raises error 87
'because only custom forms can be deleted.