I haven't tested this but I think it will place the form in center of the screen with the same proportions as the monitor is was designed on.
Private Sub Form_Load()
' This assumes you disigned your app on a monitor
' with the res set to 1280 x 960. If not change the
' vaule in the sngHeightPrecent and sngWidthPrecent
' calculations.
Dim sngWidthPrecent As Single
Dim sngHeightPrecent As Single
sngHeightPrecent = Me.Height /(960 * Screen.TwipsPerPixelY)
sngWidthPrecent = Me.Width/ (1280 * Screen.TwipsPerPixelX)
GetStats Me
With Me
.Width = Screen.Width * sngWidthPrecent
.Height = Screen.Height * sngHeightPrecent
.Left = (Screen.Width - .Width) \ 2
.Top = (Screen.Height - .Height) \ 2
End With
End Sub
**********************END CODE**********************
now you have to resize the controls on the form.
here are 2 ways to accomplish that:
1. is written in Basic so will have to be translated, but the approach is good never the less.
**********************Begin Code**********************
Option Explicit
Public blnGotStats As Boolean
Dim Stats() As CtlStats
Private Type CtlStats
udtName As Variant
udtLeft As Single
udtTop As Single
udtWidth As Single
udtHeight As Single
udtFontSize As Single
udtX1 As Single
udtX2 As Single
udtY1 As Single
udtY2 As Single
End Type
Public Sub MoveResize(frm As Form)
Dim ctl As Control
Dim intCnt As Integer
On Error Resume Next
If blnGotStats = False Then
GetStats frm
End If
For Each ctl In frm.Controls
For intCnt = 1 To UBound(Stats)
If ctl.Name = Stats(intCnt).udtName Then
ctl.Left = frm.ScaleWidth * Stats(intCnt).udtLeft
ctl.Width = frm.ScaleWidth * Stats(intCnt).udtWidth
ctl.Top = frm.ScaleHeight * Stats(intCnt).udtTop
ctl.Height = frm.ScaleHeight * Stats(intCnt).udtHeight
ctl.Font.Size = frm.ScaleHeight * Stats(intCnt).udtFontSize
ctl.X1 = frm.ScaleWidth * Stats(intCnt).udtX1
ctl.X2 = frm.ScaleWidth * Stats(intCnt).udtX2
ctl.Y1 = frm.ScaleHeight * Stats(intCnt).udtY1
ctl.Y2 = frm.ScaleHeight * Stats(intCnt).udtY2
Exit For
End If
Next intCnt
Next ctl
End Sub
Public Sub GetStats(frm As Form)
Dim ctl As Control
Static StatsInitialized As Boolean
On Error Resume Next
If StatsInitialized = False Then
ReDim Stats(0)
StatsInitialized = True
End If
For Each ctl In frm.Controls
ReDim Preserve Stats(UBound(Stats) + 1)
Stats(UBound(Stats)).udtHeight = ctl.Height / frm.ScaleHeight
Stats(UBound(Stats)).udtLeft = ctl.Left / frm.ScaleWidth
Stats(UBound(Stats)).udtTop = ctl.Top / frm.ScaleHeight
Stats(UBound(Stats)).udtWidth = ctl.Width / frm.ScaleWidth
Stats(UBound(Stats)).udtName = ctl.Name
Stats(UBound(Stats)).udtFontSize = ctl.Font.Size / frm.ScaleHeight
Stats(UBound(Stats)).udtX1 = ctl.X1 / frm.ScaleWidth
Stats(UBound(Stats)).udtX2 = ctl.X2 / frm.ScaleWidth
Stats(UBound(Stats)).udtY1 = ctl.Y1 / frm.ScaleHeight
Stats(UBound(Stats)).udtY2 = ctl.Y2 / frm.ScaleHeight
Next ctl
blnGotStats = True
End Sub
**********************END CODE**********************
2. I used 4 different resolutions. 800x600 1024x768 1152x864 and 1280x760
the sub asks for an initial resolution. meaning which resolution was this file created on. the range is from 1-4, 1 being 800x600 1280x760 being 4.
So if you designed it on 800x600 you would call the sub like
Private Sub Form_Load()
Call Resize_Form(1)
End Sub
And here is the layout of the sub. Basically you have to enter the amount you want to change the size of the controls and the form depending on what resolution it was initially made in or what resolution the screen is at.
I gave 1 example of how to cycle through the controls and resize them as well as the form.
VB Code:
**********************Begin CODE**********************
Private Sub Resize_Form(OriginalRes As Integer)
iWidth = Screen.Width / Screen.TwipsPerPixelX
iHeight = Screen.Height / Screen.TwipsPerPixelY
Size = IWidth & "X" & IHeight
Dim Con As Control
Select Case Size
Case "800X600"
If OriginalRes = 1 Then Exit Sub 'No need to resize if it was made in this rez.
If OriginalRes = 4 Then
'resize your form and controls accordingly. The controls and form will have to be made much much smaller.
End If
If OriginalRes = 3 Then
'resize your form and controls accordingly. The controls and form will have to be made much smaller.
End If
If OriginalRes = 2 Then
Me.Width = Me.Width - 800
Me.Height = Me.Height - 800
For Each Con In Me.Controls
Con.Width = Con.Width - 800
Con.Height = Con.Height - 800
Next
'Make the controls and form slightly smaller
End If
Case "1024X768"
If OriginalRes = 2 Then Exit Sub 'No need to resize if it was made in this rez.
If OriginalRes = 4 Then
'resize your form and controls accordingly
End If
If OriginalRes = 3 Then
'resize your form and controls accordingly
End If
If OriginalRes = 1 Then
'resize your form and controls accordingly
End If
Case "1152X864"
If OriginalRes = 3 Then Exit Sub 'No need to resize if it was made in this rez.
If OriginalRes = 4 Then
'resize your form and controls accordingly
End If
If OriginalRes = 2 Then
'resize your form and controls accordingly
End If
If OriginalRes = 1 Then
'resize your form and controls accordingly
End If
Case "1280X720"
If OriginalRes = 4 Then Exit Sub'No need to resize if it was made in this rez.
If OriginalRes = 3 Then
'resize your form and controls accordingly
End If
If OriginalRes = 2 Then
'resize your form and controls accordingly
End If
If OriginalRes = 1 Then
'resize your form and controls accordingly
End If
End Select
End Sub
**********************END CODE**********************
|