Possuo um mdb que foi desenvolvido para uma resolução 800 x 600, porem agora preciso que ele rode um uma maquina que o monitor so aceita 640 x 480, será que vou ter que refazer todos os formulários, ou existe alguma forma que contornar este problema.
Grato
Everaldo


--------------------------------------------------------------------------------

procure aqui no forum por resolução, se não encontrar nada que lhe satisfaça,ecesse os links que você encontrará como alterar a resolução de video.

Oi Everaldo,

existe um controle ActiveX que faz isto, mas deve custar uma nota. Veja em www.cbsoftware.com.br

[]

Ola amigo.
Eu tinha o mesmo problema que vc. Encontrei no Espaço Access um código que resolveu a questão.
Crie um módulo e coloque o seguinte código:

***************************************

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
Sub ChangeRes(iWidth As Single, iHeight As Single)
Dim a As Boolean, i&
i = 0
Do
a = EnumDisplaySettings(0&, i&, DevM)
i = i + 1
Loop Until (a = False)
Dim b&
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
DevM.dmPelsWidth = iWidth
DevM.dmPelsHeight = iHeight
b = ChangeDisplaySettings(DevM, 0)
End Sub
*************************************
feito isso, voce coloca no evento AO AO CARREGAR DE SEU FORMULARIO:
Call ChangeRes(800, 600)


e no evento AO FECHAR coloque:
Call ChangeRes(640, 480)

adorei a sua solucao abaixo para alterar a resolucao de video.fiz sistemas pra micros com resolucao de 1024x768

e eu tenho usarios com resolucao de 1024x768 e 800x600

coloquei no iniciar do meu aplicativo
Call ChangeRes(1024, 768)

mas eu so posso usar este comando se o usuário tiver resolucao de 800x600
como eu posso fazer um if p´ra saber se a pessoa utiliza 800x600 ?

Almir,

Estou te enviando um exemplo zipado para vc analisar....Este Banco de Dados possui um form q mostra tanto a resolução atual como tambem possibilita a mudar a resolução...Espero q possa te ajudar.

Caro Almir

Para complementar a excelente dica do nosso amigo Zumba, eu tenho a outra metade da moeda.
A dica dele muda a resolução e a minha (pequei aqui no forum) detecta...

Cole o bloco abaixo em um novo múdulo e chame a rotinano promeiro form doseu BD, adapte nos lugares das mensagens, os comandos que voce deseja executá-los.


======

Option Compare Database
Option Explicit

Private Declare Function GetSysMetrics Lib "user32" _
Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long

Private Const SM_CXSCREEN = 0 'resolução horizontal
Private Const SM_CYSCREEN = 1 'resolução vertical


Function Ver_Res()
Dim resoluc As String
Dim tit As String
resoluc = GetSysMetrics(SM_CXSCREEN) & "x" _
& GetSysMetrics(SM_CYSCREEN)

'MsgBox "Resolução atual é " & resoluc, vbInformation, tit

If resoluc = "1024x768" Then
MsgBox "Esta resolução " & resoluc & " é muito pequena!!!", vbExclamation, tit

ElseIf resoluc = "800x600" Then
MsgBox "A resolução " & resoluc & " é normalmente usada em todas aplicações!!!", vbExclamation, tit

ElseIf resoluc = "640x480" Then
MsgBox "Eita danada da letra grande esta " & resoluc & " !!!", vbExclamation, tit

Else
MsgBox "Não tenho palavras para definir esta resolução", vbCritical, tit
End If

'Chame a função no primeiro formulario que seu sistema abre,
' assim: call Ver_res
End Function


======

Espero que lhe sirva
Wellington Marinheiro