Binaryworld - Setting Custom Paper Size using Printer API ... [ VB -> Printing ]

Here is the alternate method which shows how to use printer APIs to set custom papersize and other printer properties using API. This code will work with Win9x and WinNT both.

Click here to copy the following block

Option Explicit

'// VERSION INFO //
Private Const VER_PLATFORM_WIN32_WINDOWS = 1

Private Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
End Type

Private Declare Function GetVersionExA Lib "kernel32" _
(lpVersionInformation As OSVERSIONINFO) As Integer

'for use in NT/2000 only
Private Const sCustomFormTitle As String = "TechnoLogismiki's Custom Form"

'******************************************
'// PRINTER //
'******************************************
Private Const NULLPTR = 0&
' Constants for DEVMODE
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32

'******************************************
'// Constants for DocumentProperties //
'******************************************
Private Const DM_IN_BUFFER = 8
Private Const DM_OUT_BUFFER = 2
Private Const DM_IN_PROMPT = 4
' Constants for dmOrientation
Private Const DM_ORIENTATION = &H1&
Private Const DMORIENT_PORTRAIT = 1
Private Const DMORIENT_LANDSCAPE = 2
' Constants for dmPrintQuality
Private Const DM_PRINTQUALITY = &H400&
Private Const DMRES_DRAFT = (-1)
Private Const DMRES_HIGH = (-4)
Private Const DMRES_LOW = (-2)
Private Const DMRES_MEDIUM = (-3)

'******************************************
'// Constants for dmTTOption //
'******************************************
Private Const DM_TTOPTION = &H4000&
Private Const DMTT_BITMAP = 1
Private Const DMTT_DOWNLOAD = 2
Private Const DMTT_DOWNLOAD_OUTLINE = 4
Private Const DMTT_SUBDEV = 3

'******************************************
'// Constants for dmColor
'******************************************

Private Const DM_COLOR = &H800&
Private Const DMCOLOR_COLOR = 2
Private Const DMCOLOR_MONOCHROME = 1

'******************************************
'// Constants for dmCollate
'******************************************

Private Const DM_COLLATE As Long = &H8000
Private Const DMCOLLATE_FALSE = 0
Private Const DMCOLLATE_TRUE = 1

'******************************************
' Constants for dmDuplex
'******************************************
Private Const DM_DUPLEX = &H1000&
Private Const DMDUP_HORIZONTAL = 3
Private Const DMDUP_SIMPLEX = 1
Private Const DMDUP_VERTICAL = 2

'******************************************
' Constants for dmPaperSize
'******************************************

