Hola Ave Fenix, Disculpame que no te agradecí anteriormente, pero se me traspapeló tu mail. Muchas gracias por tu tiempo.
Ahora voy a probarlo, muchas gracias. Beto. El día 9/07/07, Ave Fénix <[EMAIL PROTECTED]> escribió: > > 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 > > > > _____________ NOD32 EMON 2387 (20070710) information _____________ > > This message was checked by NOD32 antivirus system > http://www.eset.com > >
