yes, this should do it, however, it's a little buggy.
Code:Private ResHeight As Integer Private ResWidth As Integer Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Const SM_CXSCREEN = 0 Private Const SM_CYSCREEN = 1 Private Const Design_Width = 800 'set to Width Res of Design Enviroment Private Const Design_Height = 600 ' set to Height res of Design Enviroment Private Sub GetScreenResolution() Dim lTemp As String ' Temporary string to hold returned screen ' resolution ResWidth = GetSystemMetrics(SM_CXSCREEN) ResHeight = GetSystemMetrics(SM_CYSCREEN) ' Call the API function twice to return ' screen size for each axis as format into ' the temporary string End Sub Private Sub ResizeAll() GetScreenResolution On Error Resume Next Dim WidthProp As Double Dim HeightProp As Double Dim frm As Form WidthProp = ResWidth / Design_Width HeightProp = ResHeight / Design_Height Dim Ctrl As Control For Each frm In VB.Forms For Each Ctrl In frm.Controls If TypeOf Ctrl Is Label Then Ctrl.FontSize = Ctrl.FontSize * HeightProp End If If TypeOf Ctrl Is Image Then Ctrl.Stretch = True Ctrl.Height = Ctrl.Height * HeightProp Ctrl.Top = Ctrl.Top * HeightProp Ctrl.Left = Ctrl.Left * WidthProp Ctrl.Width = Ctrl.Width * WidthProp DoEvents End if Next Next End Sub




Reply With Quote