Private Const DM_PAPERSIZE = &H2&
Private Const DM_PAPERWIDTH = &H8&
Private Const DM_PAPERLENGTH = &H4&
Private Const DMPAPER_10X11 = 45         ' 10 x 11 in
Private Const DMPAPER_10X14 = 16         ' 10x14 in
Private Const DMPAPER_11X17 = 17         ' 11x17 in
Private Const DMPAPER_15X11 = 46         ' 15 x 11 in
Private Const DMPAPER_9X11 = 44         ' 9 x 11 in
Private Const DMPAPER_A_PLUS = 57        ' SuperA/SuperA/A4 227 x 356 mm
Private Const DMPAPER_A2 = 66          ' A2 420 x 594 mm
Private Const DMPAPER_A3 = 8           ' A3 297 x 420 mm
Private Const DMPAPER_A3_EXTRA = 63       ' A3 Extra 322 x 445 mm
Private Const DMPAPER_A3_EXTRA_TRANSVERSE = 68 ' A3 Extra Transverse 322 x 445 mm
Private Const DMPAPER_A3_TRANSVERSE = 67     ' A3 Transverse 297 x 420 mm
Private Const DMPAPER_A4 = 9           ' A4 210 x 297 mm
Private Const DMPAPER_A4_EXTRA = 53       ' A4 Extra 9.27 x 12.69 in
Private Const DMPAPER_A4_PLUS = 60        ' A4 Plus 210 x 330 mm
Private Const DMPAPER_A4_TRANSVERSE = 55     ' A4 Transverse 210 x 297mm
Private Const DMPAPER_A4SMALL = 10        ' A4 Small 210 x 297 mm
Private Const DMPAPER_A5 = 11          ' A5 148 x 210 mm
Private Const DMPAPER_A5_EXTRA = 64       ' A5 Extra 174 x 235 mm
Private Const DMPAPER_A5_TRANSVERSE = 61     ' A5 Transverse 148 x 210mm
Private Const DMPAPER_B_PLUS = 58        ' SuperB/SuperB/A3 305 x487 mm
Private Const DMPAPER_B4 = 12          ' B4 250 x 354
Private Const DMPAPER_B5 = 13          ' B5 182 x 257 mm
Private Const DMPAPER_B5_EXTRA = 65       ' B5 (ISO) Extra 201 x 276mm
Private Const DMPAPER_B5_TRANSVERSE = 62     ' B5 (JIS) Transverse 182x 257 mm
Private Const DMPAPER_CSHEET = 24        ' C size sheet
Private Const DMPAPER_DSHEET = 25        ' D size sheet
Private Const DMPAPER_ENV_10 = 20        ' Envelope #10 4 1/8 x 91/2
Private Const DMPAPER_ENV_11 = 21        ' Envelope #11 4 1/2 x 103/8
Private Const DMPAPER_ENV_12 = 22        ' Envelope #12 4 \276 x 11
Private Const DMPAPER_ENV_14 = 23        ' Envelope #14 5 x 11 1/2
Private Const DMPAPER_ENV_9 = 19         ' Envelope #9 3 7/8 x 87/8
Private Const DMPAPER_ENV_B4 = 33        ' Envelope B4 250 x 353mm
Private Const DMPAPER_ENV_B6 = 35        ' Envelope B6 176 x 125mm
Private Const DMPAPER_ENV_C3 = 29        ' Envelope C3 324 x 458mm
Private Const DMPAPER_ENV_C4 = 30        ' Envelope C4 229 x 324mm
Private Const DMPAPER_ENV_C5 = 28        ' Envelope C5 162 x 229 mm
Private Const DMPAPER_ENV_C6 = 31        ' Envelope C6 114 x 162mm
Private Const DMPAPER_ENV_C65 = 32        ' Envelope C65 114 x 229mm
Private Const DMPAPER_ENV_DL = 27        ' Envelope DL 110 x 220mm
Private Const DMPAPER_ENV_INVITE = 47      ' Envelope Invite 220 x220 mm
Private Const DMPAPER_ENV_ITALY = 36       ' Envelope 110 x 230 mm
Private Const DMPAPER_ENV_MONARCH = 37      ' Envelope Monarch 3.875 x7.5 in
Private Const DMPAPER_ENV_PERSONAL = 38     ' 6 3/4 Envelope 3 5/8 x 6 1/2 in
Private Const DMPAPER_ESHEET = 26        ' E size sheet
Private Const DMPAPER_EXECUTIVE = 7       ' Executive 7 1/4 x 10 1/2in
Private Const DMPAPER_FANFOLD_LGL_GERMAN = 41  ' German Legal Fanfold 8 1/2 x 13 in
Private Const DMPAPER_FANFOLD_STD_GERMAN = 40  ' German Std Fanfold 8 1/2x 12 in
Private Const DMPAPER_FANFOLD_US = 39      ' US Std Fanfold 14 7/8 x11 in
Private Const DMPAPER_FOLIO = 14         ' Folio 8 1/2 x 13 in
Private Const DMPAPER_ISO_B4 = 42        ' B4 (ISO) 250 x 353 mm
Private Const DMPAPER_JAPANESE_POSTCARD = 43   ' Japanese Postcard 100 x148 mm
Private Const DMPAPER_LAST = DMPAPER_FANFOLD_LGL_GERMAN
Private Const DMPAPER_LEDGER = 4         ' Ledger 17 x 11 in
Private Const DMPAPER_LEGAL = 5         ' Legal 8 1/2 x 14 in
Private Const DMPAPER_LEGAL_EXTRA = 51        ' Legal Extra 9 \275 x15 in
Private Const DMPAPER_LETTER = 1
Private Const DMPAPER_FIRST = DMPAPER_LETTER
Private Const DMPAPER_LETTER_EXTRA = 50       ' Letter Extra 9 \275x 12 in
Private Const DMPAPER_LETTER_EXTRA_TRANSVERSE = 56 ' Letter Extra Transverse 9\275 x 12 in
Private Const DMPAPER_LETTER_PLUS = 59      ' Letter Plus 8.5 x 12.69 in
Private Const DMPAPER_LETTER_TRANSVERSE = 54   ' Letter Transverse 8 \275 x 11 in
Private Const DMPAPER_LETTERSMALL = 2      ' Letter Small 8 1/2 x 11in
Private Const DMPAPER_NOTE = 18         ' Note 8 1/2 x 11 in
Private Const DMPAPER_QUARTO = 15        ' Quarto 215 x 275 mm
Private Const DMPAPER_RESERVED_48 = 48      ' RESERVED--DO NOT USE
Private Const DMPAPER_RESERVED_49 = 49      ' RESERVED--DO NOT USE
Private Const DMPAPER_STATEMENT = 6       ' Statement 5 1/2 x 8 1/2in
Private Const DMPAPER_TABLOID = 3        ' Tabloid 11 x 17 in
Private Const DMPAPER_TABLOID_EXTRA = 52       ' Tabloid Extra 11.69x 18 in
Private Const DMPAPER_USER = 256

Private Const DM_COPIES = &H100&
Private Const DM_SCALE = &H10&
Private Const DM_FORMNAME As Long = &H10000

'>> DEVMODE

Private Type DEVMODE
  dmDeviceName(1 To CCHDEVICENAME) As Byte
  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 Integer
  dmPelsWidth As Long
  dmPelsHeight As Long
  dmDisplayFlags As Long
  dmDisplayFrequency As Long
End Type

Private Type PRINTER_INFO_5
   pPrinterName As String
   pPortName As String
   Attributes As Long
   DeviceNotSelectedTimeout As Long
   TransmissionRetryTimeout As Long
End Type

Private Declare Function GetProfileString Lib "kernel32" _
Alias "GetProfileStringA" (ByVal lpAppName As String, _
ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Long) As Long

Private Declare Function WriteProfileString Lib "kernel32" _
Alias "WriteProfileStringA" (ByVal lpszSection As String, _
ByVal lpszKeyName As String, ByVal lpszString As String) As Long

Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
lParam As String) As Long

Private Const HWND_BROADCAST = &HFFFF
Private Const WM_WININICHANGE = &H1A

Private 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

Private Declare Function DeleteForm Lib "winspool.drv" Alias "DeleteFormA" _
(ByVal hPrinter As Long, ByVal pFormName As String) As Long

