Newsgroup: it.comp.appl.access
Titolo: Cambio di risoluzione sballa la barra di windows

Cercando tra i vecchi messaggi del gruppo di google ho trovato il codice 
che allego che uso per mandare la risoluzione a 1024 x 768 all'avvio del 
database e per riportarla alla risoluzione precedente alla chiusura.
Il problema e' che quando la risoluzione cambia, la barra di windows 
finisce circa a meta' schermo e non si adatta in larghezza alla finestra.
Potete aiutarmi?
Allego il codice e aggiungo che,
1 non e' farina del mio sacco! (magari!)
2 per farlo funzionare si deve aggiungere all'evento "su apertura" della 
maschera principale (pannello comandi o altro) l'istruzione "checkRes" e 
all'evento "su chiusura" della stessa maschera l'struzione "ritRes"
ecco il codice del modulo da creare:
**************************************************************************
Option Compare Database
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
Private Const ENUM_CURRENT_SETTINGS = -1
Private Const CDS_FORCE As Long = &H80000000
Private Const DISP_CHANGE_SUCCESSFUL = 0
Private Const DM_PELSWIDTH As Long = &H80000
Private Const DM_PELSHEIGHT As Long = &H100000
Private Const CCDEVICENAME As Long = 32
Private Const CCFORMNAME As Long = 32
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
Private Type TRes
     lHoriz As Long
     lVert As Long
End Type
Global DM As DEVMODE
Global g_curRes As TRes
Private Function ChangeCurrentRes(newRes As TRes) As Boolean
     With DM
         .dmPelsWidth = newRes.lHoriz
         .dmPelsHeight = newRes.lVert
         .dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
         .dmSize = LenB(DM)
     End With
     If ChangeDisplaySettings(DM, CDS_FORCE) = DISP_CHANGE_SUCCESSFUL Then
         ChangeCurrentRes = True
     End If
End Function
Private Function GetCurrentRes() As TRes
     Dim DM As DEVMODE
     DM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
     DM.dmSize = LenB(DM)
     Call EnumDisplaySettings(0&, ENUM_CURRENT_SETTINGS, DM)
     GetCurrentRes.lHoriz = DM.dmPelsWidth
     GetCurrentRes.lVert = DM.dmPelsHeight
End Function
Public Sub checkRes()
     Dim curRes As TRes
     Dim newRes As TRes
     Dim bRes As Boolean
     If g_curRes.lHoriz = 0 Then
         curRes.lHoriz = GetCurrentRes.lHoriz
         curRes.lVert = GetCurrentRes.lVert
         'Modifica secondo le tue esigenze
         If curRes.lHoriz < 1024 Then
             newRes.lHoriz = 1024
             newRes.lVert = 768
             bRes = ChangeCurrentRes(newRes)
             If bRes = True Then
                 g_curRes = curRes
                 'MsgBox "La risoluzione è stata cambiata!", 
vbInformation,"Operazione eseguita"
             Else
                 MsgBox "Impossibile cambiare la risoluzione corrente.", 
vbCritical, "ERRORE"
             End If
         End If
     Else
         newRes = g_curRes
         bRes = ChangeCurrentRes(newRes)
         If Not bRes = True Then
             MsgBox "Impossibile reimpostare la risoluzione.", 
vbCritical, "ERRORE"
         End If
     End If
End Sub
Public Sub ritRes()
'Questo reimposta la risoluzione a quella precedente
     Dim curRes As TRes
     Dim newRes As TRes
     Dim bRes As Boolean
             newRes.lHoriz = curRes.lHoriz
             newRes.lVert = curRes.lVert
             bRes = ChangeCurrentRes(newRes)
             If bRes = True Then
                 g_curRes = curRes
             End If
End Sub
**************************************************************************

 Option Compare Database






un'idea cha mi viene è quella di ridurre a icona l'applicativo access e
poi ingrandirlo
prova con
appAccess.DoCmd.RunCommand 11
appAccess.DoCmd.RunCommand 10
ciao e spero funzioni
-- 
questo articolo e` stato inviato via web dal servizio gratuito 
http://www.newsland.it/news
 segnala gli abusi ad 
ab...@newsland.it