Wednesday, 13 March 2013

Resize Control for change in Resolution


Resize Control for change in Resolution

Option Explicit
Public nHeight As Double
Public nWidth As Double
Dim nState As Boolean

Sub ResizeControls()
    Dim ctl As Control
    Dim wRatio As Double
    Dim hRatio As Double
    Dim fRatio As Double
On Error Resume Next
    If nState = True Then Exit Sub
    'Standard : 1024 * 728
    If Screen.Width = 15360 And Screen.Height = 11520 Then Exit Sub
    wRatio = Screen.Width / nWidth
    hRatio = Screen.Height / nHeight
    If UserControl.Parent.WindowState = 2 Then
        For Each ctl In UserControl.Parent
            ctl.Left = wRatio * ctl.Left
            ctl.Top = hRatio * ctl.Top
            ctl.Width = wRatio * ctl.Width
            ctl.Font.Size = ctl.Font.Size * hRatio
            ctl.Height = hRatio * ctl.Height
        Next
    End If
    nState = True
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    nHeight = UserControl.Parent.ScaleHeight
    nWidth = UserControl.Parent.ScaleWidth
    nState = UserControl.Parent.WindowState
End Sub

No comments:

Post a Comment