Attribute VB_Name = "modSizeForm"
'****************************************************************
'
'  MultiResolution
'
'  © Copyright 2000 by Herfried Wagner.
'  Es wird keine Haftung für Schäden, die durch diesen Code
'  verursacht wurden, übernommen.
'
'  Bei Fehlern oder Fragen wenden Sie sich bitte an:
'  hirf@activevb.de        http://www.ActiveVB.de
'
'****************************************************************
Option Explicit

Private Type RECT   ' pt
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Function GetClientRect Lib "user32" _
    (ByVal hwnd As Long, _
    lpRect As RECT) As Long

'
' Passt die Grösse des Formulars und der Steuerelemente
' den übergebenen Werten an.
'
Public Sub ShowSizedForm(frmForm As Form, lngNewWidth As Long, _
    blnCenterForm As Boolean)
    
    Dim rctFormClient As RECT
    Dim lngOldWidth As Long
    Dim sngPercent As Single
    Dim sngDiffX As Single
    Dim sngDiffY As Single
    Dim lngClientHeight As Long
    Dim ctrControl As Control
    
    ' "Alte" Breite des Formulars speichern.
    lngOldWidth = frmForm.Width
    
    ' Neue Breite zuweisen.
    frmForm.Width = lngNewWidth     ' <--
    
    ' Rechteck des Client-Bereichs dieses Formulars
    ' ermitteln.
    Call GetClientRect(frmForm.hwnd, rctFormClient)
    
    ' Berechnen, um wieviel Twips der Clientbereich niedriger
    ' ist als die Höhe des gesamten Formulars. Entspricht ca.
    ' der Rahmenbreite plus die Höhe der Titelleiste.
    sngDiffY = frmForm.Height - _
        (rctFormClient.Bottom - rctFormClient.Top) * _
        Screen.TwipsPerPixelY
    
    ' Analog bei der Breite vorgehen.
    sngDiffX = frmForm.Width - _
        (rctFormClient.Right - rctFormClient.Left) * _
        Screen.TwipsPerPixelX
    
    ' Verhältnis zwischen alten "Einheiten" und neuen "Einheiten"
    ' berechnen.
    sngPercent = (frmForm.Width - sngDiffX) / _
    (lngOldWidth - sngDiffX)
    
    ' Höhe des Client-Bereichs bestimmen.
    lngClientHeight = frmForm.Height - sngDiffY
    
    ' Neue Höhe zuweisen.
    frmForm.Height = lngClientHeight * sngPercent + sngDiffY
    
    ' Fehler bei Timern etc.
    On Error Resume Next
    
    ' Alle Steuerelemente anpasssen.
    For Each ctrControl In frmForm.Controls
        
        ' DriveListBox und ComboBox unterstützen die
        ' Move-Anweisung nicht.
        If (TypeOf ctrControl Is DriveListBox Or _
            TypeOf ctrControl Is ComboBox) Then
            
            ctrControl.Top = ctrControl.Top * sngPercent
            ctrControl.Left = ctrControl.Left * sngPercent
            ctrControl.Width = ctrControl.Width * sngPercent
            ctrControl.Height = ctrControl.Height * sngPercent
            
        ' Das Line-Steuerelement wird anders positioniert.
        ElseIf (TypeOf ctrControl Is Line) Then
            ctrControl.X1 = ctrControl.X1 * sngPercent
            ctrControl.X2 = ctrControl.X2 * sngPercent
            ctrControl.Y1 = ctrControl.Y1 * sngPercent
            ctrControl.Y2 = ctrControl.Y2 * sngPercent
            
            ctrControl.BorderWidth = CInt(ctrControl.BorderWidth * _
                sngPercent)
            
        ' Andere Steuerelemente (Label, TextBox etc.).
        Else
            ctrControl.Move _
                ctrControl.Left * sngPercent, _
                ctrControl.Top * sngPercent, _
                ctrControl.Width * sngPercent, _
                ctrControl.Height * sngPercent
            
            If (TypeOf ctrControl Is Shape) Then _
                ctrControl.BorderWidth = CInt(ctrControl.BorderWidth * _
                sngPercent)
        End If
        
        ' Schriftgrösse anpassen (Fehler, der bei Image-Steuerelement
        ' etc. entsteht, wird unterdrückt.
        ctrControl.Font.Size = ctrControl.Font.Size * sngPercent
    Next
    
     'Formular zentrieren.
    If blnCenterForm = True Then frmForm.Move _
        frmForm.Left, _
        frmForm.Top
    'frmForm.Show
End Sub