Private Declare Function OpenPrinter Lib "winspool.drv" Alias _
"OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _
ByVal pDefault As Long) As Long

Private 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

Private Declare Function ClosePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" _
(ByVal lpDriverName As String, ByVal lpDeviceName As String, _
ByVal lpOutput As Long, ByVal lpInitData As Long) As Long

Private Declare Function DeleteDC Lib "gdi32" _
(ByVal hdc As Long) As Long

Private Declare Function ResetDC Lib "gdi32" Alias "ResetDCA" _
  (ByVal hdc As Long, lpInitData As Any) As Long

Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long

Private Declare Function LstrCpy Lib "kernel32" Alias "lstrcpyA" _
  (ByVal lpString1 As String, ByRef lpString2 As Long) As Long

Private Type PRINTER_DEFAULTS
      pDatatype As Long ' String
      pDevMode As Long
      pDesiredAccess As Long
End Type

Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const PRINTER_ACCESS_ADMINISTER = &H4
Private Const PRINTER_ACCESS_USE = &H8
Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
  PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)

' constant that goes into PRINTER_INFO_5 Attributes member
' to set it as default
Private Const PRINTER_ATTRIBUTE_DEFAULT = 4

Private Declare Function OpenPrinterA Lib "winspool.drv" _
(ByVal pPrinterName As String, phPrinter As Long, _
pDefault As PRINTER_DEFAULTS) As Long

Private Declare Function SetPrinter2 Lib "winspool.drv" _
Alias "SetPrinterA" (ByVal hPrinter As Long, _
ByVal Level As Long, pPrinter As Any, _
ByVal Command As Long) As Long

Private Declare Function GetPrinter Lib "winspool.drv" _
Alias "GetPrinterA" (ByVal hPrinter As Long, _
ByVal Level As Long, pPrinter As Any, _
ByVal cbBuf As Long, pcbNeeded As Long) As Long

Private Declare Function PrinterProperties Lib "winspool.drv" _
  (ByVal hwnd As Long, ByVal hPrinter As Long) As Long

Private Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hdc As Long, ByVal nIndex As Long) As Long

Private Const TEXTCAPS = 34     ' Text capabilities
Private Const CURVECAPS = 28     ' Curve capabilities
Private Const LINECAPS = 30     ' Line capabilities
Private Const POLYGONALCAPS = 32   ' Polygonal capabilities
Private Const RASTERCAPS = 38    ' Bitblt capabilities
Private Const CLIPCAPS = 36     ' Clipping capabilities

Private Const DRIVERVERSION = 0   ' Device driver version
Private Const TECHNOLOGY = 2     ' Device classification
Private Const HORZSIZE = 4      ' Horizontal size in millimeters
Private Const VERTSIZE = 6      ' Vertical size in millimeters
Private Const HORZRES = 8      ' Horizontal width in pixels
Private Const VERTRES = 10      ' Vertical width in pixels
Private Const LOGPIXELSX = 88    ' Logical pixels/inch in X
Private Const LOGPIXELSY = 90    ' Logical pixels/inch in Y
Private Const ASPECTX = 40      ' Length of the X leg
Private Const ASPECTY = 42      ' Length of the Y leg
Private Const ASPECTXY = 44     ' Length of the hypotenuse
Private Const PDEVICESIZE = 26    ' Size required for device descriptor
Private Const CP_REGION = 2       '
Private Const CP_RECTANGLE = 1      ' Output clipped to rects
Private Const CP_NONE = 0        ' No clipping of output
Private Const PHYSICALWIDTH = 110 ' Physical Width in device units
Private Const PHYSICALOFFSETY = 113 ' Physical Printable Area y margin
Private Const PHYSICALOFFSETX = 112 ' Physical Printable Area x margin
Private Const PHYSICALHEIGHT = 111 ' Physical Height in device units
Private Const SCALINGFACTORX = 114 ' Scaling factor x
Private Const SCALINGFACTORY = 115 ' Scaling factor y
Private Const RC_BANDING = 2         ' Device requires banding support
Private Const RC_BIGFONT = &H400         ' supports >64K fonts
Private Const RC_BITBLT = 1         ' Can do standard BLT.
Private Const RC_BITMAP64 = 8        ' Device can support >64K bitmap
Private Const RC_DEVBITS = &H8000
Private Const RC_DIBTODEV = &H200        ' supports DIBitsToDevice
Private Const RC_FLOODFILL = &H1000       ' supports FloodFill
Private Const RC_NONE = 0
Private Const RC_SCALING = 4         ' Device requires scaling support
Private Const RC_SAVEBITMAP = &H40
Private Const RC_PALETTE = &H100         ' supports a palette
Private Const RC_STRETCHBLT = &H800       ' supports StretchBlt
Private Const RC_STRETCHDIB = &H2000       ' supports StretchDIBits
Private Const TC_CP_STROKE = &H4         ' Can do ClipPrecision STROKE
Private Const TC_CR_90 = &H8           ' Can do CharRotAbility 90
Private Const TC_CR_ANY = &H10          ' Can do CharRotAbility ANY
Private Const TC_EA_DOUBLE = &H200        ' Can do EmboldenAbility DOUBLE
Private Const TC_GP_TRAP = 2
Private Const TC_HARDERR = 1
Private Const TC_NORMAL = 0
Private Const TC_IA_ABLE = &H400         ' Can do ItalisizeAbility ABLE
Private Const TC_OP_CHARACTER = &H1       ' Can do OutputPrecision Character
Private Const TC_OP_STROKE = &H2         ' Can do OutputPrecision STROKE
Private Const TC_RA_ABLE = &H2000        ' Can do RasterFontAble ABLE
Private Const TC_RESERVED = &H8000
Private Const TC_SA_CONTIN = &H100        ' Can do ScaleAbility CONTINUOUS
Private Const TC_SA_DOUBLE = &H40        ' Can do ScaleAbility DOUBLE
Private Const TC_SA_INTEGER = &H80        ' Can do ScaleAbility INTEGER
Private Const TC_SCROLLBLT = &H10000       ' do text scroll with blt
Private Const TC_SF_X_YINDEP = &H20       ' Can do ScaleFreedom X_YINDEPENDENT
Private Const TC_SIGNAL = 3
Private Const TC_SO_ABLE = &H1000        ' Can do StrikeOutAbility ABLE
Private Const TC_UA_ABLE = &H800         ' Can do UnderlineAbility ABLE
Private Const TC_VA_ABLE = &H4000        ' Can do VectorFontAble ABLE

