'*************************************************************************
'**模 块 名：mdlPrint
'**创 建 人：叶帆
'**日 期：2004年04月02日
'**修 改 人：
'**日 期：
'**描 述：打印机设置
'**版 本：V1.0
'*************************************************************************
Option Explicit
Public 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 Long
Public Declare Function AddForm Lib "winspool.drv" Alias "AddFormA" (ByVal hPrinter As Long, ByVal Level As Long, pForm As Byte) As Long
Public Declare Function DeleteForm Lib "winspool.drv" Alias "DeleteFormA" (ByVal hPrinter As Long, ByVal pFormName As String) As Long
Public Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, ByVal pDefault As Long) As Long
Public Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Public 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 Long
Public Declare Function ResetDC Lib "gdi32" Alias "ResetDCA" (ByVal hdc As Long, lpInitData As Any) As Long
Public 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
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 Long
Public 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
'DEVMODE 相关的参数
Public Const CCHFORMNAME = 32
Public Const CCHDEVICENAME = 32
Public Const DM_FORMNAME As Long = &H10000
Public Const DM_ORIENTATION = &H1&
'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)
'DocumentProperties() 的返回值
Public Const DM_MODIFY = 8
Public Const DM_IN_BUFFER = DM_MODIFY
Public Const DM_COPY = 2
Public Const DM_OUT_BUFFER = DM_COPY
'格式添加信息
Public Const FORM_NOT_SELECTED = 0
Public Const FORM_SELECTED = 1
Public Const FORM_ADDED = 2
Public Type RECTL
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type SIZEL
cx As Long
cy As Long
End Type
Public 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
Public Type FORM_INFO_1
Flags As Long
pName As Long
Size As SIZEL
ImageableArea As RECTL
End Type
'字符串
Public Type sFORM_INFO_1
Flags As Long
pName As String
Size As SIZEL
ImageableArea As RECTL
End Type
Public 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 Type
Public Type PRINTER_DEFAULTS
pDatatype As String
pDevMode As Long ' DEVMODE
DesiredAccess As Long
End Type
Public 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
'*************************************************************************
'**函 数 名：GetFormName
'**输 入：ByVal PrinterHandle(Long) - 打印机句柄
'** ：FormSize(SIZEL) - 格式大小
'** ：FormName(String) - 格式名称
'**输 出：(Integer) -
'**功能描述：返回预查找的格式序号，0 为没找到
'**全局变量：
'**调用模块：
'**作 者：叶帆
'**日 期：2004年04月02日
'**修 改 人：
'**日 期：
'**版 本：V1.0
'*************************************************************************
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
FormIndex = 0
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)
'If .Size.cx = FormSize.cx And .Size.cy = FormSize.cy And FormName = PtrCtoVbString(.pName) Then
If FormName = PtrCtoVbString(.pName) Then
FormIndex = i + 1
Exit For
End If
End With
Next
GetFormName = FormIndex
End Function
'*************************************************************************
'**函 数 名：AddNewForm
'**输 入：PrinterHandle(Long) - 打印机句柄
'** ：FormSize(SIZEL) - 格式大小
'** ：FormName(String) - 格式名称
'**输 出：(long) - 0 添加成功 1 不允许添加 2 添加失败
'**功能描述：添加新的打印格式
'**全局变量：
'**调用模块：
'**作 者：叶帆
'**日 期：2004年04月02日
'**修 改 人：
'**日 期：
'**版 本：V1.0
'*************************************************************************
Public Function AddNewForm(PrinterHandle As Long, FormSize As SIZEL, FormName As String) As Long
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
'不允许设置打印格式
AddNewForm = 1
Else
'Err.LastDllError
AddNewForm = 2
End If
Else
AddNewForm = 0
End If
End Function
'*************************************************************************
'**函 数 名：PtrCtoVbString
'**输 入：ByVal Add(Long) - 字符地址
'**输 出：(String) - 字符串
'**功能描述：返回指定地址的字符串
'**全局变量：
'**调用模块：
'**作 者：叶帆
'**日 期：2004年04月02日
'**修 改 人：
'**日 期：
'**版 本：V1.0
'*************************************************************************
Public 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 Function
'*************************************************************************
'**函 数 名：SetPrintForm
'**输 入：ByVal MyhWnd(Long) - 窗体句柄
'** ：FormName(String) - 格式的名称
'** ：lngPageX(Long) - 宽度值（mm）
'** ：lngPageY(Long) - 高度值（mm）
'**输 出：(Integer) - 0 格式无法添加 1 格式已添加 2 格式添加成功
'**功能描述：自定义打印格式
'**全局变量：
'**调用模块：
'**作 者：叶帆
'**日 期：2004年04月02日
'**修 改 人：
'**日 期：
'**版 本：V1.0
'*************************************************************************
Public Function SetPrintForm(ByVal MyhWnd As Long, FormName As String, lngPageX As Long, lngPageY As Long) As Integer
Dim nSize As Long
Dim pDevMode As DEVMODE
Dim PrinterHandle As Long
Dim hPrtDC As Long
Dim PrinterName As String
Dim aDevMode() As Byte
Dim FormSize As SIZEL
PrinterName = Printer.DeviceName
hPrtDC = Printer.hdc
SetPrintForm = FORM_NOT_SELECTED '预设格式无法添加
If OpenPrinter(PrinterName, PrinterHandle, 0&) Then
nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, 0&, 0&, 0&)
ReDim aDevMode(1 To nSize)
nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, aDevMode(1), 0&, DM_OUT_BUFFER)
Call CopyMemory(pDevMode, aDevMode(1), Len(pDevMode))
'设置大小
With FormSize
.cx = lngPageX * 1000 '纸张宽度
.cy = lngPageY * 1000 '纸张高度
End With
'该格式是否定义
If GetFormName(PrinterHandle, FormSize, FormName) = 0 Then '不存在这个格式
'添加该格式
AddNewForm PrinterHandle, FormSize, FormName
If GetFormName(PrinterHandle, FormSize, FormName) = 0 Then
ClosePrinter (PrinterHandle)
SetPrintForm = FORM_NOT_SELECTED '格式无法添加
Exit Function
Else
SetPrintForm = FORM_ADDED '格式添加成功
End If
End If
'设置格式的名称
pDevMode.dmFormName = FormName & Chr(0)
pDevMode.dmFields = DM_FORMNAME
'设置改变
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))
ClosePrinter (PrinterHandle)
If SetPrintForm <> FORM_ADDED Then
SetPrintForm = FORM_SELECTED '格式已添加
End If
Else
SetPrintForm = FORM_NOT_SELECTED '格式无法添加
End If
End Function
'*************************************************************************
'**函 数 名：DelForm
'**输 入：FormName(String) - 格式名称
'**输 出：(Long) - 0 删除成功 1 删除失败
'**功能描述：
'**全局变量：
'**调用模块：
'**作 者：叶帆
'**日 期：2004年04月02日
'**修 改 人：
'**日 期：
'**版 本：V1.0
'*************************************************************************
Public Function DelForm(FormName As String) As Long
Dim RetVal As Long
Dim PrinterHandle As Long
Dim PrinterName As String
Dim Continue As Long
'当前打印机
PrinterName = Printer.DeviceName
DelForm = 1
If OpenPrinter(PrinterName, PrinterHandle, 0&) Then
RetVal = DeleteForm(PrinterHandle, FormName & Chr(0))
If RetVal <> 0 Then
DelForm = 0 '删除成功
Else
DelForm = 1 '删除失败
End If
ClosePrinter (PrinterHandle)
End If
End Function
'*************************************************************************
'**函 数 名：EnumPrintForm
'**输 入：strFormName()(String) - 格式名称
'** ：szFormXY()(SIZEL) - 格式的大小
'**输 出：(Long) - 可用格式的个数
'**功能描述：枚举可用的打印格式
'**全局变量：
'**调用模块：
'**作 者：叶帆
'**日 期：2004年04月02日
'**修 改 人：
'**日 期：
'**版 本：V1.0
'*************************************************************************
Public Function EnumPrintForm(strFormName() As String, szFormXY() As SIZEL) As Long
'打开错误处理陷阱
On Error GoTo ErrGoto
'----------------------------------------------------
Dim lngNumForms As Long, i As Long
Dim FI1 As FORM_INFO_1
Dim aFI1() As FORM_INFO_1
Dim Temp() As Byte
Dim BytesNeeded As Long
Dim PrinterName As String
Dim PrinterHandle As Long
Dim strFormItem As String
Dim RetVal As Long
PrinterName = Printer.DeviceName
If OpenPrinter(PrinterName, PrinterHandle, 0&) Then
ReDim aFI1(1)
RetVal = EnumForms(PrinterHandle, 1, aFI1(0), 0&, BytesNeeded, lngNumForms)
ReDim Temp(BytesNeeded)
ReDim aFI1(BytesNeeded / Len(FI1))
RetVal = EnumForms(PrinterHandle, 1, Temp(0), BytesNeeded, BytesNeeded, lngNumForms)
Call CopyMemory(aFI1(0), Temp(0), BytesNeeded)
ReDim strFormName(1 To lngNumForms)
ReDim szFormXY(1 To lngNumForms)
For i = 0 To lngNumForms - 1
With aFI1(i)
'返回可打印的纸张名称和可打印大小
strFormName(i + 1) = PtrCtoVbString(.pName)
szFormXY(i + 1).cx = .Size.cx / 1000
szFormXY(i + 1).cy = .Size.cy / 1000
End With
Next i
ClosePrinter (PrinterHandle)
EnumPrintForm = lngNumForms
Else
EnumPrintForm = 0
End If
'----------------------------------------------------
Exit Function
'-----------------------------
ErrGoto:
EnumPrintForm = -1
End Function
'*************************************************************************
'**函 数 名：EnumUseForm
'**输 入：lngFormNo()(Long) - 格式号
'** ：strFormName()(String) - 格式名称
'** ：szFormXY()(SIZEL) - 格式的大小
'**输 出：(Long) - 可用格式的个数
'**功能描述：枚举用户可用的打印格式
'**功能描述：
'**全局变量：
'**调用模块：
'**作 者：叶帆
'**日 期：2004年04月02日
'**修 改 人：
'**日 期：
'**版 本：V1.0
'*************************************************************************
Public Function EnumUseForm(lngFormNo() As Long, strFormName() As String, szFormXY() As SIZEL) As Long
Dim strFormName1() As String
Dim szFormXY1() As SIZEL
Dim i As Long, j As Long
Dim lngValue As Long
lngValue = EnumPrintForm(strFormName1, szFormXY1)
j = 0
If lngValue > 0 Then
For i = 1 To lngValue
If SetSize(i) = 0 Then
j = j + 1
ReDim Preserve lngFormNo(1 To j)
ReDim Preserve strFormName(1 To j)
ReDim Preserve szFormXY(1 To j)
lngFormNo(j) = i
strFormName(j) = strFormName1(i)
szFormXY(j).cx = szFormXY1(i).cx
szFormXY(j).cy = szFormXY1(i).cy
End If
Next
End If
EnumUseForm = j
End Function
'*************************************************************************
'**函 数 名：SetSize
'**输 入：lngNo(Long) - 可用的格式号
'**输 出：(Long) - 0 可用 1 不可用
'**功能描述：判断打印格式是否可用
'**全局变量：
'**调用模块：
'**作 者：叶帆
'**日 期：2004年04月02日
'**修 改 人：
'**日 期：
'**版 本：V1.0
'*************************************************************************
Private Function SetSize(lngNo As Long) As Long
On Error GoTo ErrExit
Printer.PaperSize = lngNo
SetSize = 0
Exit Function
ErrExit:
SetSize = 1
End Function
'*************************************************************************
'**函 数 名：GetUsePageNo
'**输 入：strFormName(String) - 打印格式的名称
'** ：Optional lngNo(Long = -1) - 判断打印号是否可用
'**输 出：(Long) - 0 指定的格式不可用 非零 为打印格式号
'**功能描述：获取指定的打印格式号
'**全局变量：
'**调用模块：
'**作 者：叶帆
'**日 期：2004年04月02日
'**修 改 人：
'**日 期：
'**版 本：V1.0
'*************************************************************************
Public Function GetUsePageNo(Optional strFormName As String, Optional lngNo As Long = -1) As Long
Dim strFormName1() As String
Dim szFormXY1() As SIZEL
Dim lngFormNo() As Long
Dim lngNum As Long
Dim i As Long
lngNum = EnumUseForm(lngFormNo, strFormName1, szFormXY1)
If lngNo = -1 Then
For i = 0 To lngNum - 1
If strFormName1(i + 1) = strFormName Then
GetUsePageNo = lngFormNo(i + 1)
Exit Function
End If
Next
Else
For i = 0 To lngNum - 1
If lngFormNo(i + 1) = lngNo Then
GetUsePageNo = lngNo
Exit Function
End If
Next
End If
GetUsePageNo = 0
End Function
