VISUAL BASIC 6 EM 1024X768 E 800X600 REDIMENCIONAR

USUARIO.EXCLUIDOS 25/05/2007 14:50:10
#218263
Boa Tarde !

Galera esto com um problema quando abro meu programa em resoluções diferentes "800x600 e 1024x768".

Meu programa tem uma figura na tela inicial que foi projetada para 800x600 ,porem quando abro em 1024x768 e figura não preenche a tela toda.

Existe alguma função ou macete para o visual basic 6 conseguir indentificar a resolução da tela usada pelo usuario e assim redimencionar de acordo com a resolução usada?

Agradeço

Allan James
DIOGOMUNARIN 25/05/2007 15:00:33
#218265
'DECLARA AS VARIAVEIS DA RESOLUÇÃO
x = Screen.Width \ Screen.TwipsPerPixelX
Y = Screen.Height \ Screen.TwipsPerPixelY

If x <= 800 And Y <= 600 Then
If (MsgBox("O Sistema deve funcionar com resolução superior a 800x600" & vbCrLf & _
"Deseja alterar para 1024 X 768?", vbQuestion + vbYesNo, "ATENÇÃO")) = vbNo Then
End
Else
Call ChangeRes(1024, 768)
End If
End If

' AGORA NO MODULO
Public ResX As Single
Public ResY As Single
Public OldX As Single
Public OldY As Single
Public resolucao As Boolean

'muda data e símbolo de R$
Public Const LOCALE_SSHORTDATE = &H1F
Public Const LOCALE_SCURRENCY = 20
Public Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
Public Declare Function SetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Boolean

'Public Declare Function GetClipCursor Lib "user32.dll" (lprc As RECT) As Long'

Private Declare Function EnumDisplaySettings Lib "user32" Alias _
"EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, _
lpDevMode As Any) As Boolean

Private Declare Function ChangeDisplaySettings Lib "user32" Alias _
"ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long

Const CCDEVICENAME = 32
Const CCFORMNAME = 32
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000

Private Type DEVMODE
dmDeviceName As String * CCDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type

Dim DevM As DEVMODE
Public Sub ChangeRes(iWidth As Single, iHeight As Single)
   Dim a As Boolean
   Dim i As Long
   Do
      a = EnumDisplaySettings(0&, i, DevM)
      i = i + 1
   Loop Until (a = False)

   Dim b As Long
   DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
   DevM.dmPelsWidth = iWidth
   DevM.dmPelsHeight = iHeight
   b = ChangeDisplaySettings(DevM, 0)
End Sub
DIOGOMUNARIN 25/05/2007 15:11:26
#218272
Postei como artigo aki no site. Ta melhor explicado. So falta o webmaster aprovar.
USUARIO.EXCLUIDOS 25/05/2007 15:42:43
#218283
Ok ,eu dei uma olhada no forum ,porem preciso que a imagem seja redimencionada ,tipo a função estender do windows.

A imagem esta em 800x600 e ela fica na rede ,preciso redimencionar ela para 1024.
ELTON.CALADO 25/05/2007 17:28:48
#218296
Caro colega,

Uma saída para o seu problema seria utilizar duas imagens... uma para 800x600 e outra para 1024 x 768...
De arcodo com a resolução vc usa a imagem adequada...

Espero ter ajudado.
USUARIO.EXCLUIDOS 25/05/2007 17:42:21
#218299
Se a imagem for do tipo (.wmf) escalonável ela aumenta e diminiu sozinha...

Use o Corel Draw para mudar sua imagem atual (deve ser .bmp ou .jpj) para .wmf) e faça o teste.
USUARIO.EXCLUIDOS 28/05/2007 10:57:36
#218472
ELTON.CALADO sua ideia e legal ,porem nao pode ter duas imagems ,uma vez que tudo e armazenado na rede.

Tenho esse problema.
LIZANDRO 28/05/2007 11:54:59
#218480
Eu particularmente uso um imagelist no MDI principal
Lá eu coloco as 2 imagens, quando vc usa a função que retorna a resolução é só manda a imagem que vc quer ...

Public Sub ResolucaoMonitor()

    Dim xRes As Double, yRes As Double
    Dim picx As Double, picy As Double
    
    picx = Screen.TwipsPerPixelX
    picy = Screen.TwipsPerPixelY
    xRes = Screen.Width \ picx
    yRes = Screen.Height \ picy
    
    If yRes = 600 Then
        mdiPrincipal.Picture = mdiPrincipal.imgImagens.ListImages(1).Picture
    Else
        mdiPrincipal.Picture = mdiPrincipal.imgImagens.ListImages(2).Picture
    End If
End Sub
Tópico encerrado , respostas não são mais permitidas
Voltar