Private Const DT_PLOTTER = 0       ' Vector plotter
Private Const DT_RASCAMERA = 3      ' Raster camera
Private Const DT_RASDISPLAY = 1     ' Raster display
Private Const DT_RASPRINTER = 2     ' Raster printer
Private Const DT_CHARSTREAM = 4     ' Character-stream, PLP
Private Const DT_DISPFILE = 6      ' Display-file
Private Const DT_METAFILE = 5      ' Metafile, VDM

Private Declare Function DeviceCapabilities Lib "winspool.drv" _
  Alias "DeviceCapabilitiesA" (ByVal lpDeviceName As String, _
  ByVal lpPort As String, ByVal iIndex As Long, ByVal lpOutput As String, _
  ByVal lpDevMode As Long) As Long

Private Declare Function DeviceCapabilities2 Lib "winspool.drv" _
  Alias "DeviceCapabilitiesA" (ByVal lpDeviceName As String, _
  ByVal lpPort As String, ByVal iIndex As Long, ptOutput As Any, _
  ByVal lpDevMode As Long) As Long

Private Const DC_FIELDS = 1
Private Const DC_PAPERS = 2
Private Const DC_PAPERSIZE = 3
Private Const DC_MINEXTENT = 4
Private Const DC_MAXEXTENT = 5
Private Const DC_BINS = 6
Private Const DC_DUPLEX = 7
Private Const DC_SIZE = 8
Private Const DC_EXTRA = 9
Private Const DC_VERSION = 10
Private Const DC_DRIVER = 11
Private Const DC_BINNAMES = 12
Private Const DC_ENUMRESOLUTIONS = 13
Private Const DC_FILEDEPENDENCIES = 14
Private Const DC_TRUETYPE = 15
Private Const DC_PAPERNAMES = 16
Private Const DC_ORIENTATION = 17
Private Const DC_COPIES = 18
Private Const DCTT_BITMAP = &H1&
Private Const DCTT_DOWNLOAD = &H2&
Private Const DCTT_SUBDEV = &H4&

Private Type RECTL
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type SIZEL
    cX As Long
    cY As Long
End Type

' The two definitions for FORM_INFO_1 make the coding easier.
Private Type FORM_INFO_1
    Flags As Long
    pName As Long ' String
    Size As SIZEL
    ImageableArea As RECTL
End Type

Private Type sFORM_INFO_1
    Flags As Long
    pName As String
    Size As SIZEL
    ImageableArea As RECTL
End Type

'// CUSTOM //

Private Const TLNotSupported As Long = -1

Public Enum TLPrinterPrintQuality
  TLDraft = -1
  TLHigh = -4
  TLLow = -2
  TLMedium = -3
End Enum

Public Enum TLPrinterOrientation
  TLOrientUndefined = 0
  TLPortrait = 1
  TLLandscape = 2
End Enum

Public Enum TLPrinterColor
  TLFullColor = 2
  TLMonochrome = 1
End Enum

Public Enum TLPrinterTTOption
  TLTTBitmap = 1
  TLTTDownLoad = 2
  TLTTDownLoadOutline = 4
  TLTTSubDev = 3
End Enum

Public Enum TLPrinterCollate
  TLCollateFalse = 0
  TLCollateTrue = 1
  'Also, TLNotSupported=-1
End Enum

Public Enum TLPrinterDuplex
  TLDuplexSimple = 1
  TLDuplexHorizontal = 2
  TLDuplexVertical = 1
  'Also, TLNotSupported=-1
End Enum

