Binaryworld - How To Print Using Custom Page Sizes on Windows NT and Windows 2000 ... [ VB -> Printing ]

Have you ever tried to set custom paper size using VB inbuilt Printer object ??? You can set custom papersize by setting Printer.PaperSize = 256 and then Printer.Height = 4500 , Printer.Width = 7500 but unfortunately this wont work under NT/2000 because in NT each paper size is considered as a "Form". To add custom papersize you have to use AddForm api and you can use DeleteForm api to delete custom papersize which is added by AddForm api.

You can not delete inbuilt paper size so DeleteForm will return error 87 (Invalid Parameter) if you try to delete inbuilt papersize. Once you add custom papersize (i.e. Custom Form) it can be used with any printer from the same Print Server. If you have multiple printers from different print server then probably you have add custom form for each printer separately.

For more information please check the following KB Article

http://support.microsoft.com/default.aspx?kbid=282474

Step-By-Step Example

- Create a standard exe project
- Add one combobox and four commandbutton controls
- Add one list box and 2 radiobutton controls
- Add one module to the project
- Add the following code in form1

Form1.frm

Click here to copy the following block

Option Explicit
Private Sub Command1_Click()
  Dim colNetworkPrinters As New Collection
  Dim srvName As String, tmpName As String

  Dim FormName As String
  Dim PrinterName As String
  Dim i

  On Error Resume Next

  FormName = "MyCustomForm" ' Use special, user-defined form.
  PrinterName = Combo1.Text

  If Option1.Value = True Then
    For i = 0 To Combo1.ListCount - 1
      '//For network printers (i.e. \\myserver\printer1): If printers are on the same print server then
      '//only one entry is needed so just do for first printer and skip others
      tmpName = ""
      srvName = GetSrvName(Combo1.List(i))

      If srvName <> "" Then
        '//if network path
        tmpName = colNetworkPrinters(srvName)
        '//if not installed + AddMyForm is successful
        If tmpName = "" Then
          If AddMyForm(Combo1.List(i), FormName) Then
            '//check if Network Printer
            colNetworkPrinters.Add srvName, srvName
          End If
        End If
      Else
        '//if not network path
        Call AddMyForm(Combo1.List(i), FormName)
      End If
    Next
  Else
    Call AddMyForm(Combo1.Text, FormName)
  End If
  RefreshAvailablePaperSizeList
