
Redimensionar A Tela Automaticamente
#1
Posted 04/06/2004, 00:28
oparrudo@ig.com.br
almada_r@hotmail.com
#2
Posted 07/06/2004, 14:46
Public Function AdapForm(F As Form, Ideal As Integer)
'4.2.7 Alterar os formulários de acordo com a resolução
Dim xRes As Integer
Dim a As Integer
Dim Prop As Single
Dim C As Control
Dim Alterar As Integer
xRes = GetSystemMetrics(0)
If xRes > Ideal Then
Prop = xRes / Ideal
For Each C In F
Alterar = 0
If TypeOf C Is Image Then Alterar = 1
#If SemProgressBar = 0 Then
If TypeOf C Is ProgressBar Then Alterar = 1
#End If
If TypeOf C Is VScrollBar Then Alterar = 1
If TypeOf C Is Label Then Alterar = 2
'4.3.4 Realçado o link da página e mail no sobre
#If SemLabelLink = 0 Then
If TypeOf C Is LabelLink Then
Alterar = 2
End If
#End If
If TypeOf C Is TextBox Then Alterar = 2
If TypeOf C Is ComboBox Then Alterar = 2
If TypeOf C Is CommandButton Then Alterar = 2
If TypeOf C Is OptionButton Then Alterar = 2
If TypeOf C Is CheckBox Then Alterar = 2
If TypeOf C Is Frame Then Alterar = 2
#If SemMSFlexGrid = 0 Then
If TypeOf C Is MSFlexGrid Then Alterar = 2
#End If
#If SemSSTab = 0 Then
If TypeOf C Is SSTab Then Alterar = 2
#End If
If Alterar Then
C.Width = C.Width * Prop
C.Left = C.Left * Prop
C.Top = C.Top * Prop
'4.4.5 Correção do redimensionamento do objeto combo
If Alterar = 2 Then
C.FontSize = C.FontSize * Prop
End If
On Error GoTo NaoVai
C.Height = C.Height * Prop
' If Alterar = 2 Then
' C.FontSize = C.FontSize * Prop
' End If
Continua_AdapForm:
End If
Next
F.Width = F.Width * Prop
F.Height = F.Height * Prop
End If
Exit Function
NaoVai:
Resume Continua_AdapForm
End Function
é chamada asism no On_Load do Formulário
AdapForm Me, 640
neste caso 640 indica que se a resolução é 640x480 não deva ser alterada
no teu caso deve o parâmetro deve ser 1024
Funcionamento:
Ele passa por todos os obejtos do formulário
e adapta de acordo com o tipo de objeto
alguns podem alterar a fonte outros não
ainda utilizo diretivas de compilação para poder funcionar em todos meus sistemas
por exemplo se num utilizo MsFlexGrid ta tranquilo
mas se não utilizo, portanto ele não esta nos componentes carregados para o projeto
ele vai dar erro ao tentar comparar um objeto com o MsFlexGrid
então coloco uma diretiva de compilação assim SemMSFlexGrid = 1
se tu tem controles personalizados como eu, no caso o LabelLink, então é só incluílos adequadamente.
Ta aí
Barbadão
Não esqueça de agradescer ao Xevious no About do teu programa

1 user(s) are reading this topic
0 membro(s), 1 visitante(s) e 0 membros anônimo(s)