小吳 VBQA 程式設計討論

請問各位大大若我的印表機(Panasonic KX-P1121)無自訂紙張選項，請問要如何自訂紙張(WINXP+VB6+SP5)
我有用以下API但沒用
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
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)

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 DMORIENT_PORTRAIT = 1
Private Const DMORIENT_LANDSCAPE = 2
Private Const DM_ORIENTATION = &H1
Private Const DM_PAPERSIZE = &H2&
'這些Public變數是PaperSize的常數，常數太多了，只拿這些來看，其他的自行查DMPAPER_開頭的常數
Public Const DMPAPER_A2 = 66
Public Const DMPAPER_A4 = 9
Public Const DMPAPER_B4 = 12
Public Const DMPAPER_B5 = 13
Public Const DMPAPER_LETTER = 1

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
　 dmICMIntent As Long
　 dmMediaType As Long
　 dmDitherType As Long
　 dmReserved1 As Long
　 dmReserved2 As Long
End Type
Private Type PRINTER_DEFAULTS
pDatatype As String
　 pDevMode As Long
　 DesiredAccess As Long
End Type
Type ACL
AclRevision As Byte
　　　　Sbz1 As Byte
　　　　AclSize As Integer
　　　　AceCount As Integer
　　　　Sbz2 As Integer
End Type
Type SECURITY_DESCRIPTOR
Revision As Byte
　　　　Sbz1 As Byte
　　　　Control As Long
　　　　Owner As Long
　　　　Group As Long
　　　　Sacl As ACL
　　　　Dacl As ACL
End Type