End Sub
Function GetSrvName(PrinterName) As String
  Dim pos As Integer

  PrinterName = Trim(PrinterName)

  If Left(PrinterName, 2) = "\\" Then
    pos = InStr(3, PrinterName, "\")
    If pos > 0 Then GetSrvName = Mid(PrinterName, 3, pos - 3)
  End If
End Function

Private Sub Command2_Click()
  Dim FormName As String
  Dim PrinterName As String

  ' Get FormName from the ListBox.
  On Error GoTo ListBoxERR ' Trap for no selection.
  FormName = Mid(List1.Text, 1, InStr(1, List1.Text, " -") - 1)
  PrinterName = Combo1.Text

  On Error GoTo 0     ' Turn off Error trap.

  Dim RetVal As Long
  Dim PrinterHandle As Long ' Handle to printer
  Dim Continue As Long

  '//If form exists then return code will be FORM_SELECTED
  '//and print action will be taken
  '//In no form exists then ADD operation is taken. Return code will be FORM_ADDED
  RetVal = SelectForm(FormName, Me.hwnd, PrinterName)

  Select Case RetVal
    Case FORM_NOT_SELECTED  ' 0
      ' Selection failed!
      MsgBox "Unable to retrieve From name", vbExclamation, _
          "Operation halted!"
    Case FORM_SELECTED ' 1
      PrintTest PrinterName
    Case FORM_ADDED   ' 2
      '//Form added and selected.
      RefreshAvailablePaperSizeList  ' by rebuilding the list.
      MsgBox FormName & " is added to " & PrinterName & _
          ". Now printing will start using " & FormName, vbInformation
      PrintTest PrinterName
  End Select

  Exit Sub
ListBoxERR:
  MsgBox "Select a papersize from the ListBox before using this option.", _
      vbExclamation
End Sub

Private Sub Command3_Click()
  Dim colNetworkPrinters As New Collection
  Dim srvName As String, tmpName As String

  Dim FormName As String
  Dim PrinterName As String
  Dim i

  On Error Resume Next

  If List1.ListIndex < 0 Then
    MsgBox "Select a papersize from the ListBox before using this option."
    Exit Sub
  End If
  FormName = Mid(List1.Text, 1, InStr(1, List1.Text, " -") - 1)

  If Option1.Value = True Then
    For i = 0 To Combo1.ListCount - 1

      '//For network printers (i.e. \\myserver\printer1): If printers are on the same print server then
      '//only one entry is needed so just do for first printer and skip others
      tmpName = ""
      srvName = GetSrvName(Combo1.List(i))

      If srvName <> "" Then
        '//if network path
        tmpName = colNetworkPrinters(srvName)
        '//if not installed + AddMyForm is successful
        If tmpName = "" Then
          If DeleteMyForm(Combo1.List(i), FormName) Then
            '//check if Network Printer
            colNetworkPrinters.Add srvName, srvName
          End If
        End If
      Else
        '//if not network path
        '//Delete the selected form for all installed printer
        Call DeleteMyForm(Combo1.List(i), FormName)
      End If
    Next
  Else
    PrinterName = Combo1.Text  ' Current printer
    '//Delete the selected form of the selected printer
    Call DeleteMyForm(PrinterName, FormName)
  End If
  RefreshAvailablePaperSizeList
End Sub

Private Sub Command4_Click()
  RefreshAvailablePaperSizeList
End Sub

Private Sub Form_Load()

  Command1.Caption = "Add Custom Form"
  Command2.Caption = "Print Test Page"
  Command3.Caption = "Delete Custom Form"
  Command4.Caption = "Display Available Paper Size"
  Option1.Value = True
  Option2.Value = False

  '//Loop through all installed printers and fill combo
  Dim prn As Printer
  Dim DefaultPrinterIdx As Integer

  For Each prn In Printers
    Combo1.AddItem prn.DeviceName
    If prn.DeviceName = Printer.DeviceName Then DefaultPrinterIdx = Combo1.NewIndex
  Next

  If Combo1.ListCount > 0 Then
    Combo1.ListIndex = DefaultPrinterIdx
  Else
    MsgBox "No printer installed", vbCritical
    Command1.Enabled = False
    Command2.Enabled = False
    Command3.Enabled = False
    Command4.Enabled = False
    Exit Sub
  End If

  Call RefreshAvailablePaperSizeList
End Sub

Function AddMyForm(PrinterName As String, FormName As String) As Boolean
  Dim RetVal As Long
  Dim Continue As Long

  '//If form exists then return code will be FORM_SELECTED
  '//and print action will be taken
  '//In no form exists then ADD operation is taken. Return code will be FORM_ADDED
  RetVal = SelectForm(FormName, Me.hwnd, PrinterName)

  Select Case RetVal
    Case FORM_NOT_SELECTED  ' 0
      ' Selection failed!
      MsgBox "Unable to retrieve From name" & " ErrorCode:" & Err.LastDllError, vbExclamation, _
          "Operation halted!"
    Case FORM_SELECTED ' 1
      MsgBox FormName & " for " & PrinterName & " is already there", vbExclamation
    Case FORM_ADDED   ' 2
      '//Form added and selected.
      MsgBox FormName & " is added to " & PrinterName, vbInformation
      AddMyForm = True
  End Select
End Function

Function DeleteMyForm(PrinterName As String, FormName As String) As Boolean
  Dim RetVal As Long
  Dim PrinterHandle As Long ' Handle to printer
  Dim Continue As Long

  If OpenPrinter(PrinterName, PrinterHandle, 0&) Then

    On Error GoTo 0   ' Turn off Error trap.
    Err.Clear
    Continue = MsgBox("Are you sure you want to permanently remove " & _
        FormName & " from " & PrinterName & "?", vbYesNo)
    If Continue = vbYes Then
      RetVal = DeleteForm(PrinterHandle, FormName & Chr(0))
      If RetVal <> 0 Then  ' DeleteForm succeeded.
        MsgBox FormName & " deleted!", vbInformation, "Success!"
        DeleteMyForm = True
      Else
        MsgBox FormName & " not deleted!" & vbCrLf & vbCrLf & _
            "Error code: " & Err.LastDllError, vbInformation, "Failure!"
      End If
    End If
    RetVal = ClosePrinter(PrinterHandle)
  End If

  Exit Function
ListBoxERR:
  MsgBox "Select a papersize from the ListBox before using this option.", _
      vbExclamation
  RetVal = ClosePrinter(PrinterHandle)
End Function

Sub RefreshAvailablePaperSizeList()
  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 BytesNeeded As Long
  Dim PrinterName As String ' Current printer
  Dim PrinterHandle As Long ' Handle to printer
  Dim FormItem As String ' For ListBox
  Dim RetVal As Long
  Dim FormSize As SIZEL  ' Size of desired form

  List1.Clear
  PrinterName = Combo1.Text '//Set selected printer for current demo

  If OpenPrinter(PrinterName, PrinterHandle, 0&) Then
    With FormSize    ' Desired page size
      .cx = 214000
      .cy = 216000
    End With
    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)
        ' List name and size including the count (index).
        FormItem = PtrCtoVbString(.pName) & " - " & .Size.cx / 1000 & _
            " mm X " & .Size.cy / 1000 & " mm (" & i + 1 & ")"
        List1.AddItem FormItem
      End With
    Next i
    ClosePrinter (PrinterHandle)
  End If

  Me.Caption = "Total " & List1.ListCount & " paper size available for " & Combo1.Text
