Option Explicit
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
' Constants for nIndex argument of GetDeviceCaps
Private Const HORZRES = 8
Private Const VERTRES = 10
Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Private Const PHYSICALWIDTH = 110
Private Const PHYSICALHEIGHT = 111
Private Const PHYSICALOFFSETX = 112
Private Const PHYSICALOFFSETY = 113
.
.
.
Public Sub PrintArea(p As Printer, lngdpiX As Long, lngdpiY As Long, lngMarginLeft As Long, lngMarginRight As Long _
, lngMarginTop As Long, lngMarginBottom As Long, lngPrintAreaHorz As Long, lngPrintAreaVert As Long _
, lngPhysHeight As Long, lngPhysWidth As Long)
Debug.Print " PrintArea"
On Error GoTo Error_Handler
Begin:
lngdpiX = GetDeviceCaps(p.hdc, LOGPIXELSX)
lngdpiY = GetDeviceCaps(p.hdc, LOGPIXELSY)
lngMarginLeft = GetDeviceCaps(p.hdc, PHYSICALOFFSETX)
lngMarginTop = GetDeviceCaps(p.hdc, PHYSICALOFFSETY)
lngPrintAreaHorz = GetDeviceCaps(p.hdc, HORZRES)
lngPrintAreaVert = GetDeviceCaps(p.hdc, VERTRES)
lngPhysWidth = GetDeviceCaps(p.hdc, PHYSICALWIDTH)
lngMarginRight = lngPhysWidth - lngPrintAreaHorz - lngMarginLeft
lngPhysHeight = GetDeviceCaps(p.hdc, PHYSICALHEIGHT)
lngMarginBottom = lngPhysHeight - lngPrintAreaVert - lngMarginTop
Rtn_Caller:
Exit Sub
Error_Handler:
Call Fatal_Error(Err.Number, Err.Source, Err.Description, "PrintArea")
Resume Rtn_Caller
End Sub
.
.
.
Public Function ScreenResolution(Optional booPrinter As Boolean) As String
Dim i As Long, j As Long, k As Long, x As Long, y As Long, z As Long
Dim s1 As String, s2 As String, s3 As String, s4 As String, s5 As String
Dim lngdpiX As Long, lngdpiY As Long, lngMarginLeft As Long, lngMarginRight As Long
Dim lngMarginTop As Long, lngMarginBottom As Long, lngPrintAreaHorz As Long, lngPrintAreaVert As Long
Dim lngPhysHeight As Long, lngPhysWidth As Long
Dim strInfo As String
Debug.Print " ScreenResolution"
On Error GoTo Error_Handler
Begin:
i = Screen.Width
j = Screen.TwipsPerPixelX
k = i \ j
x = Screen.Height
y = Screen.TwipsPerPixelY
z = x \ y
'iWidth = Screen.Width \ Screen.TwipsPerPixelX
'iHeight = Screen.Height \ Screen.TwipsPerPixelY
s1 = CStr(k) & " x " & CStr(z) & " (" & CStr(i) & " @" & CStr(j) & " X " & CStr(x) & " @" & y & ")"
ScreenResolution = s1
If booPrinter Then
s1 = s1 & vbCrLf & vbCrLf & "Printer Devicename: " & Printer.DeviceName
Call PrintArea(Printer, lngdpiX, lngdpiY, lngMarginLeft, lngMarginRight, lngMarginTop, lngMarginBottom _
, lngPrintAreaHorz, lngPrintAreaVert, lngPhysHeight, lngPhysWidth)
strInfo = "Pixels X: " & CStr(lngdpiX) & " dpi"
strInfo = strInfo & vbCrLf & "Pixels Y: " & CStr(lngdpiY) & " dpi"
strInfo = strInfo & vbCrLf & "Unprintable space on left: " & _
CStr(lngMarginLeft) & " pixels = " & CStr(lngMarginLeft / lngdpiX) & " inches"
strInfo = strInfo & vbCrLf & "Unprintable space on top: " & _
CStr(lngMarginTop) & " pixels = " & CStr(lngMarginTop / lngdpiY) & " inches"
strInfo = strInfo & vbCrLf & "Printable space (Horizontal): " & _
CStr(lngPrintAreaHorz) & " pixels = " & CStr(lngPrintAreaHorz / lngdpiX) & " inches"
strInfo = strInfo & vbCrLf & "Printable space (Vertical): " & _
CStr(lngPrintAreaVert) & " pixels = " & CStr(lngPrintAreaVert / lngdpiY) & " inches"
strInfo = strInfo & vbCrLf & "Total space (Horizontal): " & _
CStr(lngPhysWidth) & " pixels = " & CStr(lngPhysWidth / lngdpiX) & " inches"
strInfo = strInfo & vbCrLf & "Unprintable space on right: " & _
CStr(lngMarginRight) & " pixels = " & CStr(lngMarginRight / lngdpiX) & " inches"
strInfo = strInfo & vbCrLf & "Total space (Vertical): " & _
CStr(lngPhysHeight) & " pixels = " & CStr(lngPhysHeight / lngdpiY) & " inches"
strInfo = strInfo & vbCrLf & "Unprintable space on bottom: " & _
CStr(lngMarginBottom) & " pixels = " & CStr(lngMarginBottom / lngdpiY) & " inches"
s1 = s1 & vbCrLf & vbCrLf & strInfo
ScreenResolution = s1
End If
Rtn_Caller:
Exit Function
Error_Handler:
' Call Fatal_Error(Err.Number, Err.Source, Err.Description, "ScreenResolution")
Resume Rtn_Caller
End Function