|
Gewöhnlich können Sie die aktuelle Bildschirmgröße in der Maßeinheit TWIPS aus den Eigenschaften Width und Height des Screen-Objekts auslesen.
Breite = Screen.Width
Höhe = Screen.Height
Auch die aktuelle Bildschirmauflösung ("Große/Kleine Bildschirmschriften") in der Maßeinheit "dpi" können Sie ermitteln:
dpiX = 1440 / Screen.TwipsPerPixelX
dpiY = 1440 / Screen.TwipsPerPixelY
Allerdings kann es hin und wieder vorkommen, dass nach einer Änderung der Bildschirmgröße oder -auflösung durch den Anwender nicht mehr zuverlässig die aktuellen, korrekten Werte wiedergegeben werden. Vermutlich liegt dies an kleinen Unsauberkeiten im Zusammenspiel von manchem Bildschirmtreiber mit Visual Basic.
Die korrekten aktuellen Werte liefert dagegen immer die API-Funktion GetDeviceCaps. Sie wird für den Gerätekontext (DC) eines bestimmten Geräts aufgerufen, etwa eines Druckers oder eben des Bildschirms. Den Gerätekontext des Bildschirms erhalten Sie über die API-Funktion GetDC, der Sie als Fenster-Handle für den ganzen Bildschirm den Wert 0 übergeben. Nach der Verwendung des Gerätekontextes müssen Sie daran denken, ihn wieder mit der API-Funktion ReleaseDC freizugeben.
Neben dem Gerätekontext übergeben Sie der Funktion GetDeviceCaps einen Index, zu dem Sie den gewünschten Wert erhalten wollen. Zum Beispiel die Bildschirmhöhe und die Bildschirmbreite liefern auf diese Weise die beiden folgenden Hilfsfunktionen ScreenHeightPixels und ScreenWidthPixels:
Private Declare Function GetDC Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
(ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Const HORZRES = 8
Private Const VERTRES = 10
Public Property Get ScreenHeightPixels() As Long
Dim nDC As Long
nDC = GetDC(0)
ScreenHeightPixels = GetDeviceCaps(nDC, VERTRES)
ReleaseDC 0, nDC
End Property
Public Property Get ScreenWidthPixels() As Long
Dim nDC As Long
nDC = GetDC(0)
ScreenWidthPixels = GetDeviceCaps(nDC, HORZRES)
ReleaseDC 0, nDC
End Property
Da von dem erwähnten Fehler auch die Eigenschaften Screen.TwipsPerPixelX und Screen.TwipsPerPixelY betroffen sein können, brauchen wir auch hierfür Ersatzfunktionen auf der Basis von GetDeviceCaps. Im Gegensatz zum Screen-Objekt liefert uns GetDeviceCaps direkt die vertikale und die horizontale Bildschirmauflösung:
Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Public Property Get dpiX() As Long
Dim nDC As Long
nDC = GetDC(0)
dpiX = GetDeviceCaps(nDC, LOGPIXELSX)
ReleaseDC 0, nDC
End Property
Public Property Get dpiY() As Long
Dim nDC As Long
nDC = GetDC(0)
dpiY = GetDeviceCaps(nDC, LOGPIXELSY)
ReleaseDC 0, nDC
End Property
Aus Bildschirmgröße in Pixels und aus Bildschirmauflösung in dpi ergeben sich die Alternativ-Werte für TwipsPerPixelX und TwipsPerPixelY und schließlich ebenso die Bildschirmauflösung in TWIPS:
Public Property Get TwipsPerPixelX() As Single
Dim nDC As Long
nDC = GetDC(0)
TwipsPerPixelX = 1440 / GetDeviceCaps(nDC, LOGPIXELSX)
ReleaseDC 0, nDC
End Property
Public Property Get TwipsPerPixelY() As Single
Dim nDC As Long
nDC = GetDC(0)
TwipsPerPixelY = 1440 / GetDeviceCaps(nDC, LOGPIXELSY)
ReleaseDC 0, nDC
End Property
Public Property Get ScreenHeight() As Single
Dim nDC As Long
nDC = GetDC(0)
ScreenHeight = GetDeviceCaps(nDC, VERTRES) * _
(1440 / GetDeviceCaps(nDC, LOGPIXELSY))
ReleaseDC 0, nDC
End Property
Public Property Get ScreenWidth() As Single
Dim nDC As Long
nDC = GetDC(0)
ScreenWidth = GetDeviceCaps(nDC, HORZRES) * _
(1440 / GetDeviceCaps(nDC, LOGPIXELSX))
ReleaseDC 0, nDC
End Property
|