Ajustando um formulário de acordo com a resolução do video ( SDI )

VB6 - Ajustando um formulário de acordo com a resolução do video ( SDI )

Vamos a problema: Você desenvolveu um aplicativo e utilizou a resolução de vídeo 800x600 , não levou em conta que muitos usuários ainda usam a resolução 640x480.

Sabe o que vai acontecer com aquele formulário feito na resolução 800x600 quando um usuário que usa a resolução 640x480 abrir o seu projeto : dependendo do tamanho do formulário ele verá somente uma parte do mesmo ; muitos controles poderão ficar ocultos pois foram feitos para serem exibidos em um tamanho na resolução 800x600 e ficarão enormes na resolução 640x480.

Que tal prever esta situação e desenvolver um formulário que se auto redimensiona de acordo com a resolução de vídeo usada pelo usuário. Vamos mostrar como fazer isto.

Quando você for desenvolver aplicativos que deverão ser redimensionados em tempo de execução, deverá levar em conta o seguinte:

Desenhe o formulário na menor resolução de video ( o redimensionamento para resoluções maiores é melhor)
Utilize fontes TruType que são escaláveis
Use fontes que estarão disponíveis no sistema do usuário
Desenhe os controles um pouco maior do que o necessário e deixe um espaço maior entre eles. O redimensionamento nem sempre é exato.
CheckBoxes e Option buttons não são redimensionáveis; e alguns controles precisarão de um tratamento especial: Ex: A propriedade Height das caixas de combinação ( combobox ) é somente leitura em tempo de execução para redimensioná-las deveremos aumentar o tamanho das fontes usadas neste controle.

Agora o projeto passo a passo:

Trabalhe com a resolução de vídeo 800x600.
Inicie um novo projeto no VB
No formulário padrão , form1 , inclua um botão de comando ( commandButton) , uma etiqueta ( Label ) e mais alguns controles a sua escolha. Abaixo temos o aspecto do nosso formulário:

Insira o seguinte código no formulário:

Option Explicit
  Dim MyForm As FRMSIZE
  Dim DesignX As Integer
  Dim DesignY As Integer
----------------------------------------------------------------------------------
Private Sub Command2_Click()
  Unload Me
End Sub
----------------------------------------------------------------------------------
    Private Sub Form_Load()
      Dim ScaleFactorX As Single, ScaleFactorY As Single  ' fatores da escala
      ' Tamanho do formulario em Pixels na resolução de trabalho
      DesignX = 800
      DesignY = 600
      RePosForm = True
      DoResize = False
      ' define os valores da tela
      Xtwips = Screen.TwipsPerPixelX
      Ytwips = Screen.TwipsPerPixelY
      Ypixels = Screen.Height / Ytwips 
      Xpixels = Screen.Width / Xtwips  

      ' Determina os valores da escala
      ScaleFactorX = (Xpixels / DesignX)
      ScaleFactorY = (Ypixels / DesignY)
      ScaleMode = 1  ' twips
      
      Resize_For_Resolution ScaleFactorX, ScaleFactorY, Me
      Label1.Caption = "Resolução Atual " & Str$(Xpixels) + _
       "  por " + Str$(Ypixels)
      MyForm.Height = Me.Height ' Lembra o tamanho atual
      MyForm.Width = Me.Width
   End Sub
---------------------------------------------------------------------------------
   Private Sub Form_Resize()
      Dim ScaleFactorX As Single, ScaleFactorY As Single

      If Not DoResize Then  ' Para evitar um loop sem fim
         DoResize = True
         Exit Sub
      End If

      RePosForm = False
      ScaleFactorX = Me.Width / MyForm.Width   ' Quanto mudar ?
      ScaleFactorY = Me.Height / MyForm.Height
      Resize_For_Resolution ScaleFactorX, ScaleFactorY, Me
      MyForm.Height = Me.Height ' Lembra o tamanho atual
      MyForm.Width = Me.Width
   End Sub

---------------------------------------------------------------------------------
   Private Sub Command1_Click()
      Dim ScaleFactorX As Single, ScaleFactorY As Single

      DesignX = Xpixels
      DesignY = Ypixels
      RePosForm = True
      DoResize = False
      ' define os valores da tela
      Xtwips = Screen.TwipsPerPixelX
      Ytwips = Screen.TwipsPerPixelY
      Ypixels = Screen.Height / Ytwips '  Resolução do Pixel Y
      Xpixels = Screen.Width / Xtwips  ' Resolução do Pixel X

      ' determina os fatores da escala
      ScaleFactorX = (Xpixels / DesignX)
      ScaleFactorY = (Ypixels / DesignY)
      Resize_For_Resolution ScaleFactorX, ScaleFactorY, Me
      Label1.Caption = "Resolução Atual -> " & Str$(Xpixels) + _
       "  por " + Str$(Ypixels)
      MyForm.Height = Me.Height ' Lembra o tamanho atual
      MyForm.Width = Me.Width
   End Sub

Insira um modulo no projeto e inclua o seguinte código no módulo:

Public Xtwips As Integer, Ytwips As Integer
Public Xpixels As Integer, Ypixels As Integer

   Type FRMSIZE
      Height As Long
      Width As Long
   End Type
   Public RePosForm As Boolean
   Public DoResize As Boolean
-------------------------------------------------------------------------------------------

   Sub Resize_For_Resolution(ByVal SFX As Single, _
      ByVal SFY As Single, MyForm As Form)
      
      Dim I As Integer
      Dim SFFont As Single

      SFFont = (SFX + SFY) / 2  ' escala média
      ' Tamanho dos controles para a nova resolução
      On Error Resume Next  '
      With MyForm
        For I = 0 To .Count - 1
         If TypeOf .Controls(I) Is ComboBox Then 'Combobox não altera a propriedade Height
           .Controls(I).Left = .Controls(I).Left * SFX
           .Controls(I).Top = .Controls(I).Top * SFY
           .Controls(I).Width = .Controls(I).Width * SFX
         Else
           .Controls(I).Move .Controls(I).Left * SFX, _
            .Controls(I).Top * SFY, _
            .Controls(I).Width * SFX, _
            .Controls(I).Height * SFY
         End If
           ' Redimensiona e reposiciona antes de alterar o tamanho da fonte
           .Controls(I).FontSize = .Controls(I).FontSize * SFFont
        Next I
        If RePosForm Then
          ' Redimensiona o formulario
          .Move .Left * SFX, .Top * SFY, .Width * SFX, .Height * SFY
        End If
      End With
   End Sub

Agora teste o projeto.

Execute-o em diferente resoluções de vídeo e veja que o formulário se ajusta para ocupar a mesma posição e aparência no desktop. Perceba que o redimensionamento é melhor quando mudamos para uma resolução maior.

Se mudar a resolução quando o formulário estiver aberto clique no botão de comando para que o ajuste seja feito. A seguir uma comparação do resultado feito em duas resoluções de vídeo: