Mantener los tamaños y proporciones de los formularios y su contenido aunque cambie la resolución de la pantalla

 

Colaboración de Guillermo de Israel.

Este tema fue desarrollado usando VB 3.0 bajo Windows 3.1. Funciona perfectamente bajo Windows 95.
No lo he probado en VB 4.0, pero creo que con mínimas correcciones funcionara también.

El proceso de redimensionamiento y renunciación físicos de formularios y sus diversos objetos se basa en un articulo de origen ingles reproducido en MS Knowledge Base, que usaba, equivocadamente, el parámetro Twips Per Pixel (12 o 15 de acuerdo a la resolución de pantalla en pixels) para obtener un factor de conversión. El autor de esta serie de subrutinas descarto ese encare y usa el ancho y alto de pantalla, en twips, obtenibles durante la ejecución del proyecto por medio de la función SCREEN y sus propiedades Ancho y Alto.

Todas las subrutinas incluidas en este paquete, salvo esta parte que es solamente explicatoria, deben incluirse en un modulo de código (yo lo he llamado COMUNES.BAS), de modo que sean accesibles desde cualquier lugar del proyecto.

El autor uso originalmente una resolución de pantalla física de 9600 x 7200 twips.
El numero de twips por pixel no influye en el proceso, como se dijo antes.
Si la resolución de pantalla usada durante el diseño fuera distinta que estos números, habría que reemplazar dichos números en las líneas correspondientes en la subrutina factores.

'Incluir las tres declaraciones siguientes en la parte DECLARATIONS bajo GENERAL 
'del modulo COMUNES.BAS

 

Global presentForm As Form
Global FlagFlag As Integer 'bandera que indica el estado de cosas durante el proceso.
Global HorFactor As Single, VerFactor As Single 'multiplicadores para escala de adaptación

 

Sub CenterForm (x As Form)
	'Centra en la pantalla física el formulario llamado x
	Screen.MousePointer = 11
	x.Top = Screen.Height / 2 - x.Height / 2
	x.Left = Screen.Width / 2 - x.Width / 2
	Screen.MousePointer = 0
	'Exponer el formulario
	x.Show
End Sub

 

Sub ComboResizing (x As Control)
	'adapta medidas y ubicación de una caja combo
	x.Left = x.Left * HorFactor
	x.Top = x.Top * VerFactor
	x.Width = x.Width * HorFactor
	x.Height = x.Height * VerFactor
End Sub

 

Sub CommButtonResizing (x As Control)
	'Adapta medidas y ubicación de un botón de comando
	x.Left = x.Left * HorFactor
	x.Top = x.Top * VerFactor
	x.Width = x.Width * HorFactor
	x.Height = x.Height * VerFactor
	x.FontSize = x.FontSize * HorFactor
End Sub

 

Sub ControlsResizing (x As Control)
	'Redimensiona y reubica un control genérico
	x.Left = x.Left * HorFactor
	x.Top = x.Top * VerFactor
	x.Width = x.Width * HorFactor
	x.Height = x.Height * VerFactor
End Sub

 

Sub Factores ()
' El autor uso originalmente una resolución de pantalla fisica de 9600 x 7200 twips.
' El número de twips por pixel no influye en el proceso.
' Si fuera distinto habria que reemplazar dichos numeros en las lineas correspondientes
' más abajo.
' Se hace uso de la función Screen, accesible solamente durante el procesado
' del programa, que da el ancho y alto de la pantalla en twips.
	SizingFactor = 0
	HorFactor = Screen.Width / 9600
	VerFactor = Screen.Height / 7200
' Si la pantalla de uso tiene la misma resolución que la de diseño
' no habrá que hacer nada, lo cual indicamos con la bandera SizingFactor igual a 1.
	If HorFactor = 1 And VerFactor = 1 Then
		SizingFactor = 1
	End If
End Sub

 

Sub GaugeResizing (x As Control)
	'Redimensiona y reubica un instrumento de medición circular
	If x.Style = 3 Then
		DummyWidth = x.Width * HorFactor
		x.Left = x.Left * HorFactor + (DummyWidth - x.Width) / 2
		DummyHeight = x.Height * VerFactor
		x.Top = x.Top * VerFactor + (DummyHeight - x.Height) / 2
	ElseIf x.Style = 1 Then
		x.Left = x.Left * HorFactor
		x.Top = x.Top * VerFactor
		x.Height = x.Height * VerFactor
	End If
End Sub

 

