This is the code I use for resizing forms easilly with all controls etc...
![Name: Snap1.png
Views: 26
Size: 3.4 KB]()
![Name: Snap2.jpg
Views: 26
Size: 11.1 KB]()
Just add in your form
And this is the class_Resize code
Sample app Elastic.zip
Just add in your form
Code:
Option Explicit
Private mclsResize As New class_Elastic
Private Sub Form_Load()
mclsResize.Init Me
End Sub
Private Sub Form_Resize()
On Error Resume Next
mclsResize.FormResize Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set mclsResize = Nothing
End SubCode:
'****************************************************************
' Name: class_Elastic
' Description:This class can change size and location of controls on your form
' 1. Resize form
' 2. Change screen resolution
'
' By: Mikhail Shmukler
'
' Inputs:None
' Returns:None
' Assumes:
' 1. Add Elastic.cls
' 2. Add declaration 'Private El as New class_Elastic'
' 3. Insert string like 'El.init Me' (formload event)
' 4. Insert string like 'El.FormResize Me' (Resize event)
' 5. Press 'F5' and resize form ....
' Side Effects:None
'
'****************************************************************
Option Explicit
Private nFormHeight As Long
Private nFormWidth As Long
Private nNumOfControls As Long
Private nTop() As Long
Private nLeft() As Long
Private nHeight() As Long
Private nWidth() As Long
Private nFontSize() As Long
'Private nRightMargin() As Long
Private bFirstTime As Boolean
Private bFirstTimeMaximized As Boolean
Public sNameTopIgnore As String
Private Const nCaptionSize As Long = 400
Public Sub Init(oForm As Form, Optional pbFirstime As Boolean = False)
' #VBIDEUtils#************************************************************
' * Author :
' * Web Site :
' * E-Mail :
' * Date : 07/25/2010
' * Time : 07:52
' * Module Name : class_Elastic
' * Module Filename : Elastic.cls
' * Procedure Name : Init
' * Purpose :
' * Parameters :
' * oForm As Form
' * Optional nWindState As Variant
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
On Error Resume Next
Dim i As Long
With oForm
nFormHeight = .Height
nFormWidth = .Width
nNumOfControls = .Controls.Count - 1
bFirstTime = True
If Not IsMissing(pbFirstime) Then
bFirstTime = pbFirstime
bFirstTimeMaximized = pbFirstime
Else
bFirstTimeMaximized = True
End If
ReDim nTop(nNumOfControls)
ReDim nLeft(nNumOfControls)
ReDim nHeight(nNumOfControls)
ReDim nWidth(nNumOfControls)
ReDim nFontSize(nNumOfControls)
For i = 0 To nNumOfControls
nTop(i) = .Controls(i).Top
nLeft(i) = .Controls(i).Left
nHeight(i) = .Controls(i).Height
nWidth(i) = .Controls(i).Width
nFontSize(i) = .FontSize
Next
End With
EXIT_Init:
On Error Resume Next
Exit Sub
End Sub
Public Sub InitControl(oControls As Object, pnHeight As Long, pnWidth As Long, pnFontSize As Double, Optional pbFirstime As Boolean = False)
' #VBIDEUtils#************************************************************
' * Author :
' * Web Site :
' * E-Mail :
' * Date : 07/25/2010
' * Time : 07:52
' * Module Name : class_Elastic
' * Module Filename : Elastic.cls
' * Procedure Name : InitControl
' * Purpose :
' * Parameters :
' * oControls As Object
' * pnHeight As Long
' * pnWidth As Long
' * pnFontSize As Double
' * Optional pbFirstime As Boolean = False
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
On Error Resume Next
Dim i As Long
nFormHeight = pnHeight
nFormWidth = pnWidth
nNumOfControls = oControls.Count - 1
bFirstTime = True
If Not IsMissing(pbFirstime) Then
bFirstTime = pbFirstime
bFirstTimeMaximized = pbFirstime
Else
bFirstTimeMaximized = True
End If
ReDim nTop(nNumOfControls)
ReDim nLeft(nNumOfControls)
ReDim nHeight(nNumOfControls)
ReDim nWidth(nNumOfControls)
ReDim nFontSize(nNumOfControls)
For i = 0 To nNumOfControls
nTop(i) = oControls(i).Top
nLeft(i) = oControls(i).Left
nHeight(i) = oControls(i).Height
nWidth(i) = oControls(i).Width
nFontSize(i) = pnFontSize
Next
EXIT_InitControl:
On Error Resume Next
Exit Sub
End Sub
Public Sub InitTop(frm As Form, Optional pbFirstime As Boolean = False)
' #VBIDEUtils#************************************************************
' * Author :
' * Web Site :
' * E-Mail :
' * Date : 07/25/2010
' * Time : 07:52
' * Module Name : class_Elastic
' * Module Filename : Elastic.cls
' * Procedure Name : InitTop
' * Purpose :
' * Parameters :
' * frm As Form
' * Optional nWindState As Variant
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
On Error Resume Next
Dim i As Long
For i = 0 To nNumOfControls
If TypeOf frm.Controls(i) Is Line Then
nTop(i) = frm.Controls(i).Y1
nHeight(i) = frm.Controls(i).Y2
Else
nTop(i) = frm.Controls(i).Top
nHeight(i) = frm.Controls(i).Height
End If
Next
End Sub
Public Sub FormResize(oForm As Form, Optional bForceTop As Boolean = False)
' #VBIDEUtils#************************************************************
' * Author :
' * Web Site :
' * E-Mail :
' * Date : 11/03/2014
' * Time : 09:00
' * Module Name : class_Elastic
' * Module Filename : Elastic.cls
' * Procedure Name : FormResize
' * Purpose :
' * Parameters :
' * oForm As Form
' * Optional bForceTop As Boolean = False
' * Optional bRedraw As Boolean = True
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
On Error Resume Next
Dim i As Long
Dim dRatioX As Double
Dim dRatioY As Double
Dim nSaveRedraw As Long
With oForm
nSaveRedraw = .AutoRedraw
.AutoRedraw = True
If bFirstTime Then
If (.Visible) And (.WindowState = 2) And (bFirstTimeMaximized) Then
bFirstTimeMaximized = False
bFirstTime = False
.WindowState = 0
Call Init(oForm, False)
.WindowState = 2
End If
bFirstTime = False
Exit Sub
End If
If .Height < nFormHeight Then .Height = nFormHeight
If .Width < nFormWidth Then .Width = nFormWidth
dRatioY = 1# * (nFormHeight - nCaptionSize) / (.Height - nCaptionSize)
dRatioX = 1# * nFormWidth / .Width
For i = 0 To nNumOfControls
'If TypeOf .Controls(I) Is Label Then
' .Controls(I).Move Int(nLeft(I) / dRatioX), Int(nTop(I) / dRatioY), Int(nWidth(I) / dRatioX)
'
If TypeOf .Controls(i) Is ComboBox Then
.Controls(i).Move Int(nLeft(i) / dRatioX), Int(nTop(i) / dRatioY), Int(nWidth(i) / dRatioX)
ElseIf TypeOf .Controls(i) Is Line Then
.Controls(i).Y1 = Int(nTop(i) / dRatioY)
.Controls(i).X1 = Int(nLeft(i) / dRatioX)
.Controls(i).Y2 = Int(nHeight(i) / dRatioY)
.Controls(i).X2 = Int(nWidth(i) / dRatioX)
Else
.Controls(i).Move Int(nLeft(i) / dRatioX), Int(nTop(i) / dRatioY), Int(nWidth(i) / dRatioX), Int(nHeight(i) / dRatioY)
End If
Next
.AutoRedraw = nSaveRedraw
End With
End Sub
Public Sub FormResizeNoRedraw(oForm As Form, nTopBlock As Long, Optional bForceTop As Boolean = False)
' #VBIDEUtils#************************************************************
' * Author :
' * Web Site :
' * E-Mail :
' * Date : 11/03/2014
' * Time : 09:00
' * Module Name : class_Elastic
' * Module Filename : Elastic.cls
' * Procedure Name : FormResizeNoRedraw
' * Purpose :
' * Parameters :
' * oForm As Form
' * Optional bForceTop As Boolean = False
' * Optional bRedraw As Boolean = True
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
On Error Resume Next
Dim i As Long
Dim dRatioX As Double
Dim dRatioY As Double
With oForm
.AutoRedraw = True
If bFirstTime Then
If (.Visible) And (.WindowState = 2) And (bFirstTimeMaximized) Then
bFirstTimeMaximized = False
bFirstTime = False
.WindowState = 0
Call Init(oForm, False)
.WindowState = 2
End If
bFirstTime = False
Exit Sub
End If
If .Height < nFormHeight Then .Height = nFormHeight
If .Width < nFormWidth Then .Width = nFormWidth
dRatioY = 1# * (nFormHeight - nCaptionSize) / (.Height - nCaptionSize)
dRatioX = 1# * nFormWidth / .Width
For i = 0 To nNumOfControls
If TypeOf .Controls(i) Is ComboBox Then
.Controls(i).Move Int(nLeft(i) / dRatioX), Int(nTop(i) / dRatioY), Int(nWidth(i) / dRatioX)
Else
.Controls(i).Move Int(nLeft(i) / dRatioX), Int(nTop(i) / dRatioY), Int(nWidth(i) / dRatioX), Int(nHeight(i) / dRatioY)
End If
Next
End With
End Sub
Public Sub UserControlResize(oControls As Object, pnHeight As Long, pnWidth As Long, pnFontSize As Double)
' #VBIDEUtils#************************************************************
' * Author :
' * Web Site :
' * E-Mail :
' * Date : 11/03/2014
' * Time : 09:00
' * Module Name : class_Elastic
' * Module Filename : Elastic.cls
' * Procedure Name : UserControlResize
' * Purpose :
' * Parameters :
' * oControls As Object
' * pnHeight As Long
' * pnWidth As Long
' * pnFontSize As Double
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
On Error Resume Next
Dim i As Long
Dim dRatioX As Double
Dim dRatioY As Double
If pnHeight < nFormHeight Then pnHeight = nFormHeight
If pnWidth < nFormWidth Then pnWidth = nFormWidth
dRatioY = 1# * (nFormHeight - nCaptionSize) / (pnHeight - nCaptionSize)
dRatioX = 1# * nFormWidth / pnWidth
For i = 0 To nNumOfControls
If TypeOf oControls(i) Is ComboBox Then
oControls(i).Move Int(nLeft(i) / dRatioX), Int(nTop(i) / dRatioY), Int(nWidth(i) / dRatioX)
Else
oControls(i).Move Int(nLeft(i) / dRatioX), Int(nTop(i) / dRatioY), Int(nWidth(i) / dRatioX), Int(nHeight(i) / dRatioY)
End If
Next
End Sub
Public Sub FormResizeForceTop(oForm As Form)
' #VBIDEUtils#************************************************************
' * Author :
' * Web Site :
' * E-Mail :
' * Date : 11/03/2014
' * Time : 09:00
' * Module Name : class_Elastic
' * Module Filename : Elastic.cls
' * Procedure Name : FormResize
' * Purpose :
' * Parameters :
' * oForm As Form
' * Optional bForceTop As Boolean = False
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
Dim i As Long
Dim dRatioX As Double
Dim dRatioY As Double
Dim nSaveRedraw As Long
On Error Resume Next
With oForm
nSaveRedraw = .AutoRedraw
.AutoRedraw = True
If bFirstTime Then
If (.Visible) And (.WindowState = 2) And (bFirstTimeMaximized) Then
bFirstTimeMaximized = False
bFirstTime = False
.WindowState = 0
Call Init(oForm, False)
.WindowState = 2
End If
bFirstTime = False
Exit Sub
End If
If .Height < nFormHeight Then .Height = nFormHeight
If .Width < nFormWidth Then .Width = nFormWidth
dRatioY = 1# * (nFormHeight - nCaptionSize) / (.Height - nCaptionSize)
dRatioX = 1# * nFormWidth / .Width
For i = 0 To nNumOfControls
If TypeOf .Controls(i) Is Line Then
.Controls(i).Y1 = Int(nTop(i) / dRatioY)
.Controls(i).X1 = Int(nLeft(i) / dRatioX)
.Controls(i).Y2 = Int(nHeight(i) / dRatioY)
.Controls(i).X2 = Int(nWidth(i) / dRatioX)
Else
If sNameTopIgnore = .Controls(i).Name Then
.Controls(i).Move Int(nLeft(i) / dRatioX), nTop(i), Int(nWidth(i) / dRatioX), Int(nHeight(i) / dRatioY)
Else
.Controls(i).Move Int(nLeft(i) / dRatioX), Int(nTop(i) / dRatioY), Int(nWidth(i) / dRatioX), Int(nHeight(i) / dRatioY)
End If
End If
Next
.AutoRedraw = nSaveRedraw
End With
End Sub