Sub AjustaControlesForm(Formulario As Form, ByVal AntHeight As Single, _
ByVal AntWidth As Single, Optional ByVal AjustarFuentes As Boolean = True, _
Optional ByVal AjustarFuentesAlAncho As Boolean = False)
Dim PorcentajeH As Double
Dim PorcentajeW As Double
Dim EnaBAK As Boolean
Dim tControl As Control
If Formulario.WindowState = vbMinimized Then Exit Sub
On Local Error Resume Next
If Formulario.Height <> AntHeight Or Formulario.Width <> AntWidth Then
PorcentajeH = ((Formulario.Height - AntHeight) * 100) / AntHeight
PorcentajeW = ((Formulario.Width - AntWidth) * 100) / AntWidth
For Each tControl In Formulario.Controls
' SI EL TIPO DE CONTROL NO ES VISIBLE,
' COMO UN TIMER, NO SE TOCA.
If TypeOf tControl Is Timer = False _
And TypeOf tControl Is Menu = False _
Then
' AÑADE LOS CONTROLES QUE VEAS NECESARIOS,
' DEPENDIENDO DE TU PROGRAMA.
' P.EJ. PUEDES AÑADIR LOS COMMONDIALOG
' SI TU PROGRAMA CONTIENE ALGUNO.
'And TypeOf tControl Is CommonDialog = False _
' SIN EMBARGO AÑADIRLOS, CUANDO EL PROYECTO
' NO LOS CONTIENE, PROVOCA ERRORES (AL MENOS A MI)
' POR ESO NO INCLUYO POR DEFECTO EL COMMONDIALOG
' ESTA PARTE ES PARA QUE SE REDIBUJEN
' BIEN LOS CONTROLES QUE NO SE ENCUENTREN ENABLED.
' SIN EMBARGO ALGUNOS CONTROLES TAMPOCO
' ADMITEN ESTA PROPIEDAD...
If TypeOf tControl Is Line = False Then
EnaBAK = tControl.Enabled
tControl.Enabled = False
tControl.Enabled = True
End If
' SI HAY QUE AJUSTAR EL TAMAÑO DE LAS FUENTES DE TEXTO...
If AjustarFuentes = True Then
' NO CAMBIAMOS LAS FUENTES SI NO TIENEN TEXTO.
If TypeOf tControl Is HScrollBar = False _
And TypeOf tControl Is VScrollBar = False _
And TypeOf tControl Is Line = False _
And TypeOf tControl Is Slider = False _
And TypeOf tControl Is Shape = False Then
' Las fuentes se ajustan por defecto al alto del form
If AjustarFuentesAlAncho = True Then
tControl.FontSize = tControl.FontSize + ((PorcentajeW * tControl.FontSize) / 100)
Else
' las fuentes se ajustan por defecto al alto porque si
' se hace al ancho se deforman los botones y ademas no se
' puede estirar para ver mas texto (p.ej en un listbox)
' porque el texto crece tambien.
' SI APARECE UN ERROR USA ESTOS MSGBOX PARA DESCUBRIR
' EL CONTROL (Y SU FORM) QUE NO ES COMPATIBLE, PARA
' AGREGARLO A LAS COMPARACIONES Y REPARAR EL FALLO.
'MsgBox tControl.name
'MsgBox Formulario.name
' SI ES UN RICHTEXTBOX EL FONTSIZE SE HACE DIFERENTE.
' SI TU FORMULARIO CONTIENE RICHTEXTBOX ACTIVA LAS
' SIGUIENTES 4 LÍNEAS ANULADAS.
'If TypeOf tControl Is RichTextBox = True Then
' tControl.Font.Size = tControl.Font.Size + ((PorcentajeH * tControl.Font.Size) / 100)
'Else
tControl.FontSize = tControl.FontSize + ((PorcentajeH * tControl.FontSize) / 100)
'End If
' SI TIENES UN CONTROL QUE NO HAYA PROBADO YO, Y QUE
' TENGA EL FONTSIZE DE LA FORMA "FONT.SIZE", AÑADE UNA COMPARACION
' EN EL CÓDIGO ANTERIOR.
End If
End If
End If
' AJUSTAMOS EL CONTROL
If TypeOf tControl Is Line = True Then
' SI ES DEL TIPO LINE SE AJUSTAN X1, Y1, X2, Y2
tControl.X1 = tControl.X1 + ((PorcentajeW * tControl.X1) / 100)
tControl.X2 = tControl.X2 + ((PorcentajeW * tControl.X2) / 100)
tControl.Y1 = tControl.Y1 + ((PorcentajeH * tControl.Y1) / 100)
tControl.Y2 = tControl.Y2 + ((PorcentajeH * tControl.Y2) / 100)
Else
' SI ES DE OTRO TIPO SE AJUSTA EL TAMAÑO Y POSICION
' PERO NO CAMBIAMOS EL HEIGHT SI ES DE SOLO LECTURA.
' LOS COMBOBOX Y DRIVELISTBOX SE AJUSTAN SEGUN
' EL FONTSIZE, Y NO SE DEJAN CAMBIAR A MANO.
If TypeOf tControl Is ComboBox = False _
And TypeOf tControl Is DriveListBox = False Then
tControl.Height = tControl.Height + ((PorcentajeH * tControl.Height) / 100)
End If
' NO SE PUEDE CAMBIAR ESTE ORDEN.
' PRIMERO HAY QUE AJUSTAR EL TAMAÑO DE FUENTES
' Y DESPUES EL HEIGHT SE TIENE QUE AJUSTAR ANTES
' QUE LOS DEMÁS, PORQUE SI NO, LOS BOTONES
' SE HACEN MAS ALTOS DE LO DEBIDO.
tControl.Top = tControl.Top + ((PorcentajeH * tControl.Top) / 100)
tControl.Left = tControl.Left + ((PorcentajeW * tControl.Left) / 100)
tControl.Width = tControl.Width + ((PorcentajeW * tControl.Width) / 100)
End If
' AQUI SE VUELVEN A DESACTIVAR LOS CONTROLES
' QUE AL COMENZAR TUVIESEN LA PROPIEDAD ENABLED = FALSE
If TypeOf tControl Is Line = False Then
tControl.Enabled = EnaBAK
End If
End If
Next tControl
End If
End Sub
Este tema le ha gustado a 1 personas