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

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

Public Type FORM_INFO_1

        Flags As Long

        pName As Long

        Size As SIZEL

        ImageableArea As RECTL

'字符串

Public Type sFORM_INFO_1

        pName As String

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

Public Type PRINTER_DEFAULTS

        pDatatype As String

        pDevMode As Long    ' DEVMODE

        DesiredAccess As Long

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

        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

'**函 数 名：GetFormName

'**输    入：ByVal PrinterHandle(Long) - 打印机句柄

'**        ：FormSize(SIZEL)           - 格式大小

'**        ：FormName(String)          - 格式名称

'**输    出：(Integer) -

'**功能描述：返回预查找的格式序号，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 添加失败

'**功能描述：添加新的打印格式

Public Function AddNewForm(PrinterHandle As Long, FormSize As SIZEL, FormName As String) As Long

    Dim FI1 As sFORM_INFO_1

    Dim aFI1() As Byte

    With FI1

        .Flags = 0

        .pName = FormName

        With .Size

            .cx = FormSize.cx

            .cy = FormSize.cy

        With .ImageableArea

            .Left = 0

            .Top = 0

            .Right = FI1.Size.cx

            .Bottom = FI1.Size.cy

    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

'**函 数 名：PtrCtoVbString

'**输    入：ByVal Add(Long) - 字符地址

'**输    出：(String) - 字符串

'**功能描述：返回指定地址的字符串

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 = ""

         PtrCtoVbString = Left(sTemp, InStr(1, sTemp, Chr(0)) - 1)

'**函 数 名：SetPrintForm

'**输    入：ByVal MyhWnd(Long) - 窗体句柄

'**        ：FormName(String)   - 格式的名称

'**        ：lngPageX(Long)     - 宽度值（mm）

'**        ：lngPageY(Long)     - 高度值（mm）

'**输    出：(Integer) - 0 格式无法添加 1 格式已添加 2 格式添加成功

'**功能描述：自定义打印格式

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  '纸张高度

        '该格式是否定义

        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          '格式添加成功

        '设置格式的名称

        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            '格式已添加

        SetPrintForm = FORM_NOT_SELECTED           '格式无法添加

'**函 数 名：DelForm

'**输    入：FormName(String) - 格式名称

'**输    出：(Long) - 0 删除成功 1 删除失败

'**功能描述：

Public Function DelForm(FormName As String) As Long

    Dim Continue As Long

    '当前打印机

    DelForm = 1

        RetVal = DeleteForm(PrinterHandle, FormName & Chr(0))

        If RetVal <> 0 Then

           DelForm = 0     '删除成功

           DelForm = 1     '删除失败

'**函 数 名：EnumPrintForm

'**输    入：strFormName()(String) - 格式名称

'**        ：szFormXY()(SIZEL)     - 格式的大小

'**输    出：(Long) - 可用格式的个数

'**功能描述：枚举可用的打印格式

Public Function EnumPrintForm(strFormName() As String, szFormXY() As SIZEL) As Long

   '打开错误处理陷阱

   On Error GoTo ErrGoto

   '----------------------------------------------------

    Dim lngNumForms As Long, i As Long

    Dim aFI1() As FORM_INFO_1

    Dim Temp() As Byte

    Dim strFormItem As String

        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

        EnumPrintForm = lngNumForms

        EnumPrintForm = 0

   Exit Function

   '-----------------------------

ErrGoto:

   EnumPrintForm = -1

'**函 数 名：EnumUseForm

'**输    入：lngFormNo()(Long)     - 格式号

'**        ：strFormName()(String) - 格式名称

'**功能描述：枚举用户可用的打印格式

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 不可用

'**功能描述：判断打印格式是否可用

Private Function SetSize(lngNo As Long) As Long

  On Error GoTo ErrExit

  Printer.PaperSize = lngNo

  SetSize = 0

  Exit Function

ErrExit:

  SetSize = 1

'**函 数 名：GetUsePageNo

'**输    入：strFormName(String) - 打印格式的名称

'**        ：Optional lngNo(Long = -1) - 判断打印号是否可用

'**输    出：(Long) - 0 指定的格式不可用 非零 为打印格式号

'**功能描述：获取指定的打印格式号

Public Function GetUsePageNo(Optional strFormName As String, Optional lngNo As Long = -1) As Long

   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

           If lngFormNo(i + 1) = lngNo Then

              GetUsePageNo = lngNo

   GetUsePageNo = 0