Private 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　 '第7個Long值
　　　　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
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" _
(ByValhPrinter 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

'設定預設印表機的列印方向，參數 1:直式　2:橫式
Public Sub SetOrientation(NewOrientation As Long)
Dim PrinterHandle As Long
Dim PrinterName As String
Dim pd As PRINTER_DEFAULTS
Dim lpDevMode As DEVMODE
Dim Result As Long
Dim Needed As Long
Dim pFullDevMode As Long
Dim pi2_buffer() As Long
On Error GoTo errHandle
PrinterName = Printer.DeviceName
If PrinterName = "" Then Exit Sub
pd.pDatatype = vbNullString
pd.pDevMode = 0&
pd.DesiredAccess = PRINTER_ALL_ACCESS
'取得Handle of Printer
Result = OpenPrinter(PrinterName, PrinterHandle, pd)
'取得 Printer_Info_2的資料需要多少Byte
Result = GetPrinter(PrinterHandle, 2, ByVal 0&, 0, Needed)
ReDim pi2_buffer((Needed \ 4)) '一個Long = 4個Byte
'第二個參數傳2代表pi2_buffer存的是Printer_Info_2
Result = GetPrinter(PrinterHandle, 2, pi2_buffer(0), Needed, Needed)
pFullDevMode = pi2_buffer(7) '取得Printer_Info_2.pDevMode的指標
'Copy Printer_Info_2.pDevMode的結構內容到lpDevMode
Call CopyMemory(lpDevMode, ByVal pFullDevMode, Len(lpDevMode))
'--------以下更動新的文件方向
lpDevMode.dmOrientation = NewOrientation
lpDevMode.dmFields = DM_ORIENTATION
'------------------------------
'copy 回Printer_Info_2.pDevMode
Call CopyMemory(ByVal pFullDevMode, lpDevMode, Len(lpDevMode))
Result = DocumentProperties(0, PrinterHandle, PrinterName, ByVal _
pFullDevMode, ByVal pFullDevMode, DM_IN_BUFFER Or DM_OUT_BUFFER)
　　　　　
'設定更改後的資料回Printer
Result = SetPrinter(PrinterHandle, 2, pi2_buffer(0), 0&)
Call ClosePrinter(PrinterHandle)
'以下是cww所Mark，我個人覺得沒有必要，或許在某些情況下需要也不一定
'但至少我Mark後也正常運作
'Dim p As Printer
'For Each p In Printers
'　　If p.DeviceName = PrinterName Then
'　　　 Set Printer = p
'　　　 Exit For
'　　End If
'Next p
'Printer.Orientation = lpDevMode.dmOrientation
Exit Sub
errHandle:
'--- Your Error Handle Here
End Sub
'設定預設印表機的紙張規格
Public Sub SetPaperSize(NewPaperSize As Long)
Dim PrinterHandle As Long
Dim PrinterName As String
Dim pd As PRINTER_DEFAULTS
Dim lpDevMode As DEVMODE
Dim Result As Long
Dim Needed As Long
Dim pFullDevMode As Long
Dim pi2_buffer() As Long
PrinterName = Printer.DeviceName
If PrinterName = "" Then Exit Sub
pd.pDatatype = vbNullString
pd.pDevMode = 0&
pd.DesiredAccess = PRINTER_ALL_ACCESS
'取得Handle of Printer
Result = OpenPrinter(PrinterName, PrinterHandle, pd)
'取得 Printer_Info_2的資料需要多少Byte
Result = GetPrinter(PrinterHandle, 2, ByVal 0&, 0, Needed)
ReDim pi2_buffer((Needed \ 4)) '一個Long = 4個Byte
'第二個參數傳2代表pi2_buffer存的是Printer_Info_2
Result = GetPrinter(PrinterHandle, 2, pi2_buffer(0), Needed, Needed)
pFullDevMode = pi2_buffer(7) '取得Printer_Info_2.pDevMode的指標
'Copy Printer_Info_2.pDevMode的結構內容到lpDevMode
Call CopyMemory(lpDevMode, ByVal pFullDevMode, Len(lpDevMode))
'--------以下更動新的紙張規格
lpDevMode.dmPaperSize = NewPaperSize
lpDevMode.dmFields = DM_PAPERSIZE
'------------------------------
'copy 回Printer_Info_2.pDevMode
Call CopyMemory(ByVal pFullDevMode, lpDevMode, Len(lpDevMode))
Result = DocumentProperties(0, PrinterHandle, PrinterName, ByVal _
pFullDevMode, ByVal pFullDevMode, DM_IN_BUFFER Or DM_OUT_BUFFER)
　　　　　
'設定更改後的資料回Printer
Result = SetPrinter(PrinterHandle, 2, pi2_buffer(0), 0&)
Call ClosePrinter(PrinterHandle)
End Sub
'自訂印表機的紙張
Public Sub SetUserDefPaperSize(ByVal vsngWidthByCm As Single, _
ByVal vsngHeightByCm As Single)
　　Dim PrinterHandle As Long
　　Dim PrinterName As String
　　Dim pd As PRINTER_DEFAULTS
　　Dim lpDevMode As DEVMODE
　　Dim Result As Long
　　Dim Needed As Long
　　Dim pFullDevMode As Long
　　Dim pi2_buffer() As Long
　　
　　PrinterName = Printer.DeviceName
　　If PrinterName = "" Then Exit Sub
　　
　　pd.pDatatype = vbNullString
　　pd.pDevMode = 0&
　　pd.DesiredAccess = PRINTER_ALL_ACCESS
　　'取得Handle of Printer
　　Result = OpenPrinter(PrinterName, PrinterHandle, pd)
　　'取得 Printer_Info_2的資料需要多少Byte
　　Result = GetPrinter(PrinterHandle, 2, ByVal 0&, 0, Needed)
　　ReDim pi2_buffer((Needed \ 4)) '一個Long = 4個Byte
　　'第二個參數傳2代表pi2_buffer存的是Printer_Info_2
　　Result = GetPrinter(PrinterHandle, 2, pi2_buffer(0), Needed, Needed)
　　
　　pFullDevMode = pi2_buffer(7) '取得Printer_Info_2.pDevMode的指標
　　'Copy Printer_Info_2.pDevMode的結構內容到lpDevMode
　　Call CopyMemory(lpDevMode, ByVal pFullDevMode, Len(lpDevMode))
　　
　　'--------以下更動新的紙張規格
　　lpDevMode.dmPaperSize = DMPAPER_USER
　　lpDevMode.dmPaperWidth = vsngWidthByCm * 100
　　lpDevMode.dmPaperLength = vsngHeightByCm * 100
　　lpDevMode.dmFields = DM_PAPERSIZE + DM_PAPERLENGTH + DM_PAPERWIDTH
　　'lpDevMode.dmFields = DM_PAPERSIZE
　　'------------------------------
　　'copy 回Printer_Info_2.pDevMode
　　Call CopyMemory(ByVal pFullDevMode, lpDevMode, Len(lpDevMode))
　　
　　Result = DocumentProperties(0, PrinterHandle, PrinterName, ByVal _
　　　　　　　pFullDevMode, ByVal pFullDevMode, DM_IN_BUFFER Or DM_OUT_BUFFER)
　　　　　　　
　　'設定更改後的資料回Printer
　　Result = SetPrinter(PrinterHandle, 2, pi2_buffer(0), 0&)
　　
　　Call ClosePrinter(PrinterHandle)
End Sub