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