Sub LabelResizing (x As Control)
	' Redimensiona y reubica un label
	x.Left = x.Left * HorFactor
	x.Top = x.Top * VerFactor
	x.Width = x.Width * HorFactor
	x.Height = x.Height * VerFactor
	x.FontSize = x.FontSize * VerFactor
End Sub

 

Sub LineResizing (x As Control)
	' Redimensiona (incluido grosor) y reubica una linea recta
	x.X1 = x.X1 * HorFactor
	x.X2 = x.X2 * HorFactor
	x.Y1 = x.Y1 * VerFactor
	x.Y2 = x.Y2 * VerFactor
	x.BorderWidth = x.BorderWidth * VerFactor
End Sub

 

Sub MainFrm_View ()
	' Esta subrutina la uso para descargar el formulario en uso,
	' y recargar la que contiene los menus del proyecto. No es imprescindible para
	' la tarea de redimensionar y reubicar formularios y sus objetos.
	presentForm.Hide
	Unload presentForm
	frmMain.Show
End Sub

 

Sub PictResizing (x As Control)
	'Redimensiona y reubica un objeto de tipo picture
	x.Top = Screen.Height / 2 - x.Height / 2
	x.Left = Screen.Width / 2 - x.Width / 2
End Sub

 

Sub SizeAdaptor (y As Form)
	' Esta es la rutina principal del proceso de redimensión y reubucación.
	' Debe ser invocada [call SizeAdaptor(NombreDelFormulario)] al cargar (Load)
	' cada formulario del programa a su turno.
	' Aca se recorren el formulario y todos los controles que contiene
	' para determinar el curso de accion a seguir para cada uno de ellos.
	HojaBlanca.Show 'Desplegamos un formulario vacio mientras efectua los cambios
	'El autor uso un formulario principal llamado frmMain conteniendo menus.
	If FlagFlag = 0 Then Unload frmMain
	' Invocar la rutina que calcula los factores de correccion de tamaño
	Call Factores
	' Si el uso y el diseño se realizan con una misma resolución de pantalla,
	' no hace falta corrección alguna y se puede salir de la subrutina.
	If SizingFactor = 1 Then
		y.Show
		Unload HojaBlanca
		Exit Sub
	End If
	' Si el uso y el diseño se realizan con resoluciones de pantalla distintas
	' hay que modificar las medidas y ubicación de cada componente.
	' Adaptar el formulario en si.
	' Esconder el formulario y su contenido mientras se hace la adaptación.
	y.Hide
	y.Left = 0
	y.Top = 0
	y.Height = Screen.Height
	y.Width = Screen.Width
	' La funcion Controls.Count permite saber cuantos controles hay en el formulario
	Ctl = y.Controls.Count - 1
	' Adaptar uno por uno todos los controles incluidos en el formulario, cada uno
	' de acuerdo a su naturaleza.
	For ii = 0 To Ctl
		If TypeOf y.Controls(ii) Is Line Then
			Call LineResizing(y.Controls(ii))
		ElseIf TypeOf y.Controls(ii) Is ComboBox Then
			Call ComboResizing(y.Controls(ii))
		ElseIf TypeOf y.Controls(ii) Is ListBox Then
			Call ComboResizing(y.Controls(ii))
		ElseIf TypeOf y.Controls(ii) Is CommandButton Then
			Call CommButtonResizing(y.Controls(ii))
		ElseIf TypeOf y.Controls(ii) Is TextBox Then
			Call TextBoxResizing(y.Controls(ii))
		ElseIf TypeOf y.Controls(ii) Is Label Then
			Call LabelResizing(y.Controls(ii))
		ElseIf TypeOf y.Controls(ii) Is Gauge Then
			Call GaugeResizing(y.Controls(ii))
		ElseIf TypeOf y.Controls(ii) Is PictureBox Then
			Call PictResizing(y.Controls(ii))
		ElseIf TypeOf y.Controls(ii) Is Timer Then
			' Aca se pueden agregar lineas para otros tipos de control que hubiere
		Else
			Call ControlsResizing(y.Controls(ii))
		End If
	Next ii
	' Una vez completado el proceso de adaptacion volvemos a mostrar el formulario
	' con todo su contenido.
	y.Show
	' Una vez desplegado nuevamente el formulario modificado,
	' podemos descargar el formulario vacio.
	Unload HojaBlanca
End Sub

 

Sub TextBoxResizing (x As Control)
	x.Left = x.Left * HorFactor
	x.Top = x.Top * VerFactor
	x.Width = x.Width * HorFactor
	x.Height = x.Height * VerFactor
	x.FontSize = x.FontSize * VerFactor
End Sub

ir al índice