Option Compare Database
Option Explicit
Private List() As Control
'Private curr_obj As Object
Private curr_obj As Access.Control
Private iHeight As Integer
Private iWidth As Integer
Private x_size As Double
Private y_size As Double
' http://www.dreamincode.net/forums/topic/34776-resize-form-controls-for-screen-size-vb6/
'*****************************************************************************************
' LICENSE INFORMATION
'*****************************************************************************************
' FormControl Version 2.0
' Code module for resizing a form based on screen size, then resizing the
' controls based on the forms size
'
' Copyright (C) 2007
' Richard L. McCutchen
' Email: richard@psychocoder.net
' Created: AUG99
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
' GNU General Public License for more details.
'
' You should have received a copy of the GNU General Public License
' along with this program. If not, see <http://www.gnu.org/licenses/>.
'*****************************************************************************************
'Private Sub Form_Load()
' GetLocation Me
' CenterForm Me
' ResizeForm Me
' lblInstructions.Font = SetFontSize()
' End Sub
'
'Private Sub Form_Resize()
' ResizeControls Me
' lblInstructions.FontSize = SetFontSize()
' End Sub
Private Type Control
Index As Integer
Name As String
Left As Integer
Top As Integer
Width As Integer
Height As Integer
FontSize As Integer
End Type
Public Sub ResizeControls(frm As Form)
Dim i As Integer
' Get ratio of initial form size to current form size
x_size = frm.Height / iHeight
y_size = frm.Width / iWidth
'Loop though all the objects on the form
'Based on the upper bound of the # of controls
For i = 0 To UBound(List)
'Grad each control individually
For Each curr_obj In frm.Controls
'Check to make sure its the right control
If curr_obj.TabIndex = List(i).Index Then
'Then resize the control
With curr_obj
.Left = List(i).Left * y_size
.Width = List(i).Width * y_size
.Height = List(i).Height * x_size
.Top = List(i).Top * x_size
.FontSize = List(i).FontSize * x_size
End With
End If
'Get the next control
Next curr_obj
Next i
End Sub
Public Function SetFontSize() As Integer
'Make sure x_size is greater than 0
If Int(x_size) > 0 Then
'Set the font size
SetFontSize = Int(x_size * 8)
End If
End Function
Public Sub GetLocation(frm As Form)
Dim i As Integer
' Load the current positions of each object into a user defined type array.
' This information will be used to rescale them in the Resize function.
'Loop through each control
For Each curr_obj In frm.Controls
'Resize the Array by 1, and preserve
'the original objects in the array
ReDim Preserve List(i)
With List(i)
.Name = curr_obj
.Index = curr_obj.TabIndex
.Left = curr_obj.Left
.Top = curr_obj.Top
.Width = curr_obj.Width
.Height = curr_obj.Height
.FontSize = curr_obj.FontSize
End With
i = i + 1
Next curr_obj
' This is what the object sizes will be compared to on rescaling.
iHeight = frm.Height
iWidth = frm.Width
End Sub
Public Sub CenterForm2(frm As Form)
frm.Move (Screen.Width - frm.Width) \ 2, (Screen.Height - frm.Height) \ 2
End Sub
Public Sub ResizeForm(frm As Form)
'Set the forms height
frm.Height = Screen.Height / 2
'Set the forms width
frm.Width = Screen.Width / 2
'Resize all of the controls
'based on the forms new size
ResizeControls frm
End Sub