Caros Colegas.

Preciso do socorro dos nobre colegas de plantão.

Já algum tempo venho desenvolvendo aplicativos em VB sob win98 e atualmente em win2000, e os quais foram instalados em maquinas win98 e win200.

Recentemente instalei em uma maq. com Win XP e tive a surpresa de verificar que as barras de titulos do WIN XP são mais largas que o win98/2000, e com isso prococou um scroll nas laterais da tela, pois a tela ficou com a área dos forms um pouco reduzidas. O cliente não ficou muito satisfeito em também eu. Como poderia estar solucionando este problema, talves alguma rotina que qdo. carregar os aplicativo estaria alterando alguma propriedade tela/monitor, mas só em tempo de execução.

Obrigados colegas.

Altere o visual do windows para windows classic.

Mas o cliente não quer que mude o visual do XP.

 

Fácil Kra.....faz assim

 

No módulo:

 

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

' muda resolução do vídeo
Public Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

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

 

No Form:

 

Public Sub MudaResolucao()
Dim t As Boolean
Dim s As Boolean
Dim r As RECT
t = True
s = True
    ' Neste ponto coloque a resolução que você deseja para seu programa. Se ele for diferente, ele vai chamar a rotina para alterar...
    ResX = 1024
    ResY = 768
    Call GetClipCursor(r)
    OldX = r.Right
    OldY = r.Bottom
If test = False Then
    'Vai testar agora se a resolução está correta ou se precisa ser alterada
    If OldX <> ResX And OldY <> ResY Then
    troq = MsgBox("Este programa está otimizado para computadores com resolução de vídeo de " & ResX & " X " & ResY & "." & vbNewLine & "Talvez não seja possível alterá-lo. Quer tentar alterar as resoluções agora?", vbQuestion + vbYesNo)
    test = True
    If troq = vbYes Then
        resolucao = True
        Call ChangeRes(ResX, ResY)
    Else
        resolucao = False
    End If
    Else
        resolucao = False
    End If
End If

End Sub

Public Sub VoltaNormal()
Dim t As Boolean
Dim s As Boolean
Dim r As RECT
t = True
s = True

If ResX = 1024 Then Exit Sub
    ' Neste ponto coloque a resolução que você deseja para seu programa. Se ele for diferente, ele vai chamar a rotina para alterar...
    ResX = 800
    ResY = 600
    Call GetClipCursor(r)
    OldX = r.Right
    OldY = r.Bottom
If test = False Then
    'Vai testar agora se a resolução está correta ou se precisa ser alterada
    If OldX <> ResX And OldY <> ResY Then
    troq = MsgBox("Este programa está otimizado para computadores com resolução de vídeo de " & ResX & " X " & ResY & "." & vbNewLine & "Talvez não seja possível alterá-lo. Quer tentar alterar as resoluções agora?", vbQuestion + vbYesNo)
    test = True
    If troq = vbYes Then
        resolucao = True
        Call ChangeRes(ResX, ResY)
    Else
        resolucao = False
    End If
    Else
        resolucao = False
    End If
End If
End
End Sub

Private Sub Form_Load()
MudaResolucao
End Sub

Private Sub Form_Terminate()
 If resolucao = True Then
        Call ChangeRes(OldX, OldY)
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
VoltaNormal
End Sub

 

Ai ele muda a resolução em tempo de execução......no caso eu to usando um msgbox pra ver se o usuário quer mesmo mudar a resolução....mas fica liga que alguns adaptadores de vídeo não suporta resolução 1024X768 e a tela fica tda loka...hehehe......bom é isso ae!!!