RESOLUCAO DE VIDEO

MICROSCHEME 05/01/2010 23:14:32
#331121

Eu trabalho com resolução 1280 x 768.

Acontece que quando rodo meus programas em outros computadores nem sempre a resolução é a mesma
do meu equipamento e, geralmente, o cliente reclama quando anterado a resolução em seu equipamento e ai,
volto pro projeto e mudo tudo, quando possível é claro.

Agora, criei um projeto que independente da resolução do cliente, sempre vai tar a mesma aparência, sem
a necessida de alterar as configurações do equipamento do cliente e/ou amigo.

[txt-color=#e80000]Gravar como .FRM:[/txt-color]

VERSION 5.00
Begin VB.Form Resolucao
BackColor = &H80000003&
BorderStyle = 1 [ô]Fixed Single
Caption = [Ô] Resolução de Video Visual Basic 6.0[Ô]
ClientHeight = 10470
ClientLeft = 45
ClientTop = 435
ClientWidth = 15270
ControlBox = 0 [ô]False
LinkTopic = [Ô]Form1[Ô]
MaxButton = 0 [ô]False
MinButton = 0 [ô]False
Moveable = 0 [ô]False
OLEDropMode = 1 [ô]Manual
ScaleHeight = 10470
ScaleWidth = 15270
Begin VB.TextBox Text03
BeginProperty Font
Name = [Ô]MS Sans Serif[Ô]
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 [ô]False
Italic = 0 [ô]False
Strikethrough = 0 [ô]False
EndProperty
Height = 480
Left = 3758
TabIndex = 2
Top = 5070
Width = 7740
End
Begin VB.TextBox Text02
BeginProperty Font
Name = [Ô]MS Sans Serif[Ô]
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 [ô]False
Italic = 0 [ô]False
Strikethrough = 0 [ô]False
EndProperty
Height = 480
Left = 3758
TabIndex = 1
Top = 4470
Width = 7740
End
Begin VB.TextBox Text01
BeginProperty Font
Name = [Ô]MS Sans Serif[Ô]
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 [ô]False
Italic = 0 [ô]False
Strikethrough = 0 [ô]False
EndProperty
Height = 480
Left = 3758
TabIndex = 0
Top = 3870
Width = 7740
End
Begin VB.CommandButton Command01
BackColor = &H000000FF&
Cancel = -1 [ô]True
Caption = [Ô]Sair[Ô]
BeginProperty Font
Name = [Ô]MS Sans Serif[Ô]
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 [ô]False
Italic = 0 [ô]False
Strikethrough = 0 [ô]False
EndProperty
Height = 540
Left = 13725
Style = 1 [ô]Graphical
TabIndex = 3
Top = 9450
Width = 1215
End
Begin VB.Label Label01
Alignment = 2 [ô]Center
BackColor = &H80000003&
BeginProperty Font
Name = [Ô]Times New Roman[Ô]
Size = 15.75
Charset = 0
Weight = 400
Underline = 0 [ô]False
Italic = 0 [ô]False
Strikethrough = 0 [ô]False
EndProperty
Height = 480
Left = 3773
TabIndex = 4
Top = 6240
Width = 7740
End
End
Attribute VB_Name = [Ô]Resolucao[Ô]
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim MyForm As FrmSize

Private Sub Command01_Click()
Unload Me
End Sub

Private Sub Form_Load()
intWidhtPadrao = 1024 [ô] padrão do meu equipamento
intHeightPadrao = 768 [ô] padrão do meu equipamento
booReposicionar_Form = True
booRefazer_Recize = False
intXTwips = Screen.TwipsPerPixelX
intYTwips = Screen.TwipsPerPixelY
intYPixels = Screen.Height / intYTwips
intXPixels = Screen.Width / intXTwips
sinFatorX = (intXPixels / intWidhtPadrao)
sinFatorY = (intYPixels / intHeightPadrao)
ScaleMode = 1
Refazer_Resolucao_Video sinFatorX, sinFatorY, Me
MyForm.lngHeight = Me.Height
MyForm.lngWidth = Me.Width
Refazer_Resize
End Sub

Function Refazer_Resize()
intWidhtPadrao = intXPixels
intHeightPadrao = intYPixels
booReposicionar_Form = True
booRefazer_Recize = False
intXTwips = Screen.TwipsPerPixelX
intYTwips = Screen.TwipsPerPixelY
intYPixels = Screen.Height / intYTwips
intXPixels = Screen.Width / intXTwips
sinFatorX = (intXPixels / intWidhtPadrao)
sinFatorY = (intYPixels / intHeightPadrao)
Refazer_Resolucao_Video sinFatorX, sinFatorY, Me
Label01.Caption = [Ô]A Resolução Atual do Video é de [Ô] & intXPixels & [Ô] por [Ô] & intYPixels & [Ô] Pixels[Ô]
MyForm.lngHeight = Me.Height
MyForm.lngWidth = Me.Width
End Function

[txt-color=#e80000]Gravar num módulo:[/txt-color]

Public booReposicionar_Form As Boolean
Public booRefazer_Recize As Boolean
Public intControls As Integer
Public intHeightPadrao As Integer
Public intWidhtPadrao As Integer
Public intXPixels As Integer
Public intXTwips As Integer
Public intYPixels As Integer
Public intYTwips As Integer
Public sinFatorX As Single
Public sinFatorY As Single
Public sinFont As Single
Type FrmSize
lngHeight As Long
lngWidth As Long
End Type

Public Function Refazer_Resolucao_Video(ByVal sinFontX As Single, ByVal sinFontY As Single, MyForm As Form)
sinFont = (sinFontX + sinFontY) / 2
With MyForm
For intControls = 0 To .Count - 1
If TypeOf .Controls(intControls) Is ComboBox Then
.Controls(intControls).Left = .Controls(I).Left * sinFontX
.Controls(intControls).Top = .Controls(I).Top * sinFontY
.Controls(intControls).Width = .Controls(I).Width * sinFontX
Else
.Controls(intControls).Move .Controls(intControls).Left * sinFontX
.Controls(intControls).Top = .Controls(intControls).Top * sinFontY
.Controls(intControls).Width = .Controls(intControls).Width * sinFontX
.Controls(intControls).Height = .Controls(intControls).Height * sinFontY
End If
.Controls(intControls).FontSize = .Controls(intControls).FontSize * sinFont
Next intControls
If booReposicionar_Form Then
.Move .Left * sinFontX, .Top * sinFontY, .Width * sinFontX, .Height * sinFontY
End If
End With
End Function

é só rodar

Blz . . .
EPISCOPAL 05/01/2010 23:30:32
#331122
[txt-color=#e80000]???[/txt-color]
MICROSCHEME 06/01/2010 07:37:32
#331129

Desculpa.

Eu disse: [Ô]Eu trabalho com resolução 1280 x 768.[Ô]

Na verdade é 1024 x 768.

.. .
TECLA 06/01/2010 08:49:11
#331132 Resposta escolhida
Citação:

WOLFFIRE :
[txt-color=#e80000]???[/txt-color]


O tópico é uma DÚVIDA ou uma SOLUÇÃO???
Se for a segunda alternativa, favor enviar o projeto para o site (na HOME) para que a SOLUÇÃO seja melhor aproveitada.
MICROSCHEME 06/01/2010 15:44:20
#331204

Blz . . .

Mas peço desculpas, pois descobri agora que estou tendo problemas com mensagens de erro
em controles que possuem propriedade ready-only e outros que não possuem a propriedade
fontsize tais como: timer e image.

Quando resolvido mandarei.

Blz . . .
Tópico encerrado , respostas não são mais permitidas
Voltar