Option Explicit
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long
Const SM_CXSCREEN As Long = 0
Const SM_CYSCREEN As Long = 1
Dim MyForm As FRMSIZE
Dim DesignX As Integer
Dim DesignY As Integer
Private Sub Form_Load()
Dim ScaleFactorX As Single, ScaleFactorY As Single ' Scaling factors
' Size of Form in Pixels at design resolution
DesignX = GetSystemMetrics(SM_CXSCREEN) ' aquí para X
DesignY = GetSystemMetrics(SM_CYSCREEN) ' aquí para Y
RePosForm = True ' Flag for positioning Form
DoResize = False ' Flag for Resize Event
' Set up the screen values
Xtwips = Screen.TwipsPerPixelX
Ytwips = Screen.TwipsPerPixelY
Ypixels = Screen.Height / Ytwips ' Y Pixel Resolution
Xpixels = Screen.Width / Xtwips ' X Pixel Resolution
' Determine scaling factors
ScaleFactorX = (Xpixels / DesignX)
ScaleFactorY = (Ypixels / DesignY)
ScaleMode = 1 ' twips
'Exit Sub ' uncomment to see how Form1 looks without resizing
Resize_For_Resolution ScaleFactorX, ScaleFactorY, Me
Label1.Caption = "Current resolution is " & Str$(Xpixels) + _
" by " + Str$(Ypixels)
MyForm.Height = Me.Height ' Remember the current size
MyForm.Width = Me.Width
End Sub
Private Sub Form_Resize()
Dim ScaleFactorX As Single, ScaleFactorY As Single
If Not DoResize Then ' To avoid infinite loop
DoResize = True
Exit Sub
End If
RePosForm = False
ScaleFactorX = Me.Width / MyForm.Width ' How much change?
ScaleFactorY = Me.Height / MyForm.Height
Resize_For_Resolution ScaleFactorX, ScaleFactorY, Me
MyForm.Height = Me.Height ' Remember the current size
MyForm.Width = Me.Width
End Sub
Private Sub Command1_Click()
Dim ScaleFactorX As Single, ScaleFactorY As Single
DesignX = Xpixels
DesignY = Ypixels
RePosForm = True
DoResize = False
' Set up the screen values
Xtwips = Screen.TwipsPerPixelX
Ytwips = Screen.TwipsPerPixelY
Ypixels = Screen.Height / Ytwips ' Y Pixel Resolution
Xpixels = Screen.Width / Xtwips ' X Pixel Resolution
' Determine scaling factors
ScaleFactorX = (Xpixels / DesignX)
ScaleFactorY = (Ypixels / DesignY)
Resize_For_Resolution ScaleFactorX, ScaleFactorY, Me
Label1.Caption = "Current resolution is " & Str$(Xpixels) + _
" by " + Str$(Ypixels)
MyForm.Height = Me.Height ' Remember the current size
MyForm.Width = Me.Width
End Sub