Public Enum TLPrinterPaperSize
  TLLetter = 1
  TLLetterSmall = 2
  TLTabloid = 3
  TLLedger = 4
  TLLegal = 5
  TLStatement = 6
  TLExecutive = 7
  TLA3 = 8
  TLA4 = 9
  TLA4Small = 10
  TLA5 = 11
  TLB4 = 12
  TLB5 = 13
  TLFolio = 14
  TLQuarto = 15
  TL10x14 = 16
  TL11X17 = 17
  TLNote = 18
  TLEnv9 = 19
  TLEnv10 = 20
  TLEnv11 = 21
  TLEnv12 = 22
  TLEnv14 = 23
  TLCSheet = 24
  TLDSheet = 25
  TLESheet = 26
  TLEnvDl = 27
  TLEnvC5 = 28
  TLEnvC3 = 29
  TLEnvC4 = 30
  TLEnvC6 = 31
  TLEnvC65 = 32
  TLEnvB4 = 33
  TLEnvB5 = 34
  TLEnvB6 = 35
  TLEnvItaly = 36
  TLEnvMonarch = 37
  TLEnvPersonal = 38
  TLFanfoldUS = 39
  TLFanfoldStdGerman = 40
  TLFanfoldLglGerman = 41
  TLISOB4 = 42
  TLJapanesePostcard = 43
  TL9X11 = 44
  TL10X11 = 45
  TL15X11 = 46
  TLEnvInvite = 47
  TLReserved48 = 48
  TLReserved49 = 49
  TLLetterExtra = 50
  TLLegalExtra = 51
  TLTabloidExtra = 52
  TLA4Extra = 53
  TLLetterTransverse = 54
  TLA4Transverse = 55
  TLLetterExtraTransverse = 56
  TLAPlus = 57
  TLBPlus = 58
  TLLetterPlus = 59
  TLA4Plus = 60
  TLA5Transverse = 61
  TLB5Transverse = 62
  TLA3Extra = 63
  TLA5Extra = 64
  TLB5Extra = 65
  TLA2 = 66
  TLA3Transverse = 67
  TLA3ExtraTransverse = 68
  TLUser = 256
End Enum

Public Enum TLPrinterCapability
  TLIsPlotter
  TLIsRasterPrinter
  TLIsRasterCamera
  TLIsRasterDisplay
  TLIsCharacterStream
  TLIsDiplayFile
  TLIsMetafile
  TLBitBltSupported
  TLSetDIBitsToDeviceSupported
  TLStretchBltSupported
  TLStretchDIBSupported
  TLFloodFillSupported
  TLBigBitmapSupported
  TLBigFontSupported
  TLRasterFontSupported
  TLVectorFontSupported
  TLBoldFontSupported
  TLItalicFontSupported
  TLUnderlineFontSupported
  TLStrikeoutFontSupported
  TLClipToRectangleSupported
  TLClipToRegionSupported
  TLCharacterRotationSupported
  TLCharacter90DegreesRotationSupported
End Enum

Private mPhysicalWidth As Long
Private mPhysicalHeight As Long
Private mHorzRes As Long
Private mVertRes As Long
Private mLogPixelsX As Long
Private mLogPixelsY As Long
Private mPhysicalOffsetX As Long
Private mPhysicalOffsetY As Long
Private mPageWidth As Single
Private mPageHeight As Single
Private mAvailWidth As Single
Private mAvailHeight As Single
Private mLeftGap As Single
Private mTopGap As Single
Private mRightGap As Single
Private mBottomGap As Single
Private mPrinterPixPerMMX As Single
Private mPrinterPixPerMMY As Single
Private mPrinterPixPerMM As Single

Private Const mMMPerInch As Single = 25.4

Private mhDCPrinter As Long      'handle to printer's DC (private)
Private mhPrinter As Long       'handle to printer's DC (private)

Private mPrinterDeviceName As String  'printer's name
Private mPrinterDriverName As String  'printer driver's name
Private mPrinterPort As String     'printer's port
Private mDEVMODE As DEVMODE       'devmode structure
Private mDEVMODESIZE As Long      'devmode size

Public Function IsWin9X() As Boolean
On Error GoTo Er
  Dim oSinfo As OSVERSIONINFO
  Dim dl As Integer

  IsWin9X = False

  oSinfo.dwOSVersionInfoSize = 148
  oSinfo.szCSDVersion = Space$(128)

  dl = GetVersionExA(oSinfo)

  If oSinfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then IsWin9X = True

Er:
End Function

Private Function StripNulls(OriginalStr As String) As String
On Error Resume Next
  If (InStr(OriginalStr, Chr$(0)) > 0) Then
    OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr$(0)) - 1)
  End If
  StripNulls = Trim$(OriginalStr)
End Function

Private Function ByteToString(ByteArray() As Byte) As String
On Error Resume Next
  Dim TempStr As String
  Dim I As Integer

  For I = 1 To CCHDEVICENAME
    TempStr = TempStr & Chr$(ByteArray(I))
  Next I
  ByteToString = StripNulls(TempStr)
End Function

Private Function PtrCtoVbString(ByVal Add As Long) As String
Dim sTemp As String * 512, X As Long
On Error Resume Next
  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

Private Function CreatePrinterDC(sPrinterName As String) As Long
On Error GoTo Er

  Dim X As Printer
  Dim dl As Long

  CreatePrinterDC = 0

  If mhDCPrinter <> 0 Then dl = DeleteDC(mhDCPrinter)

  For Each X In Printers
    If X.DeviceName = sPrinterName Then
      mhDCPrinter = CreateDC(X.DriverName, X.DeviceName, 0&, 0&)
        If mhDCPrinter <> 0 Then
          'success
          CreatePrinterDC = 1
          'store these values
          mPrinterDeviceName = X.DeviceName
          mPrinterDriverName = X.DriverName
          mPrinterPort = X.Port
          'get DEVMODE
          GetDEVMODE
          'load data
          LoadPrinterData
        End If
      Exit Function
    End If
  Next X

Er:
End Function

