Hier nun die bisherige Lösung.
Aufgrund statischer Umrechnungsfaktoren noch unsauber, evtl. hat jemand etwas besseres.
Siehe auch: https://dotnet-snippets.de/snippet/bildschirmskalierung-bestimmen/5950
in einem Modul:
Imports System
Imports System.Drawing
Imports System.Runtime.InteropServices
Imports System.Runtime.CompilerServices
Module ScreenExtensions
Const S_OK As Integer = 0
Const MONITOR_DEFAULTTONEAREST As Integer = 2
Const E_INVALIDARG As Integer = -2147024809
Private Declare Function MonitorFromPoint Lib "user32.dll" (<[In]()> _
ByVal pt As Point, <[In]()> ByVal dwFlags As UInteger) As IntPtr
Private Declare Function GetDpiForMonitor Lib "Shcore.dll" (<[In]()> _
ByVal hmonitor As IntPtr, <[In]()> ByVal dpiType As DpiType, <Out()> _
ByRef dpiX As UInteger, <Out()> ByRef dpiY As UInteger) As IntPtr
<Extension()> _
Sub GetDpi(ByVal screen As Screen, ByVal dpiType As DpiType, <Out()> _
ByRef dpiX As UInteger, <Out()> ByRef dpiY As UInteger)
Dim point = New Point(screen.Bounds.Left + 1, screen.Bounds.Top + 1)
Dim hmonitor = MonitorFromPoint(point, MONITOR_DEFAULTTONEAREST)
Select Case GetDpiForMonitor(hmonitor, dpiType, dpiX, dpiY).ToInt32()
Case S_OK
Return
Case E_INVALIDARG
Throw New ArgumentException("Unknown error. See" & _
"https://msdn.microsoft.com/en-us/library/windows/desktop/dn" & _
"80510.aspx for more information.")
Case Else
Throw New COMException("Unknown error. See" & _
"https://msdn.microsoft.com/en-us/library/windows/desktop/dn" & _
"80510.aspx for more information.")
End Select
End Sub
End Module
Public Enum DpiType
Effective = 0
Angular = 1
Raw = 2
End Enum in meinem Formular:
Private Function BildschirmFotoInClipBoard(ByVal rct As Rectangle) As _
Boolean
Try
Dim sc = GetScreenAtPoint(rct.Location)
Dim dpiX As UInteger
Dim dpiY As UInteger
GetDpi(sc, DpiType.Angular, dpiX, dpiY)
'Debug.Print("GetDpi bringt bei DpiType.Angular : dpiX = " &
' dpiX.ToString & " ; dpiY = " & dpiY.ToString)
Dim dpiXe As UInteger
Dim dpiYe As UInteger
GetDpi(sc, DpiType.Effective, dpiXe, dpiYe)
'Debug.Print("GetDpi bringt bei DpiType.Effective : dpiX = " &
' dpiXe.ToString & " ; dpiY = " & dpiYe.ToString)
If dpiX = 110 AndAlso dpiXe = 96 Then ' bei mir alles gut,
' Skalierung auf 100%
ElseIf dpiX = 88 AndAlso dpiXe = 96 Then ' auf dem Laptop
' Skalierung 125%
With rct
.Location = New Point(CInt(rct.X * 1.25), CInt(rct.Y * _
1.25))
.Width = .Width * 1.25
.Height = .Height * 1.25
End With
ElseIf dpiX = 73 AndAlso dpiXe = 96 Then ' auf dem Laptop
' Skalierung 150%
With rct
.Location = New Point(CInt(rct.X * 1.5), CInt(rct.Y * 1.5))
.Width = .Width * 1.5
.Height = .Height * 1.5
End With
ElseIf dpiX = 63 AndAlso dpiXe = 96 Then ' auf dem Laptop
' Skalierung 175%
With rct
.Location = New Point(CInt(rct.X * 1.75), CInt(rct.Y * _
1.75))
.Width = .Width * 1.75
.Height = .Height * 1.75
End With
Else
MessageBox.Show("Der Bildausschnitt wird vermutlich nicht" & _
"stimmen," _
& Environment.NewLine & _
"da die Skalierung der Anzeige nicht auf einen" & _
"Standardwert eingestellt ist." & _
Environment.NewLine & _
"Sie können das in der Systemsteuerung unter" & _
"Anzeigeeinstellungen ändern", ProgrammName, _
MessageBoxButtons.OK)
End If
Using b As New Bitmap(rct.Width, rct.Height)
Using g As Graphics = Graphics.FromImage(b)
g.CopyFromScreen(rct.Location, New Point(0, 0), New Size( _
rct.Width, rct.Height))
End Using
Clipboard.SetImage(b)
End Using
Return True
Catch ex As Exception
Debug.Print(ex.Message)
DebugToFile(ex.Message)
Return False
End Try
End Function Danke für die Hilfe
Gruß Christian |