End Sub

Public Sub PrintTest(Optional PrinterName As String = "")

  If PrinterName = "" Then
    PrinterName = Printer.DeviceName  ' Use Default printer
  Else
    MakeDefaultPrinter PrinterName  'Use specified printer
  End If

  ' Print two test pages to confirm the page size.
  Printer.Print "Top of Page 1."
  Printer.NewPage
  ' Spacing between lines should reflect the chosen page height.
  Printer.Print "Top of Page 2. - Check the page Height (Length.)"
  Printer.EndDoc
  MsgBox "Check Printer " & Printer.DeviceName, vbInformation, "Done!"
End Sub

Now Add the following code in Module1

Module1.bas

Click here to copy the following block

'/////////////////////////////////////////////////////////////////////////
'This code is directly taken from Microsoft KB Article Q282474
'http://support.microsoft.com/default.aspx?kbid=282474
'/////////////////////////////////////////////////////////////////////////
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

Private 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

' Optional functions not used in this sample, but may be useful.
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

' Constants for DEVMODE
Public Const CCHFORMNAME = 32
Public Const CCHDEVICENAME = 32
Public Const DM_FORMNAME As Long = &H10000
Public Const DM_ORIENTATION = &H1&

' Constants 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)

' Constants for DocumentProperties() call
Public Const DM_MODIFY = 8
Public Const DM_IN_BUFFER = DM_MODIFY
Public Const DM_COPY = 2
Public Const DM_OUT_BUFFER = DM_COPY

' Custom constants for this sample's SelectForm function
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

' The two definitions for FORM_INFO_1 make the coding easier.
Public Type FORM_INFO_1
  Flags As Long
  pName As Long      ' String
  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

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

  FormName = vbNullString
  FormIndex = 0
  ReDim aFI1(1)
  ' First call retrieves the BytesNeeded.
  RetVal = EnumForms(PrinterHandle, 1, aFI1(0), 0&, BytesNeeded, NumForms)
  ReDim Temp(BytesNeeded)
  ReDim aFI1(BytesNeeded / Len(FI1))
  ' Second call actually enumerates the supported forms.
  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 Then
        ' Found the desired form
        FormName = PtrCtoVbString(.pName)
        FormIndex = i + 1
        Exit For
      End If
    End With
  Next i
  GetFormName = FormIndex ' Returns non-zero when form is found.
