ResetDC does not work when custom paper size, but returns success

rajah1982

'Print paper related properties
Public Type PaperRegion_sq
    Width As Double 'Print paper width
    Height As Double 'Paper height
    LeftMargin As Double 'Left Margin
    RightMargin As Double 'Right Margin
    TopMargin As Double 'Top Margin
    BottomMargin As Double 'Bottom Margin
    Left As Double
    Right As Double
    Top As Double
    Bottom As Double
End Type

'Set Shaker paper to the specified size, unit: mm
'Shaker paper this FormName should exist, no check here
Public Function UsePaper (pWidth As Double, pHeight As Double, Optional ByRef ErrMsg As String) As Long
    'Tested under WinXP
    Dim aFI1 () As Byte, sFI1 As sFORM_INFO_1, FormName As String
    Dim PrinterName As String, hPrinter As Long
    Dim nSize As Long, pDevMode As DEVMODE, aDevMode () As Byte
    
    PrinterName = Printer.DeviceName
    FormName = "Shaker Paper" 'Select the server properties in the control panel-printer and fax's file menu when testing, add a format called Shaker paper, the size is arbitrary
    With sFI1
        .Flags = 0
        .PName = FormName
        .Size.cx = pWidth * 1000
        .Size.cy = pHeight * 1000
        .ImageableArea.Left = 0
        .ImageableArea.Top = 0
        .ImageableArea.Right = pWidth * 1000
        .ImageableArea.Bottom = pHeight * 1000
    End With
    
    If OpenPrinter (PrinterName, hPrinter, 0&) = 0 Then GoTo ErrHandle
    
    'Modify custom paper
    ReDim aFI1 (Len (sFI1))
    Call CopyMemory (aFI1 (0), sFI1, Len (sFI1))
    If SetForm (hPrinter, FormName, 1, aFI1 (0)) = 0 Then GoTo ErrHandle
    
    'Update Printer
    nSize = DocumentProperties (0, hPrinter, PrinterName, 0&, 0&, 0&)
    ReDim aDevMode (1 To nSize)
    nSize = DocumentProperties (0, hPrinter, PrinterName, aDevMode (1), 0&, DM_OUT_BUFFER)
    Call CopyMemory (pDevMode, aDevMode (1), Len (pDevMode))
    pDevMode.dmFormName = FormName&Chr (0) 'Must end with NULL! !!
    pDevMode.dmFields = DM_FORMNAME 'Set the dmFields flag
    Call CopyMemory (aDevMode (1), pDevMode, Len (pDevMode))
    nSize = DocumentProperties (0, hPrinter, PrinterName, aDevMode (1), aDevMode (1), DM_IN_BUFFER Or DM_OUT_BUFFER)
    nSize = ResetDC (Printer.hDC, aDevMode (1))
    ClosePrinter (hPrinter) 'Close the printer
    Call GetPaperRegion (vbMillimeters) 'Here there is a problem with the value of GetPaperRegion, described later
    UsePaper = -1
    Exit Function
ErrHandle:
    ErrMsg = Err.LastDllError
    Exit Function
End Function

'Return to the default printer preferred paper information
Public Function GetPaperRegion (Optional pScaleMode As ScaleModeConstants = vbPixels) As PaperRegion_sq
    With GetPaperRegion
        .Width = GetDeviceCaps (Printer.hDC, PHYSICALWIDTH)
        .Height = GetDeviceCaps (Printer.hDC, PHYSICALHEIGHT)
        .LeftMargin = GetDeviceCaps (Printer.hDC, PHYSICALOFFSETX)
        .TopMargin = GetDeviceCaps (Printer.hDC, PHYSICALOFFSETY)
        .RightMargin = GetDeviceCaps (Printer.hDC, PHYSICALWIDTH)-GetDeviceCaps (Printer.hDC, HORZRES)-GetDeviceCaps (Printer.hDC, PHYSICALOFFSETX)
        .BottomMargin = GetDeviceCaps (Printer.hDC, PHYSICALHEIGHT)-GetDeviceCaps (Printer.hDC, VERTRES)-GetDeviceCaps (Printer.hDC, PHYSICALOFFSETY)
        .Left = 0
        .Top = 0
        .Right = .LeftMargin + GetDeviceCaps (Printer.hDC, HORZRES)
        .Bottom = .TopMargin + GetDeviceCaps (Printer.hDC, VERTRES)
    End With
    
    If pScaleMode = vbPixels Then Exit Function
    
    Dim x As Double, y As Double
    'First convert to inches and then to other units
    x = GetDeviceCaps (Printer.hDC, LOGPIXELSX): y = GetDeviceCaps (Printer.hDC, LOGPIXELSY)
    With GetPaperRegion
        .Width = .Width / x
        .Height = .Height / y
        .LeftMargin = .LeftMargin / x
        .TopMargin = .TopMargin / y
        .RightMargin = .RightMargin / x
        .BottomMargin = .BottomMargin / y
        .Right = .Right / x
        .Bottom = .Bottom / y
    End With
    If pScaleMode = vbInches Then Exit Function
    
    With GetPaperRegion
        .Width = Printer.ScaleX (.Width, vbInches, pScaleMode)
        .Height = Printer.ScaleY (.Height, vbInches, pScaleMode)
        .LeftMargin = Printer.ScaleX (.LeftMargin, vbInches, pScaleMode)
        .TopMargin = Printer.ScaleY (.TopMargin, vbInches, pScaleMode)
        .RightMargin = Printer.ScaleX (.RightMargin, vbInches, pScaleMode)
        .BottomMargin = Printer.ScaleY (.BottomMargin, vbInches, pScaleMode)
        .Right = Printer.ScaleX (.Right, vbInches, pScaleMode)
        .Bottom = Printer.ScaleY (.Bottom, vbInches, pScaleMode)
    End With
End Function

After performing ResetDC in UsePaper, observe the width and height through the GetPaperRegion function, and found that it can be customized for LQ1600K and not for Lenovo laser printer Lj2500, but the correct DC value is returned.

When exiting UsePaper, observe the width and height through the GetPaperRegion function, and find that it has become the default paper size again. Without exiting the process, observe the printing preferences of the LQ1600K and find that the default printing paper has not changed at all.

rajah1982

Just found a problem, after calling UsePaper, if you set the paper direction again, it will restore the default paper size