Private Sub GetDEVMODE()
On Error Resume Next

  Dim dl As Long
  Dim nSize As Long
  Dim aDevMode() As Byte
  Dim TempStr As String
  Dim hPrinter As Long

  If mhPrinter <> 0 Then
    Call ClosePrinter(mhPrinter)
    dl = DeleteObject(mhPrinter)
    mhPrinter = 0
  End If

  If OpenPrinter(mPrinterDeviceName, mhPrinter, NULLPTR) = 0 Then Exit Sub

  nSize = DocumentProperties(NULLPTR, mhPrinter, mPrinterDeviceName, _
    NULLPTR, NULLPTR, 0)

  If nSize < 1 Then Exit Sub

  ReDim aDevMode(1 To nSize)

  mDEVMODESIZE = nSize

  nSize = DocumentProperties(NULLPTR, mhPrinter, mPrinterDeviceName, _
    aDevMode(1), NULLPTR, DM_OUT_BUFFER)

  If nSize < 0 Then Exit Sub

  Call CopyMemory(mDEVMODE, aDevMode(1), Len(mDEVMODE))

End Sub

Public Function SetPrinterCustomPaperSize(ByVal WidthMM As Single, ByVal HeightMM As Single) As Long
On Error GoTo Er

  Dim dl As Long

  'initialise with failure
  SetPrinterCustomPaperSize = 0
  'first try it as in Win 9x, no matter if you are on Win NT/2000
  dl = PrivateSetPrinterCustomPaperSize(WidthMM, HeightMM, True)
  'success?
  If dl = 0 Or Abs(mPageWidth - WidthMM) > 1 Or Abs(mPageHeight - HeightMM) > 1 Then
    'no, try to change the orientation
    If Me.GetPrinterOrientation = TLPortrait Then
      dl = Me.SetPrinterOrientation(TLLandscape)
    Else
      dl = Me.SetPrinterOrientation(TLPortrait)
    End If
    'not even the orientation?
    If dl = 0 Then Exit Function
    'ok, now try once again
    dl = PrivateSetPrinterCustomPaperSize(WidthMM, HeightMM, True)
    'success?
    If dl = 0 Or Abs(mPageWidth - WidthMM) > 1 Or Abs(mPageHeight - HeightMM) > 1 Then
      'no, see if you are on Win NT/2000
      If Not IsWin9X Then
        'ok, now try once again
        dl = PrivateSetPrinterCustomPaperSize(WidthMM, HeightMM, False)
        'success?
        If dl = 0 Or Abs(mPageWidth - WidthMM) > 1 Or Abs(mPageHeight - HeightMM) > 1 Then
          'no, try to change the orientation
          If Me.GetPrinterOrientation = TLPortrait Then
            dl = Me.SetPrinterOrientation(TLLandscape)
          Else
            dl = Me.SetPrinterOrientation(TLPortrait)
          End If
          'not even the orientation?
          If dl = 0 Then Exit Function
          'ok, now try once again
          dl = PrivateSetPrinterCustomPaperSize(WidthMM, HeightMM, False)
          'success?
          If dl = 0 Or Abs(mPageWidth - WidthMM) > 1 Or Abs(mPageHeight - HeightMM) > 1 Then
            'done everything, it just cannot be done
            Exit Function
          End If
        End If
      End If
    End If
  End If

  'success
  SetPrinterCustomPaperSize = 1
Er:
End Function

Private Function PrivateSetPrinterCustomPaperSize(ByVal WidthMM As Single, ByVal HeightMM As Single, _
  Optional ByVal bWin9X As Boolean = True) As Long
On Error Resume Next

  'initialise with failure
  PrivateSetPrinterCustomPaperSize = 0
  'error?
  If mhDCPrinter = 0 Then Exit Function

If bWin9X Then

  Dim dl As Long
  Dim iA As Long
  Dim aDevMode() As Byte
  Dim nSize As Long
  Dim sCustomWidth As Long
  Dim sCustomHeight As Long

  'Win9x/ME, try this at first even on WinNT/2000

  'is there an error in mDevmode?
  If mDEVMODESIZE < 1 Then Exit Function

  'change
  mDEVMODE.dmFields = mDEVMODE.dmFields And _
    (Not (DM_PAPERSIZE Or DM_PAPERWIDTH Or DM_PAPERLENGTH))
  mDEVMODE.dmPaperSize = DMPAPER_USER
  mDEVMODE.dmPaperWidth = WidthMM * 10
  mDEVMODE.dmPaperLength = HeightMM * 10
  mDEVMODE.dmFields = mDEVMODE.dmFields Or DM_PAPERSIZE _
    Or DM_PAPERLENGTH Or DM_PAPERWIDTH
  'allocate enough space for the byte array
  ReDim aDevMode(1 To mDEVMODESIZE)
  'copy mDevmode to aDevmode
  Call CopyMemory(aDevMode(1), mDEVMODE, Len(mDEVMODE))
  'then update mDEVMODE
  nSize = DocumentProperties(NULLPTR, mhPrinter, mPrinterDeviceName, _
  aDevMode(1), aDevMode(1), DM_IN_BUFFER Or DM_OUT_BUFFER)
  'reset printer's hDC
  nSize = ResetDC(mhDCPrinter, aDevMode(1))
  'success?
  If nSize = 0 Then Exit Function
  'update mDEVMODE
  Call CopyMemory(mDEVMODE, aDevMode(1), Len(mDEVMODE))
  'check h mhDCPrinter has changed
  If nSize <> mhDCPrinter Then
    dl = DeleteDC(mhDCPrinter)
    mhDCPrinter = nSize
  End If
  'update data
  LoadPrinterData

  'success
  PrivateSetPrinterCustomPaperSize = 1

