[Scrip]

Hi

With reference to the post by PsycoCoder : Resize Form & Controls For Screen Size - VB6

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
'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
	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

the application breaks at :

With List(i)
.Name = curr_obj

with error 394 - Property is write only

[cyber_sam]

the code is working properly but it is givinng error while adding toolbar and status bar

Option Explicit

Private List() As control
Private curr_obj As Object
Private iHeight As Integer
Private iWidth As Integer
Private X_size As Double
Private Y_size As Double

Private Type control
  index As Integer
  Name As String
  Top As Integer
  Left As Integer
  Width As Integer
  Height As Integer

End Type

Private Sub Form_Load()
	
	GetLocation Me
	ReSizeForm Me
End Sub


Private Sub ReSizeForm(frm As Form)
   With frm
		.Width = Screen.Width / 2
		.Top = (Screen.Height / 2) - .Height / 2
		.Left = (Screen.Width / 2) - .Width / 2
		.Height = Screen.Height / 2
		ResizeControl Me
   End With
End Sub
Private Sub ResizeControl(frm As Form)
	 Dim i As Integer
	 X_size = frm.Width / iWidth
	 Y_size = frm.Height / iHeight
	 
	 For i = 0 To UBound(List)
	   For Each curr_obj In frm
		 If curr_obj.TabIndex = List(i).index Then
			With curr_obj
			   .Top = List(i).Top * X_size
			   .Height = List(i).Height * X_size
			   .Left = List(i).Left * Y_size
			   .Width = List(i).Width * Y_size
			End With
		 End If
	   Next curr_obj
	 Next i

End Sub
Private Sub GetLocation(frm As Form)
   Dim i As Integer
   For Each curr_obj In frm
	ReDim Preserve List(i)
	With List(i)
	   .index = curr_obj.TabIndex
	   .Name = curr_obj.Name
	   .Height = curr_obj.Height
	   .Width = curr_obj.Width
	   .Left = curr_obj.Left
	   .Top = curr_obj.Top
	End With
   i = i + 1
   Next curr_obj
   iWidth = frm.Width
   iHeight = frm.Height
End Sub
Private Sub Form_Resize()
	ResizeControl Me
End Sub

 

[Slogger]

Firstly let me thank you for this code...just what the doctor ordered.

However, I think the resize has a fundamental flaw.

I use an "Image" control for photographs. This Object has no TabIndex and so is not picked in the ResizeControls routine.

Many of my controls are also Indexed and so just using the name was not sufficient.

I have reworked the code to store Name() and Index. On objects that have no Index then the line "Index = curr_obj.Index" will fail but this is alright for now. You will need an On Error Resume Next at the start of the GetLocation routine.

The loop within the Resize now checks for both Name And Index or just Name if the object no Index. (I am sure this can be simplified more but I need another coffee before playing!)

I have also resized each of the the objects Fontsize.

Any comments ?



Private Type Control
''' Index As Integer
Index As String
Name As String
Left As Integer
Top As Integer
width As Integer
height As Integer
fontSize As Integer
End Type

I have commented out TabIndex and used Inded...note Name() !!.

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.
On Error Resume Next
i = 0
'Loop through each control
For Each curr_obj In frm
'Resize the Array by 1, and preserve
'the original objects in the array
ReDim Preserve ControlsList(i)
With ControlsList(i)
''' .Name = curr_obj
.Name = curr_obj.Name()
''' .Index = curr_obj.TabIndex
.Index = curr_obj.Index
.Left = curr_obj.Left
.Top = curr_obj.Top
.width = curr_obj.width
.height = curr_obj.height
.fontSize = curr_obj.fontSize
Debug.Print .Name, .Index
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 ResizeControls(frm As Form)
Dim i As Integer
Dim Flag As Integer
Dim a$

' Get ratio of initial form size to current form size
x_size = frm.height / iHeight
y_size = frm.width / iWidth

On Error Resume Next

'Loop though all the objects on the form
'Based on the upper bound of the # of controls
For Each curr_obj In frm
a$ = curr_obj.Index
For i = 0 To UBound(List)
'Grad each control individually
'Check to make sure its the right control
' If curr_obj.TabIndex = List(i).Index Then
Flag = False
If IsNumeric(a$) Then
If curr_obj.Name() = List(i).Name Then
If CInt(a$) = List(i).Index Then
Flag = True
End If
End If
Else
If curr_obj.Name() = List(i).Name Then
Flag = True
End If
End If
If Flag = True 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
Exit For
End If
'Get the next control
Next i
Next curr_obj

End Sub

This post has been edited by Slogger: 12 September 2009 - 04:15 AM