Skip Navigation Links
Novas Tecnologias
Ferramentas Adicionais
Ferramentas Adicionais


Dica No :
134
Assunto : Visual Basic
Titulo: Adaptar um form para a resolução do vídeo

Gostou do texto ? Vote e dê sua opinião! Pontuação atual :

Translate this page now :






Adicione aos Favoritos!
BlogBlogs Rec6 Linkk Ueba Technorati Delicious DiggIt! StumbleUpon



Em dicas anteriores mencionamos como seria feito para obter a resolução atual do vídeo. Vejamos agora como adaptar o tamanho do form para a resolução atual.

Precisaremos 3 coisas : Redimensionar o form quando a aplicação iniciar e redimensionar os componentes quando a aplicação iniciar.

Veja :

'No form load é identificada a resolução atual e feita a adaptação
'no tamanho do form. Chama-se então a sub Resize_For_Resolution para fazer
'adaptações no tamanho dos componentes.

Option Explicit

Dim MyForm As FRMSIZE
Dim DesignX As Integer
Dim DesignY As Integer

Private Sub Form_Load()
Dim ScaleFactorX As Single, ScaleFactorY As Single ' Scaling factors
' Size of Form in Pixels at design resolution
DesignX = 800
DesignY = 600
RePosForm = True ' Flag for positioning Form
DoResize = False ' Flag for Resize Event
' Set up the screen values
Xtwips = Screen.TwipsPerPixelX
Ytwips = Screen.TwipsPerPixelY
Ypixels = Screen.Height / Ytwips ' Y Pixel Resolution
Xpixels = Screen.Width / Xtwips ' X Pixel Resolution

' Determine scaling factors
ScaleFactorX = (Xpixels / DesignX)
ScaleFactorY = (Ypixels / DesignY)
ScaleMode = 1 ' twips
'Exit Sub ' uncomment to see how Form1 looks without resizing
Resize_For_Resolution ScaleFactorX, ScaleFactorY, Me
Label1.Caption = "Current resolution is " & Str$(Xpixels) + _
" by " + Str$(Ypixels)
MyForm.Height = Me.Height ' Remember the current size
MyForm.Width = Me.Width
End Sub

'Em um módulo faça o seguinte código :

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 ' average scale
' Size the Controls for the new resolution
On Error Resume Next ' for read-only or nonexistent properties
With MyForm
For I = 0 To .Count - 1
If TypeOf .Controls(I) Is ComboBox Then ' cannot change 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
' Be sure to resize and reposition before changing the FontSize
.Controls(I).FontSize = .Controls(I).FontSize * SFFont
Next I
If RePosForm Then
' Now size the Form
.Move .Left * SFX, .Top * SFY, .Width * SFX, .Height * SFY
End If
End With
End Sub

' O código acima utiliza a coleção Controls do form para redimensionar cada um
' componentes existentes no form.

Nome :
E-mail:
Comentarios :
 
 
Os Últimos Comentários
data: 12/30/2015 8:10:00 PM
nome: Rodrigo
email: rodrigo_sampaio@globo.com
comentário:
Boa noite,

Gostei da solução, estou precisando fazer no VBA funciona?

Grato


data: 6/24/2015 11:13:00 AM
nome: Dennes
email: Dennes@bufaloinfo.com.br
comentário:
Oi,

Essa dica foi criada para VB 6, é algo bem antigo, nunca foi testada para VBA.

O código envolve fazer ajustes nos componentes internos do form.

Abs,


data: 6/21/2015 12:47:00 PM
nome: Josué
email: jvbastos@terra.com.br
comentário:
Tentei usar o seu código no VBA mas eu tenho que marcar algo em Referência por que ele da um erro "Erro de compilação, Tipo Definido pelo Usuário Não Foi Definido", e eu não sei que item é esse.
Você pode me ajudar?
Outra questão, o formulário vai ser dimencionado conforme a configuração da tela e quanto aos labels, combobox, botons e textbox? Pelo que eu fiquei sabendo eles não se au-ajustam.


data: 6/17/2007 7:43:00 PM
nome: Cesar
email:
comentário:
Excelente, funcionou com uma mínima distorção.

data: 6/30/2006 10:07:00 AM
nome: Emerson Araujo
email: opejfa@ambev.com.br
comentário:
Bom dia !

Tentei utilizar este código no VBA (Excel), mas não consegui fazer funcionar, vc tem como me ajudar ??
Esta dando erro na "Screen.TwipsPerPixelX" não reconhece o Screen..

Att


 1  
Dicas
Dica do Dia
Receba Dicas Por Email
E-mail :  
 


 (help)
Aceito receber informativos do devASPNet, informações de eventos e treinamentos

Veja Quais Informativos Você Receberá

Pesquisar Dicas
Pesquisar Artigos, Dicas e Noticias

Banco de Dados
Algumas Entrevistas
Links Importantes

Búfalo Informática, Treinamento e Consultoria
R. Alvaro Alvim, 37/920 Centro - Cinelândia - Rio de Janeiro Cep: 20031-010
Tel : (21) 2262-1368 (21) 9240-5134 E-mail : Contato@bufaloinfo.com.br