Else

  'NT/2000

  Dim NumForms As Long
  Dim FI1 As FORM_INFO_1
  Dim FI2 As sFORM_INFO_1
  Dim aFI1() As FORM_INFO_1      ' Working FI1 array
  Dim Temp() As Byte         ' Temp FI1 array
  Dim aByte() As Byte
  Dim BytesNeeded As Long
  Dim FormName As String

  'is there an error in mDevmode?
  If mDEVMODESIZE < 1 Then Exit Function

  'does this form exist? If yes, delete it
  dl = EnumForms(mhPrinter, 1, 0&, 0&, BytesNeeded, _
       NumForms)
  ReDim Temp(BytesNeeded)
  ReDim aFI1(BytesNeeded / Len(FI1))
  dl = EnumForms(mhPrinter, 1, Temp(0), BytesNeeded, _
       BytesNeeded, NumForms)
  Call CopyMemory(aFI1(0), Temp(0), BytesNeeded)
  For iA = 0 To NumForms - 1
    With aFI1(iA)
      FormName = PtrCtoVbString(.pName)
      If sCustomFormTitle = FormName Then
        dl = DeleteForm(mhPrinter, sCustomFormTitle & Chr$(0))
        Exit For
      End If
    End With
  Next iA

  'now create the new form
  With FI2
    .Flags = 0
    .pName = sCustomFormTitle
    With .Size
      .cX = CLng(WidthMM * 1000)
      .cY = CLng(HeightMM * 1000)
    End With
    With .ImageableArea
      .Left = 0
      .Top = 0
      .Right = FI2.Size.cX
      .Bottom = FI2.Size.cY
    End With
  End With

  ReDim aByte(1 To Len(FI2))
  Call CopyMemory(aByte(1), FI2, Len(FI2))

  dl = AddForm(mhPrinter, 1, aByte(1))

  If dl = 0 Then Exit Function

  'and use the new form
  'change the appropriate member in the DevMode.
  'in this case, you want to change the form name.
  mDEVMODE.dmFormName = sCustomFormTitle & Chr$(0) ' Must be NULL terminated!
  'set the dmFields bit flag to indicate what you are changing.
  mDEVMODE.dmFields = mDEVMODE.dmFields Or DM_FORMNAME
  'allocate enough space for the byte array
  ReDim aDevMode(1 To mDEVMODESIZE)
  'copy mDevmode to aDevmode
  Call CopyMemory(aDevMode(1), mDEVMODE, Len(mDEVMODE))
  'then update mDEVMODE
  dl = DocumentProperties(NULLPTR, mhPrinter, mPrinterDeviceName, _
  aDevMode(1), aDevMode(1), DM_IN_BUFFER Or DM_OUT_BUFFER)
  'reset printer's hDC
  dl = ResetDC(mhDCPrinter, aDevMode(1))
  'success?
  If dl = 0 Then Exit Function
  'update mDEVMODE
  Call CopyMemory(mDEVMODE, aDevMode(1), Len(mDEVMODE))
  'check h mhDCPrinter has changed
  If dl <> mhDCPrinter Then
    nSize = DeleteDC(mhDCPrinter)
    mhDCPrinter = dl
  End If
  'update data
  LoadPrinterData

  'success
  PrivateSetPrinterCustomPaperSize = 1

End If

End Function

Public Function SetPrinterOrientation(gOrientation As TLPrinterOrientation) As Long

On Error Resume Next

  Dim dl As Long
  Dim nSize As Long
  Dim aDevMode() As Byte
  'initialise with failure
  SetPrinterOrientation = 0
  'error?
  If mhDCPrinter = 0 Then Exit Function
  'any need to change?
  If gOrientation = mDEVMODE.dmOrientation Then
    SetPrinterOrientation = 1
    Exit Function
  End If

  'is there an error in mDevmode?
  If mDEVMODESIZE < 1 Then Exit Function

  'change
  mDEVMODE.dmOrientation = gOrientation
  mDEVMODE.dmFields = mDEVMODE.dmFields Or DM_ORIENTATION

  'allocate enough space for the byte array
  ReDim aDevMode(1 To mDEVMODESIZE)

  'copy mDevmode to aDevmode
  Call CopyMemory(aDevMode(1), mDEVMODE, Len(mDEVMODE))

  'then update mDEVMODE
  nSize = DocumentProperties(NULLPTR, mhPrinter, mPrinterDeviceName, _
  aDevMode(1), aDevMode(1), DM_IN_BUFFER Or DM_OUT_BUFFER)

  'reset printer's hDC
  nSize = ResetDC(mhDCPrinter, aDevMode(1))

  'success?
  If nSize = 0 Then Exit Function

  'update mDEVMODE
  Call CopyMemory(mDEVMODE, aDevMode(1), Len(mDEVMODE))

  'check h mhDCPrinter has changed
  If nSize <> mhDCPrinter Then
    dl = DeleteDC(mhDCPrinter)
    mhDCPrinter = nSize
  End If

  'update data
  LoadPrinterData

  'success
  SetPrinterOrientation = 1

End Function

Private Function LoadPrinterData() As Long
On Error GoTo myExit

  Dim dl As Long

  LoadPrinterData = 0

  If mhDCPrinter = 0 Then GoTo myExit

  mPhysicalWidth = GetDeviceCaps(mhDCPrinter, PHYSICALWIDTH)   'page width in pix
  mPhysicalHeight = GetDeviceCaps(mhDCPrinter, PHYSICALHEIGHT)  'page height in pix

  mHorzRes = GetDeviceCaps(mhDCPrinter, HORZRES)
