Win2000下打印设定

'*************************************************************************
'**模 块 名：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