End Function

Private Function AddNewForm(PrinterHandle As Long, FormSize As SIZEL, _
              FormName As String) As String
  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
      MsgBox "You do not have permissions to add a form to " & _
          Printer.DeviceName, vbExclamation, "Access Denied!"
    Else
      MsgBox "Error: " & Err.LastDllError, "Error Adding Form"
    End If
    AddNewForm = "none"
  Else
    AddNewForm = FI1.pName
  End If
End Function

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

Public Sub MakeDefaultPrinter(TargetPrinter As String)
  Dim prn As Printer
  For Each prn In Printers
    If prn.DeviceName = TargetPrinter Then Set Printer = prn: Exit Sub
  Next
End Sub

Public Function SelectForm(FormName As String, ByVal MyhWnd As Long, Optional PrinterName As String = "") As Integer
  Dim nSize As Long    ' Size of DEVMODE
  Dim pDevMode As DEVMODE
  Dim PrinterHandle As Long ' Handle to printer
  Dim hPrtDC As Long    ' Handle to Printer DC
  Dim aDevMode() As Byte ' Working DEVMODE
  Dim FormSize As SIZEL

  If PrinterName = "" Then
    PrinterName = Printer.DeviceName  ' Current printer
  Else
    MakeDefaultPrinter PrinterName
  End If

  hPrtDC = Printer.hdc   ' hDC for current Printer
  SelectForm = FORM_NOT_SELECTED  ' Set for failure unless reset in code.

  ' Get a handle to the printer.
  If OpenPrinter(PrinterName, PrinterHandle, 0&) Then
    ' Retrieve the size of the DEVMODE.
    nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, 0&, _
        0&, 0&)
    ' Reserve memory for the actual size of the DEVMODE.
    ReDim aDevMode(1 To nSize)

    ' Fill the DEVMODE from the printer.
    nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, _
        aDevMode(1), 0&, DM_OUT_BUFFER)
    ' Copy the Public (predefined) portion of the DEVMODE.
    Call CopyMemory(pDevMode, aDevMode(1), Len(pDevMode))

    ' If FormName is "MyCustomForm", we must make sure it exists
    ' before using it. Otherwise, it came from our EnumForms list,
    ' and we do not need to check first. Note that we could have
    ' passed in a Flag instead of checking for a literal name.
    If FormName = "MyCustomForm" Then
      ' Use form "MyCustomForm", adding it if necessary.
      ' Set the desired size of the form needed.
      With FormSize  ' Given in thousandths of millimeters
        .cx = 214000 ' width
        .cy = 216000 ' height
      End With
      If GetFormName(PrinterHandle, FormSize, FormName) = 0 Then
        ' Form not found - Either of the next 2 lines will work.
        'FormName = AddNewForm(PrinterHandle, FormSize, "MyCustomForm")
        AddNewForm PrinterHandle, FormSize, "MyCustomForm"
        If GetFormName(PrinterHandle, FormSize, FormName) = 0 Then
          ClosePrinter (PrinterHandle)
          SelectForm = FORM_NOT_SELECTED  ' Selection Failed!
          Exit Function
        Else
          SelectForm = FORM_ADDED  ' Form Added, Selection succeeded!
        End If
      End If
    End If

    ' Change the appropriate member in the DevMode.
    ' In this case, you want to change the form name.
    pDevMode.dmFormName = FormName & Chr(0)  ' Must be NULL terminated!
    ' Set the dmFields bit flag to indicate what you are changing.
    pDevMode.dmFields = DM_FORMNAME

    ' Copy your changes back, then update DEVMODE.
    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))  ' Reset the DEVMODE for the DC.

    ' Close the handle when you are finished with it.
    ClosePrinter (PrinterHandle)
    ' Selection Succeeded! But was Form Added?
    If SelectForm <> FORM_ADDED Then SelectForm = FORM_SELECTED
  Else
    SelectForm = FORM_NOT_SELECTED  ' Selection Failed!
  End If
End Function

Click here to copy the following block

http://support.microsoft.com/default.aspx?kbid=282474