Option Strict Off
Option Explicit On
Module Bildschirmauflösung
 
    ' Bildschirmauflösung, unter der die Userform erstellt wurde
    Public Const X_RESOLUTION As Short = 1024
    Public Const Y_RESOLUTION As Short = 768
 
    'X = Aktuelle Horizontal-Auflösung/1024
    'Y = Aktuelle Vertikal-Auflösung/768
    Public X As Single
    Public Y As Single
 
    Public Sub SetDeviceIndependentWindow(ByRef FormName As Object)
        ' Diese Prozedur passt die Größe und Anordnung einer Userform
        ' an die jeweilige Auflösung an.
        ' Idee und Grundgerüst von Frank Lubitz
        ' Im Prozeduraufruf muss die zu ändernde Userform angegeben werden
 
        Dim HeightChange As Integer
        Dim WidthChange As Integer
        Dim OldHeight As Integer
        Dim OldWidth As Integer
        Dim ctlControl As System.Windows.Forms.Control
 
        ' Fehlermeldungen abfangen
        On Error GoTo ErrorHandler
        ' Vergrößerungs-/Verkleinerungsfaktor der aktuellen Auflösung
        ' in Bezug auf die ursprüngliche Auflösung
        'X = System.HorizontalResolution / X_RESOLUTION
        'Y = System.VerticalResolution / Y_RESOLUTION
 
        X = VB6.PixelsToTwipsX( _
          System.Windows.Forms.Screen.PrimaryScreen.Bounds.Width) / _
        VB6.TwipsPerPixelX / X_RESOLUTION
        Y = VB6.PixelsToTwipsY( _
          System.Windows.Forms.Screen.PrimaryScreen.Bounds.Height) / _
        VB6.TwipsPerPixelY / Y_RESOLUTION
 
        ' Keine Neuanordung bei identischer Auflösung
        If X = 1 And Y = 1 Then Exit Sub
        ' Alte Einstellungen sichern
        OldHeight = FormName.Height
        OldWidth = FormName.Width
        ' Neue Abmessung der Userform berechnen
        FormName.Height = FormName.Height * Y
        FormName.Width = FormName.Width * X
        ' Änderungen der Abmessungen
        HeightChange = FormName.Height - OldHeight
        WidthChange = FormName.Width - OldWidth
        ' Userform neu positionieren
        FormName.Left = FormName.Left - WidthChange / 2
        FormName.Top = FormName.Top - HeightChange / 2
        ' Alle Controls durchlaufen und ändern
        For Each ctlControl In FormName.Controls
            Debug.Print(ctlControl.Name)
 
            If TypeOf ctlControl Is System.Windows.Forms.TextBox Then
                ControlResize2(ctlControl, X, Y)
            ElseIf TypeOf ctlControl Is System.Windows.Forms.Label Then
                ControlResize2(ctlControl, X, Y)
            ElseIf TypeOf ctlControl Is System.Windows.Forms.CheckBox Then
                ControlResize2(ctlControl, X, Y)
            ElseIf TypeOf ctlControl Is System.Windows.Forms.Button Then
                ControlResize2(ctlControl, X, Y)
            ElseIf TypeOf ctlControl Is System.Windows.Forms.ListBox Then
                ControlResize2(ctlControl, X, Y)
              ElseIf TypeOf ctlControl Is AxXGAUGELib.AxXGauge Then
                ControlResize2(ctlControl, X, Y)
            Else
                ControlResize2(ctlControl, X, Y)
            End If
        Next ctlControl
        Exit Sub
ErrorHandler:
        ' try to handle next control
        Resume Next
 
    End Sub
 
    Function ControlResize2(ByRef Control As System.Windows.Forms.Control, _
    ByRef X As Object, ByRef Y As Object) As Object '
        With Control
            .Font = VB6.FontChangeSize(.Font, .Font.SizeInPoints * X)
            .SetBounds(VB6.TwipsToPixelsX(VB6.PixelsToTwipsX(.Left) * X), _
            VB6.TwipsToPixelsY(VB6.PixelsToTwipsY(.Top) * Y), _
            VB6.TwipsToPixelsX(VB6.PixelsToTwipsX(.Width) * X), _
            VB6.TwipsToPixelsY(VB6.PixelsToTwipsY(.Height) * Y))
        End With
    End Function
 
End Module