Newsgroup: it.comp.appl.access
Titolo: Impostazione risoluzione video

Ennesimo aiuto.
Avrei bisogno di settare la risoluzione a video del computer dove viene
aperto il mio database.  Mi servirebbe  verificare la risoluzione video
corrente del pc (nessun problema) e se differente da 1024x768a  32 bit
impostarla a tale valore.
Ecco sulla seconda parte, ovvero sull'impostazione a video, ho qualche (è un
eufemismo) difficoltà.
Ho già visto l'applicazione creata da Carlo Costarella, ma non riesco a
districarmi  nel codice con successo. Esiste una routine "semplificata" per
fare questo senza dover scegliere da una lista il settaggio video?
Come si potrebbe gestire il caso in cui tale risoluzione non sia
disponibile?
Mi sa che sto esagerando.. comunque al vostro buon cuore.
Comunque se ho esagerato ...... capirò
grazie paolo

 ha scritto nel messaggio
news:j0FGa.89478$pR3.1...@news1.tin.it...

Io uso questo metodo:
Su apertura della maschera di avvio del database  inserisco
    checkRes
che è una funzione che imposta a 1024x768 la risoluzione se la trova
differente.
Ecco il listato.
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
Ciao, Buonuomo.


Mai nome fu più appropriato
La funzione .... funziona  (scusa la cacofonia) però mi accade una cosa  un
po' strana. Non appena da 800 x 600 l'applicazione imposta il monitor  a
1024 x 768 la barra di Windows la trovo a metà schermo ed access si apre con
una finestra non completamente aperta.
C'è un modo per risolvere la questione? Anche l'immagine del desktop (in
modalità estesa) quando cambio risoluzione risulta apparire in una parte
dello schermo e non a tutto schermo come è all'origine.
Immagino avrai impostato anche le variabili in modo che all'uscita
dell'applicazione riportino l'impostazione video originale.
Grazie buonuomo per l'aiuto
ciao paolo


Io ho messo, prima di richiamare la funzione,  il comando     Debug.Print
HideTaskbar()      ed il comando   Debug.Print UnhideTaskbar()   sul
pulsante di chiusura.
Probabilmente ci sarà un modo più elegante ma purtroppo non lo conosco !!!
Ciao, Buonuomo.

 ha scritto nel messaggio
news:ZS2Ha.90847$Ny5.2...@twister2.libero.it...

Ho provato ma non succede nulla. Sicuramente sbaglio in qualcosa. La
Hidetaskbar() è il richiamo ad una  funzione?  Se metto le parentesi,
Debug.print Hidetaskbar(), mi dice funzione non definita se le tolgo
Debug.print Hidetaskbar, non accade nulla.
Bisogna avere un po' di pazienza
grazie ancora
ciao paolo

...

Ho risolto ho trovato il codice per le funzioni.
grazie
paolo

 ha scritto nel messaggio
news:2Q8Ha.180412$g92.3...@news2.tin.it...

Chiedo scusa per l'errore di sbaglio, avevo dimenticato un pezzo di codice.
Crea un nuovo modulo ed inseriscici :
Option Compare Database
Option Explicit
Dim handleW1 As Long
Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As
String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal handleW1 As Long,
ByVal handleW1InsertWhere As Long, ByVal w As Long, ByVal x As Long, ByVal y
As Long, ByVal z As Long, ByVal wFlags As Long) As Long
Const TOGGLE_HIDEWINDOW = &H80
Const TOGGLE_UNHIDEWINDOW = &H40
Function HideTaskbar()
   handleW1 = FindWindowA("Shell_traywnd", "")
   Call SetWindowPos(handleW1, 0, 0, 0, 0, 0, TOGGLE_HIDEWINDOW)
End Function
Function UnhideTaskbar()
   Call SetWindowPos(handleW1, 0, 0, 0, 0, 0, TOGGLE_UNHIDEWINDOW)
End Function
Rubato dal sito di mamma Microsoft all'indirizzo:
http://support.microsoft.com/support/kb/articles/Q202/0/99.ASP
Ciao, Buonuomo.


Ciao, ho provato anch'io la tua soluzione. Effettivamente funziona cone dice
paolo, nel senso che non sposta la barra di avvio di Win.
E' possibile correggere questo piccolo bug.
ciao MAssiimliano
--------------------------------
Inviato via 
http://usenet.libero.it