'available width in pix
  mVertRes = GetDeviceCaps(mhDCPrinter, VERTRES)
'available height in pix

  mLogPixelsX = GetDeviceCaps(mhDCPrinter, LOGPIXELSX)      'pix per inch (horizontal)
  mLogPixelsY = GetDeviceCaps(mhDCPrinter, LOGPIXELSY)      'pix per inch (vertical)

  mPhysicalOffsetX = GetDeviceCaps(mhDCPrinter, PHYSICALOFFSETX) 'left unprintable area in pix
  mPhysicalOffsetY = GetDeviceCaps(mhDCPrinter, PHYSICALOFFSETY) 'top unprintable area in pix

'calculate the corresponding values in mm:

  mPageWidth = mPhysicalWidth / mLogPixelsX * mMMPerInch
  mPageHeight = mPhysicalHeight / mLogPixelsX * mMMPerInch
  mAvailWidth = mHorzRes / mLogPixelsX * mMMPerInch
  mAvailHeight = mVertRes / mLogPixelsY * mMMPerInch

  mLeftGap = mPhysicalOffsetX / mLogPixelsX * mMMPerInch
  mTopGap = mPhysicalOffsetY / mLogPixelsY * mMMPerInch
  mRightGap = mPageWidth - mAvailWidth - mLeftGap
  mBottomGap = mPageHeight - mAvailHeight - mTopGap

  If mAvailWidth > mPageWidth Or mAvailHeight > mPageHeight Or _
    mAvailWidth <= 0 Or mAvailHeight <= 0 Or _
    mLeftGap < 0 Or mRightGap < 0 Or mTopGap < 0 Or mBottomGap < 0 Or _
    Abs((mAvailWidth + mLeftGap + mRightGap) - mPageWidth) > 1 Or _
    Abs((mAvailHeight + mTopGap + mBottomGap) - mPageHeight) > 1 Then
    'something's wrong, we got to fix the values manually
    'this will probably happen when defining custom paper size
    mAvailWidth = mPageWidth
    mAvailHeight = mPageHeight
    mLeftGap = 0
    mRightGap = 0
    mTopGap = 0
    mBottomGap = 0
  End If

'finally, the resolution variables:

  mPrinterPixPerMMX = mLogPixelsX / mMMPerInch
  mPrinterPixPerMMY = mLogPixelsY / mMMPerInch
  mPrinterPixPerMM = (mPrinterPixPerMMX + mPrinterPixPerMMY) / 2

LoadPrinterData = 1
Exit Function

myExit:
'things went wrong. We 've got to initialise somehow
  mLogPixelsX = 300
  mLogPixelsY = 300
  mPhysicalOffsetX = 0
  mPhysicalOffsetY = 0

  mLeftGap = 20
  mRightGap = 20
  mTopGap = 20
  mBottomGap = 20

  mPageWidth = 210
  mPageHeight = 297
  mAvailWidth = mPageWidth - 40
  mAvailHeight = mPageHeight - 40

  mPrinterPixPerMMX = mLogPixelsX / mMMPerInch
  mPrinterPixPerMMY = mLogPixelsY / mMMPerInch
  mPrinterPixPerMM = (mPrinterPixPerMMX + mPrinterPixPerMMY) / 2
End Function

Function GetPrinterOrientation() As TLPrinterOrientation
  ' NOTE: This function returns what you would see if you clicked Start, Printer Settings, and clicked properties for the default printer.
  ' If the user has changed the printer settings in Notes, those changes will not be reflected by this function.

  ' Returns string value indicating Printer Orientation ("Landscape" or "Portrait")

  Dim bufsize, res As Long
  Dim dmIn As DEVMODE, dmOut As DEVMODE
  Dim dm As DEVMODE
  Dim DeviceName As String


  If mhDCPrinter = 0 Then
    MsgBox "Unable to open default printer"
    Exit Function
  End If


  bufsize = DocumentProperties(hwnd, mhPrinter, mPrinterDeviceName, dm, dm, 0)

  res = DocumentProperties(0, mhPrinter, mPrinterDeviceName, dmOut, dm, DM_OUT_BUFFER)
  If dmOut.dmOrientation = DMORIENT_LANDSCAPE Then
    GetPrinterOrientation = TLLandscape
  Else
    GetPrinterOrientation = TLPortrait
  End If

End Function

'
'Public Function GetPrinterOrientation( _
'   DeviceName As String, _
'   hdc As Long _
'  ) As TLPrinterOrientation
'
'  Dim hPrinter  As Long
'  Dim nSize    As Long
'  Dim pDevMode  As DEVMODE
'  Dim aDevMode() As Byte
'
'  If OpenPrinter(DeviceName, hPrinter, NULLPTR) Then
'    nSize = DocumentProperties( _
    '        NULLPTR, hPrinter, DeviceName, NULLPTR, NULLPTR, 0 _
    '        )
'    ReDim aDevMode(1 To nSize)
'    nSize = DocumentProperties( _
    '        NULLPTR, hPrinter, DeviceName, aDevMode(1), NULLPTR, _
    'DM_OUT_BUFFER)
'    Call CopyMemory(pDevMode, aDevMode(1), Len(pDevMode))
'    GetPrinterOrientation = pDevMode.dmOrientation
'    Call ClosePrinter(hPrinter)
'  Else
'    GetPrinterOrientation = OrientUndefined
'  End If
'End Function
'