En base a lo que explicaste, desarrollé el siguiente algoritmo.
Por supuesto, no es perfecto, en algunas cosas habrá que retocar
manualmente, pero fijate.
Lo probé en el evento Form_Load() y anduvo bien.
Explicación de los parámetros:
1°) frmForm : Formulario que quieras redimensionar
2°) lngOriginalWidth: Ancho (en píxels) de la resolución en la que
diseñaste el formulario en cuestión
3°) lngOriginalHeight: Alto (en píxels) de la resolución en la que
diseñaste el formulario en cuestión
4°) varNewWidth: Ancho (en píxels) de la nueva resolución, si no
especificas nada, se usará el ancho de la resolución actual.
5°) varNewHeight: Alto (en píxels) de la nueva resolución, si no
especificas nada, se usará el alto de la resolución actual.
6°) blnMinimumOrAverageFontSize: Al calcular el tamaño de la tipografía,
lo hace en base al ancho y alto actual comparado con la resolución de
diseño, por lo tanto, esta variable te permite especificar si queres el
mínimo tamaño calculado (True) or el promedio de ambos (False).
Suerte.
Public Sub Form_Redimension( _
ByRef frmForm As Form, _
Optional ByVal lngOriginalWidth As Long = 1024, _
Optional ByVal lngOriginalHeight As Long = 768, _
Optional ByVal varNewWidth As Variant, _
Optional ByVal varNewHeight As Variant, _
Optional ByVal blnMinimumOrAverageFontSize As Boolean = True)
Dim objObject As Object
Dim sngFont1 As Single, sngFont2 As Single
With frmForm
If IsMissing(varNewWidth) Then
varNewWidth = Screen.Width / Screen.TwipsPerPixelX
End If
If IsMissing(varNewHeight) Then
varNewHeight = Screen.Height / Screen.TwipsPerPixelY
End If
If (lngOriginalWidth = varNewWidth) And _
(lngOriginalHeight = varNewHeight) Then
Exit Sub
End If
'Form
On Error Resume Next
sngFont1 = ((varNewWidth * .Font.Size) / lngOriginalWidth)
sngFont2 = ((varNewHeight * .Font.Size) / lngOriginalHeight)
If blnMinimumOrAverageFontSize Then
.Font.Size = (IIf(sngFont1 <= sngFont2, sngFont1, sngFont2) +
(Abs(sngFont1 - sngFont2) / 2))
Else
.Font.Size = IIf(sngFont1 <= sngFont2, sngFont1, sngFont2)
End If
Select Case .WindowState
Case vbMaximized
.WindowState = vbNormal
.Height = varNewHeight
.Left = 0
.Top = 0
.Width = varNewWidth
.WindowState = vbMaximized
Case vbMinimized
.WindowState = vbNormal
.Height = ((varNewHeight * .Height) / lngOriginalHeight)
.Left = ((varNewWidth * .Left) / lngOriginalWidth)
.Top = ((varNewHeight * .Top) / lngOriginalHeight)
.Width = ((varNewWidth * .Width) / lngOriginalWidth)
.WindowState = vbMinimized
Case vbNormal
.Height = ((varNewHeight * .Height) / lngOriginalHeight)
.Left = ((varNewWidth * .Left) / lngOriginalWidth)
.Top = ((varNewHeight * .Top) / lngOriginalHeight)
.Width = ((varNewWidth * .Width) / lngOriginalWidth)
End Select
On Error GoTo 0
For Each objObject In .Controls
With objObject
On Error Resume Next
sngFont1 = ((varNewWidth * .Font.Size) /
lngOriginalWidth)
sngFont2 = ((varNewHeight * .Font.Size) /
lngOriginalHeight)
If blnMinimumOrAverageFontSize Then
.Font.Size = (IIf(sngFont1 <= sngFont2, sngFont1,
sngFont2) + (Abs(sngFont1 - sngFont2) / 2))
Else
.Font.Size = IIf(sngFont1 <= sngFont2, sngFont1,
sngFont2)
End If
sngFont1 = ((varNewWidth * .FontSize) /
lngOriginalWidth)
sngFont2 = ((varNewHeight * .FontSize) /
lngOriginalHeight)
If blnMinimumOrAverageFontSize Then
.FontSize = (IIf(sngFont1 <= sngFont2, sngFont1,
sngFont2) + (Abs(sngFont1 - sngFont2) / 2))
Else
.FontSize = IIf(sngFont1 <= sngFont2, sngFont1,
sngFont2)
End If
.Height = ((varNewHeight * .Height) / lngOriginalHeight)
.Left = ((varNewWidth * .Left) / lngOriginalWidth)
.Top = ((varNewHeight * .Top) / lngOriginalHeight)
.Width = ((varNewWidth * .Width) / lngOriginalWidth)
On Error GoTo 0
End With
Next
End With
End Sub
_____
From: [email protected] [mailto:[EMAIL PROTECTED] On Behalf Of Ave Fénix
Sent: Saturday, July 07, 2007 12:13 AM
To: vbusers List Member
Subject: [vbusers] RE: [vbusers] RE: [vbusers] Re: Tamaños del forma
Aunque no recuerdo la funcionalidad que describió Cristian, el MZTools
lo encontrás en: www.mztools.com
Suerte.
_____
From: [email protected] [mailto:[EMAIL PROTECTED] On Behalf Of Cristian
C. Bittel
Sent: Friday, July 06, 2007 5:24 PM
To: vbusers List Member
Subject: [vbusers] RE: [vbusers] Re: Tamaños del forma
Beto, hay un Add-In FREE para VB6 q se llama MZTools. No sé dónde lo podrás
conseguir y yo no lo tengo en su configuración original
Bueno, este Add-In tiene una opción de integrar a tu aplicación unos módulos
que hacen eso que vos querés. Sirve sólo con pantallas simples, con
controles complejos se confunde un poco, pero funciona!
Buscalo con Google seguro lo encontrás.
Cristian.
_____
De: [email protected] [mailto:[EMAIL PROTECTED] En nombre de Beto
Carranza
Enviado el: Viernes, 06 de Julio de 2007 15:50
Para: vbusers List Member
Asunto: [vbusers] Re: Tamaños del forma
Muchas gracias Cesar,
El problema que tengo es que lo que necesito es que me posicione todos los
botones, texts, etc en una posición similar a la que diseño yo, pero en otra
resolución mas chica.
Yo ya tengo los forms diseñados, y lo que me pasa es esto:
Pantalla 1024x768: Pantalla
800x600:
__________________________________ _______________________
| | |
|
| | |
|
| | |
| | | |
|
| | |
|
| |
|______________________|
| |
| textbox |
textbox
|_________________________________|
Osea lo que necesitaría, que no se si se puede, es que aparte de achicarme
el form, me posicione los componentes insertados.
Saludos, y gracias denuevo,
Beto.
2007/7/5, César Daniel Falchi <[EMAIL PROTECTED]>:
Beto, probá esta rutina, ponela en el form - activate.
César.
'Tamaño del area de trabajo (Ancho x Alto)
'Altura de la pantalla
h = Screen.Height / Screen.TwipsPerPixelY
'Ancho de la pantalla
w = Screen.Width / Screen.TwipsPerPixelX
'REsolucion 800 x 600
If h = 600 And w = 600 Or h = 600 And w = 800 Then
If Me.Width > 12090 Or Me.Width < 12090 Or Me.WindowState = 2 Or
Me.Height > 8670 Or Me.Height < 8670 Then
Me.WindowState = 0
Me.Height = 9000
Me.Width = 12000
Me.Top = 0
Me.Left = 0
End If
End If
'Resolución 1024 x 768
'If h = 768 And w = 1024 Or h = 864 And w = 1152 Then
If h = 768 And w = 768 Or h = 768 And w = 1024 Then
If Me.Width > 12090 Or Me.Width < 12090 Or Me.WindowState = 2 Or
Me.Height > 9930 Or Me.Height < 9930 Then
Me.WindowState = 0
Me.Height = 9000 '9930
Me.Width = 12000
Me.Top = 1200
Me.Left = 1800
End If
End If
'Resolución 1024 x 1280
'If h = 1280 And w =1024 Or h = 864 And w = 1152 Then
If h = 1024 And w = 1024 Or h = 1024 And w = 1024 Then
If Me.Width > 12090 Or Me.Width < 12090 Or Me.WindowState = 2 Or
Me.Height > 9930 Or Me.Height < 9930 Then
Me.WindowState = 0
Me.Height = 9000 '9930
Me.Width = 12000
Me.Top = 2800
Me.Left = 3600
End If
End If
No virus found in this incoming message.
Checked by AVG Free Edition.
Version: 7.5.476 / Virus Database: 269.10.1/888 - Release Date: 06/07/2007
06:36
__________ NOD32 2383 (20070706) Information __________
This message was checked by NOD32 antivirus system.
http://www.eset.com
No virus found in this outgoing message.
Checked by AVG Free Edition.
Version: 7.5.476 / Virus Database: 269.10.1/888 - Release Date: 06/07/2007
06:36
_____________ NOD32 EMON 2383 (20070706) information _____________
This message was checked by NOD32 antivirus system
http://www.eset.com
_____________ NOD32 EMON 2383 (20070706) information _____________
This message was checked by NOD32 antivirus system
http://www.eset.com
__________ NOD32 2383 (20070706) Information __________
This message was checked by NOD32 antivirus system.
http://www.eset.com
_____________ NOD32 EMON 2383 (20070706) information _____________
This message was checked by NOD32 antivirus system
http://www.eset.com
_____________ NOD32 EMON 2387 (20070710) information _____________
This message was checked by NOD32 antivirus system
http://www.eset.com
