Imports System
Imports System.Text
Imports System.Runtime
Imports System.Security
Imports System.Runtime.InteropServices
Imports System.Windows.Forms
'注意,本模块的计量单位为毫米,获取的纸张为1/%英寸
Public Class definepaper
    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _
    Private Structure structPrinterDefaults
        <MarshalAs(UnmanagedType.LPTStr)> Dim pDatatype As String
        Dim pDevMode As IntPtr
        <MarshalAs(UnmanagedType.I4)> Dim DesiredAccess As Integer
    End Structure
    <DllImport("winspool.Drv", EntryPoint:="OpenPrinter", SetLastError:=True, CharSet:=CharSet.Unicode, ExactSpelling:=False, CallingConvention:=CallingConvention.StdCall), SuppressUnmanagedCodeSecurityAttribute()> _
    Private Shared Function OpenPrinter(<MarshalAs(UnmanagedType.LPTStr)> ByVal printername As String, ByRef phPrinter As IntPtr, ByRef pd As structPrinterDefaults) As <MarshalAs(UnmanagedType.I4)> Integer
    End Function

    <DllImport("winspool.Drv", EntryPoint:="ClosePrinter", SetLastError:=True, CharSet:=CharSet.Unicode, ExactSpelling:=False, CallingConvention:=CallingConvention.StdCall), SuppressUnmanagedCodeSecurityAttribute()> _
    Private Shared Function ClosePrinter(ByVal phPrinter As IntPtr) As <MarshalAs(UnmanagedType.I4)> Integer

    End Function



    'Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, ByRef phPrinter As IntPtr, ByRef pDefault As structPrinterDefaults) As Long
    ' Private Declare Function ClosePrinter Lib "winspool.drv" Alias "ClosePrinter" (ByVal hPrinter As IntPtr) As Long
    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _
    Private Structure structSize
        Dim width As Int32
        Dim height As Int32
    End Structure
    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _
    Private Structure structRect
        Dim left As Int32
        Dim top As Int32
        Dim right As Int32
        Dim bottom As Int32
    End Structure
    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _
    Private Structure structFormInfo1
        <MarshalAs(UnmanagedType.I4)> Dim Flags As Integer
        <MarshalAs(UnmanagedType.LPTStr)> Dim pName As String
        Dim size As structSize
        Dim ImageableArea As structRect
    End Structure
    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _
    Private Structure structDevMode
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=32)> Dim dmDeviceName As String
        <MarshalAs(UnmanagedType.U2)> Dim dmSpecVersion As Short
        <MarshalAs(UnmanagedType.U2)> Dim dmDriverVersion As Short
        <MarshalAs(UnmanagedType.U2)> Dim dmSize As Short
        <MarshalAs(UnmanagedType.U2)> Dim dmDriverExtra As Short
        <MarshalAs(UnmanagedType.U4)> Dim dmFields As Integer
        <MarshalAs(UnmanagedType.I2)> Dim dmOrientation As Short
        <MarshalAs(UnmanagedType.I2)> Dim dmPaperSize As Short
        <MarshalAs(UnmanagedType.I2)> Dim dmPaperLength As Short
        <MarshalAs(UnmanagedType.I2)> Dim dmPaperWidth As Short
        <MarshalAs(UnmanagedType.I2)> Dim dmScale As Short
        <MarshalAs(UnmanagedType.I2)> Dim dmCopies As Short
        <MarshalAs(UnmanagedType.I2)> Dim dmDefaultSource As Short
        <MarshalAs(UnmanagedType.I2)> Dim dmPrintQuality As Short
        <MarshalAs(UnmanagedType.I2)> Dim dmColor As Short
        <MarshalAs(UnmanagedType.I2)> Dim dmDuplex As Short
        <MarshalAs(UnmanagedType.I2)> Dim dmYResolution As Short
        <MarshalAs(UnmanagedType.I2)> Dim dmTTOption As Short
        <MarshalAs(UnmanagedType.I2)> Dim dmCollate As Short
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=32)> Dim dmFormName As String
        <MarshalAs(UnmanagedType.U2)> Dim dmLogPixels As Short
        <MarshalAs(UnmanagedType.U4)> Dim dmBitsPerPel As Integer
        <MarshalAs(UnmanagedType.U4)> Dim dmPelsWidth As Integer
        <MarshalAs(UnmanagedType.U4)> Dim dmPelsHeight As Integer
        <MarshalAs(UnmanagedType.U4)> Dim dmNup As Integer
        <MarshalAs(UnmanagedType.U4)> Dim dmDisplayFrequency As Integer
        <MarshalAs(UnmanagedType.U4)> Dim dmICMMethod As Integer
        <MarshalAs(UnmanagedType.U4)> Dim dmICMIntent As Integer
        <MarshalAs(UnmanagedType.U4)> Dim dmMediaType As Integer
        <MarshalAs(UnmanagedType.U4)> Dim dmDitherType As Integer
        <MarshalAs(UnmanagedType.U4)> Dim dmReserved1 As Integer
        <MarshalAs(UnmanagedType.U4)> Dim dmReserved2 As Integer
    End Structure


    <DllImport("winspool.Drv", EntryPoint:="AddForm", SetLastError:=True, CharSet:=CharSet.Unicode, ExactSpelling:=False, CallingConvention:=CallingConvention.StdCall), SuppressUnmanagedCodeSecurityAttribute()> _
    Private Shared Function AddForm(ByVal hPrinter As IntPtr, <MarshalAs(UnmanagedType.I4)> ByVal Level As Integer, ByRef pForm As structFormInfo1) As <MarshalAs(UnmanagedType.I4)> Integer

    End Function
    <DllImport("winspool.Drv", EntryPoint:="DeleteForm", SetLastError:=True, CharSet:=CharSet.Unicode, ExactSpelling:=False, CallingConvention:=CallingConvention.StdCall), SuppressUnmanagedCodeSecurityAttribute()> _
    Private Shared Function DeleteForm(ByVal hPrinter As IntPtr, <MarshalAs(UnmanagedType.LPTStr)> ByVal pFormName As String) As <MarshalAs(UnmanagedType.I4)> Integer

    End Function

    <DllImport("winspool.Drv", EntryPoint:="SetForm", SetLastError:=True, CharSet:=CharSet.Unicode, ExactSpelling:=False, CallingConvention:=CallingConvention.StdCall), SuppressUnmanagedCodeSecurityAttribute()> _
    Private Shared Function SetForm(ByVal hPrinter As IntPtr, <MarshalAs(UnmanagedType.LPTStr)> ByVal pFormName As String, <MarshalAs(UnmanagedType.I4)> ByVal Level As Integer, ByRef pForm As structFormInfo1) As <MarshalAs(UnmanagedType.I4)> Integer

    End Function
    <DllImport("kernel32.dll", EntryPoint:="GetLastError", SetLastError:=False, ExactSpelling:=True, CallingConvention:=CallingConvention.StdCall), SuppressUnmanagedCodeSecurityAttribute()> _
    Private Shared Function GetLastError() As <MarshalAs(UnmanagedType.I4)> Integer

    End Function
    <DllImport("GDI32.dll", EntryPoint:="CreateDC", SetLastError:=True, CharSet:=CharSet.Unicode, ExactSpelling:=False, CallingConvention:=CallingConvention.StdCall), SuppressUnmanagedCodeSecurityAttribute()> _
    Private Shared Function CreateDC(<MarshalAs(UnmanagedType.LPTStr)> ByVal lpDriverName As String, <MarshalAs(UnmanagedType.LPTStr)> ByVal lpDeviceName As String, <MarshalAs(UnmanagedType.LPTStr)> ByVal lpOutput As String, ByRef lpInitData As structDevMode) As IntPtr

    End Function
    <DllImport("GDI32.dll", EntryPoint:="ResetDC", SetLastError:=True, CharSet:=CharSet.Unicode, ExactSpelling:=False, CallingConvention:=CallingConvention.StdCall), SuppressUnmanagedCodeSecurityAttribute()> _
    Private Shared Function ResetDC(ByVal hdc As IntPtr, ByRef lpInitData As structDevMode) As IntPtr

    End Function
    <DllImport("GDI32.dll", EntryPoint:="DeleteDC", SetLastError:=True, CharSet:=CharSet.Unicode, ExactSpelling:=False, CallingConvention:=CallingConvention.StdCall), SuppressUnmanagedCodeSecurityAttribute()> _
    Private Shared Function DeleteDC(ByVal hdc As IntPtr) As <MarshalAs(UnmanagedType.I4)> Integer

    End Function
    
    Public Function GetPrintForm(ByVal printerName As String, ByVal paperName As String) As System.Drawing.Printing.PaperSize
        '得到指定打印机的纸张的参数,如果该打印机没有这种纸,则返回NotHing
        Dim paper As System.Drawing.Printing.PaperSize = Nothing
        Dim printer As System.Drawing.Printing.PrinterSettings = New System.Drawing.Printing.PrinterSettings()
        printer.PrinterName = printerName

        For Each ps As System.Drawing.Printing.PaperSize In printer.PaperSizes
            If (ps.PaperName.ToLower() = paperName.ToLower()) Then
                paper = ps
                Exit For
            End If
        Next
        Return paper
    End Function

    Public Sub SetPrintForm(ByVal printerName As String, ByVal paperName As String, ByVal width As Single, ByVal height As Single)
        '设置打印机printername自定义打印纸张

        If (PlatformID.Win32NT = Environment.OSVersion.Platform) Then

            Const PRINTER_ACCESS_USE As Integer = 8
            Const PRINTER_ACCESS_ADMINISTER As Integer = 4

            Dim defaults As structPrinterDefaults = New structPrinterDefaults()

            defaults.pDatatype = Nothing

            defaults.pDevMode = IntPtr.Zero
            defaults.DesiredAccess = PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE

            Dim hPrinter As IntPtr = IntPtr.Zero
            Dim p As Long
            p = OpenPrinter(printerName, hPrinter, defaults)
            If (p <> 0) Then

                Try

                    Dim formInfo As structFormInfo1 = New structFormInfo1()
                    formInfo.Flags = 0

                    formInfo.pName = paperName

                    formInfo.size.width = CInt(width * 1000)

                    formInfo.size.height = CInt(height * 1000)

                    formInfo.ImageableArea.left = 0

                    formInfo.ImageableArea.right = formInfo.size.width

                    formInfo.ImageableArea.top = 0

                    formInfo.ImageableArea.bottom = formInfo.size.height

                    Dim rslt As Boolean = False
                    If (GetPrintForm(printerName, paperName) IsNot Nothing) Then

                        rslt = SetForm(hPrinter, paperName, 1, formInfo)

                    Else

                        AddCustomPaperSize(printerName, paperName, width, height)
                        rslt = True
                    End If
                    If rslt = False Then
                        Dim strBuilder As StringBuilder = New StringBuilder()

                        strBuilder.AppendFormat("添加纸张{0}时发生错误!, 系统错误号: {1}", paperName, GetLastError())

                        MessageBox.Show(strBuilder.ToString())

                    End If

                Finally
                    ClosePrinter(hPrinter)
                End Try
            End If
        End If

    End Sub

    Public Sub AddCustomPaperSize(ByVal printerName As String, ByVal paperName As String, ByVal width As Single, ByVal height As Single)


        If (PlatformID.Win32NT = Environment.OSVersion.Platform) Then

            Const PRINTER_ACCESS_USE As Integer = 8
            Const PRINTER_ACCESS_ADMINISTER As Integer = 4

            Dim defaults As structPrinterDefaults = New structPrinterDefaults()

            defaults.pDatatype = Nothing

            defaults.pDevMode = IntPtr.Zero

            defaults.DesiredAccess = PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE

            Dim hPrinter As IntPtr = IntPtr.Zero
            If OpenPrinter(printerName, hPrinter, defaults) <> 0 Then


                Try


                    DeleteForm(hPrinter, paperName)

                    Dim formInfo As structFormInfo1 = New structFormInfo1()

                    formInfo.Flags = 0

                    formInfo.pName = paperName

                    formInfo.size.width = CInt(width * 1000.0)

                    formInfo.size.height = CInt(height * 1000.0)

                    formInfo.ImageableArea.left = 0

                    formInfo.ImageableArea.right = formInfo.size.width

                    formInfo.ImageableArea.top = 0

                    formInfo.ImageableArea.bottom = formInfo.size.height
                    Try
                        If (AddForm(hPrinter, 1, formInfo) = 0) Then


                            Dim strBuilder As StringBuilder = New StringBuilder()

                            strBuilder.AppendFormat("添加纸张{0}时发生错误!, 系统错误号: {1}", paperName, GetLastError())

                            Throw New ApplicationException(strBuilder.ToString())

                        End If
                    Catch ex As Exception
                        MsgBox("添加自定义纸张时出现错误:" & ex.Message)
                    End Try




                Finally

                    ClosePrinter(hPrinter)

                End Try



            Else

                Dim strBuilder As StringBuilder = New StringBuilder()

                strBuilder.AppendFormat("打开打印机{0} 时出现异常!, 系统错误号: {1}", printerName, GetLastError())

                Throw New ApplicationException(strBuilder.ToString())

            End If
        Else
            Dim pDevMode As structDevMode = New structDevMode()

            Dim hDC As IntPtr = CreateDC(Nothing, printerName, Nothing, pDevMode)

            If (hDC <> IntPtr.Zero) Then
                Const DM_PAPERSIZE As Long = 2

                Const DM_PAPERLENGTH As Long = 4

                Const DM_PAPERWIDTH As Long = 8

                pDevMode.dmFields = DM_PAPERSIZE Or DM_PAPERWIDTH Or DM_PAPERLENGTH

                pDevMode.dmPaperSize = 256

                pDevMode.dmPaperWidth = CInt(width * 2.54 * 1000.0)

                pDevMode.dmPaperLength = CInt(height * 2.54 * 1000.0)

                ResetDC(hDC, pDevMode)

                DeleteDC(hDC)

            End If
        End If

    End Sub
End Class
