Accueil > > > GESTION RÉSOLUTION ÉCRAN
GESTION RÉSOLUTION ÉCRAN
Information sur la source
Description
encor une modif résolution écran mais avec la gestion de la fréquence et du mode couleur. Il marche sous VB6 et W2k. Faites moi savoir si il tourne sous les autres Win.
Source
-
-
- Public oldX, oldY, oldR, oldC As Long ' Résolution écran avant application
-
-
- 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 Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
- ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) 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
-
- Private Const CCHDEVICENAME = 32
- Private Const CCHFORMNAME = 32
-
- Private Const DM_BITSPERPEL = &H40000
- Private Const DM_WIDTH = &H80000
- Private Const DM_HEIGHT = &H100000
- Private Const DM_DISPLAYFREQUENCY = &H400000
- Private Const WM_DEVMODECHANGE = &H1B
- Private Const HWND_BROADCAST = &HFFFF&
- Private Const HWND_DESKTOP = 0
-
- Const TOGGLE_HIDEWINDOW = &H80
- Const TOGGLE_UNHIDEWINDOW = &H40
-
- Private Type DEVMODE
- dmDeviceName As String * CCHDEVICENAME
- 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 * CCHFORMNAME
- dmUnusedPadding As Integer
- dmBitsPerPel As Integer
- dmPelsWidth As Long
- dmPelsHeight As Long
- dmDisplayFlags As Long
- dmDisplayFrequency As Long
- End Type
-
- Dim dmEcran As DEVMODE
- Dim dynSetting() As String
-
- Dim handleW1 As Long
-
- ' =================================== DEBUT DU CODE ================================
- '---- Change la résolution écran
-
- Public Sub ResolutionEcran(Chge As Boolean, sgWidth As Long, sgHeight As Long)
- Dim blTMP As Boolean
- Dim lgTMP As Long
- Dim compt As Integer
-
- If Chge = True Then ' modification de la résolution - début du programme
-
- blTMP = EnumDisplaySettings(0, -1, dmEcran) ' stockage de la résolution écran avant modif
- oldX = dmEcran.dmPelsWidth
- oldY = dmEcran.dmPelsHeight
- oldR = dmEcran.dmDisplayFrequency
- oldC = dmEcran.dmBitsPerPel
-
- If Not oldX = sgWidth Then ' si la résolution est différente de la résolution demandée
-
- lgTMP = 0
- cpt = 0 ' compteur d'affichage
-
- ReDim dynSetting(0)
- Do ' parcours tous les affichages possibles
- blTMP = EnumDisplaySettings(0, lgTMP, dmEcran)
- lgTMP = lgTMP + 1
-
- If dmEcran.dmPelsWidth = sgWidth Then ' si résolution demandée
- dynSetting(cpt) = Right("000" & dmEcran.dmBitsPerPel, 3) & _
- Right("000" & dmEcran.dmDisplayFrequency, 3)
- cpt = cpt + 1
- ReDim Preserve dynSetting(cpt)
- End If
- Loop Until Not blTMP
-
- ' right(dynSetting(cpt - 1),3) ' Fréquence maximale acceptée par la carte
- ' left(dynSetting(cpt - 1),3) ' Mode couleur maxi accepté par la carte
-
- For compt = cpt - 1 To 0 Step -1
- If CLng(Left(dynSetting(compt), 3)) = oldC Then
- If CLng(Right(dynSetting(compt), 3)) = oldR Then ' si même mode couleur et même fréquence
- Exit For
- Else ' même mode couleur mais fréquence inférieure
- If CLng(Right(dynSetting(compt), 3)) > 71 Then ' contrainte sur la fréquence 72Hz
- Exit For
- End If
- End If
- Else ' mode couleur inférieur
- If CLng(Right(dynSetting(comp), 3)) = oldR Then
- Exit For
- Else
- If CLng(Right(dynSetting(comp), 3)) > 71 Then ' contrainte sur la fréquence 72Hz
- Exit For
- End If
- End If
- End If
- Next
- If cpt = 0 Then
- 'alerte : votre système ne supporte pas la résolution demandée
- End
- End If
-
- Call Change(sgWidth, sgHeight, CLng(Left(dynSetting(compt), 3)), CLng(Right(dynSetting(compt), 3)))
- End If
-
- Else ' modification de la résolution - fin du programme
- Call Change((oldX), (oldY), (oldC), (oldR))
- End If
- End Sub
-
- Private Sub Change(width As Long, height As Long, pel As Long, freq As Long)
-
- dmEcran.dmFields = DM_BITSPERPEL Or DM_WIDTH Or DM_HEIGHT Or DM_DISPLAYFREQUENCY
- dmEcran.dmPelsWidth = width
- dmEcran.dmPelsHeight = height
- dmEcran.dmBitsPerPel = pel
- dmEcran.dmDisplayFrequency = freq
-
- lgTMP = ChangeDisplaySettings(dmEcran, 0)
- Call SendMessage(HWND_BROADCAST, WM_DEVMODECHANGE, 0, 0)
- End Sub
-
Public oldX, oldY, oldR, oldC As Long ' Résolution écran avant application
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 Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) 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
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
Private Const DM_BITSPERPEL = &H40000
Private Const DM_WIDTH = &H80000
Private Const DM_HEIGHT = &H100000
Private Const DM_DISPLAYFREQUENCY = &H400000
Private Const WM_DEVMODECHANGE = &H1B
Private Const HWND_BROADCAST = &HFFFF&
Private Const HWND_DESKTOP = 0
Const TOGGLE_HIDEWINDOW = &H80
Const TOGGLE_UNHIDEWINDOW = &H40
Private Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
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 * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Dim dmEcran As DEVMODE
Dim dynSetting() As String
Dim handleW1 As Long
' =================================== DEBUT DU CODE ================================
'---- Change la résolution écran
Public Sub ResolutionEcran(Chge As Boolean, sgWidth As Long, sgHeight As Long)
Dim blTMP As Boolean
Dim lgTMP As Long
Dim compt As Integer
If Chge = True Then ' modification de la résolution - début du programme
blTMP = EnumDisplaySettings(0, -1, dmEcran) ' stockage de la résolution écran avant modif
oldX = dmEcran.dmPelsWidth
oldY = dmEcran.dmPelsHeight
oldR = dmEcran.dmDisplayFrequency
oldC = dmEcran.dmBitsPerPel
If Not oldX = sgWidth Then ' si la résolution est différente de la résolution demandée
lgTMP = 0
cpt = 0 ' compteur d'affichage
ReDim dynSetting(0)
Do ' parcours tous les affichages possibles
blTMP = EnumDisplaySettings(0, lgTMP, dmEcran)
lgTMP = lgTMP + 1
If dmEcran.dmPelsWidth = sgWidth Then ' si résolution demandée
dynSetting(cpt) = Right("000" & dmEcran.dmBitsPerPel, 3) & _
Right("000" & dmEcran.dmDisplayFrequency, 3)
cpt = cpt + 1
ReDim Preserve dynSetting(cpt)
End If
Loop Until Not blTMP
' right(dynSetting(cpt - 1),3) ' Fréquence maximale acceptée par la carte
' left(dynSetting(cpt - 1),3) ' Mode couleur maxi accepté par la carte
For compt = cpt - 1 To 0 Step -1
If CLng(Left(dynSetting(compt), 3)) = oldC Then
If CLng(Right(dynSetting(compt), 3)) = oldR Then ' si même mode couleur et même fréquence
Exit For
Else ' même mode couleur mais fréquence inférieure
If CLng(Right(dynSetting(compt), 3)) > 71 Then ' contrainte sur la fréquence 72Hz
Exit For
End If
End If
Else ' mode couleur inférieur
If CLng(Right(dynSetting(comp), 3)) = oldR Then
Exit For
Else
If CLng(Right(dynSetting(comp), 3)) > 71 Then ' contrainte sur la fréquence 72Hz
Exit For
End If
End If
End If
Next
If cpt = 0 Then
'alerte : votre système ne supporte pas la résolution demandée
End
End If
Call Change(sgWidth, sgHeight, CLng(Left(dynSetting(compt), 3)), CLng(Right(dynSetting(compt), 3)))
End If
Else ' modification de la résolution - fin du programme
Call Change((oldX), (oldY), (oldC), (oldR))
End If
End Sub
Private Sub Change(width As Long, height As Long, pel As Long, freq As Long)
dmEcran.dmFields = DM_BITSPERPEL Or DM_WIDTH Or DM_HEIGHT Or DM_DISPLAYFREQUENCY
dmEcran.dmPelsWidth = width
dmEcran.dmPelsHeight = height
dmEcran.dmBitsPerPel = pel
dmEcran.dmDisplayFrequency = freq
lgTMP = ChangeDisplaySettings(dmEcran, 0)
Call SendMessage(HWND_BROADCAST, WM_DEVMODECHANGE, 0, 0)
End Sub
Conclusion
A mettre dans un module et appeler la Sub ResolutionEcran(Chge As Boolean, sgWidth As Long, sgHeight As Long)
Sources de la même categorie
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
APPLICATION DANS TOUTES LES RESOLUTIONS D'ECRAN [ par serge ]
j'ai fait une application avec ma résolution écran 1024x768 mais lorsque je la visualise en 800x600, il me manque une grande partie d'écran et impossi
Prob. Résolution Ecran [ par dave ]
bonjour à tous,mon but est de changer par programmation la résolution de l'écran.Lorsque j'utilise les modules disponibles sur ce site, si l'écran est
Résolution d'ecran sur Excel et VBA [ par Quecks ]
Slt,je crée des userform avec une résolution 800*600 mais lorsque je les envoie à ceux qui travail avec une résolution 1024*768, les userform ne couvr
TAIILE DE FENTRE ET RESOLUTION D'ECRAN [ par acidburn23 ]
Comment faire pour que la taille de ma fenetre soit proportionnelle à la résolution de l'ecran. Par exemple, mon appli doit pouvoir tourner sous une r
Plein Ecran & changement de résolution [ par MaDC ]
Salut!Je voudrais juste savoir :1) comment faire pour avoir mon application qui se lance en plein ecran comme un programme DOS et ainsi ne plus avoir
Résolution d'ecran SANS VB6FR.dll ! (sos) [ par loskiller62 ]
Je voudrais récuperer la résolution d'écran mais sans ke le prog ai besoin du fichier vb6fr.dllle coup du screen.width etcle coup du Private Declare F
résolution ecran pr page web! très important [ par supernulle ]
helloG réalisé un site en 1024*768 en fait j'aurais voulu savoir s'il y avait une solution pr tous ceux ki ont une résolution en 800/600 voit mon site
résolution d ecran !! [ par supernulle ]
helloG réalisé un site en 1024*768 en fait j'aurais voulu savoir s'il y avait une solution pr tous ceux ki ont une résolution en 800/600 voit mon site
raccourcie clavier et résolution d'ecran [ par vick46 ]
bonjour, j'ai fait un peu le tour du site et je ne trouve pas vraiment ce que je cherchemon probleme est que j'ai deux moniteur sur le meme pc qui bas
Résolution Ecran [ par Sinsitrus ]
Salut a tousJ'ai fouillé un peu partout ici pour trouver ce que je cherche mais en fait voilà, je voudrais qu'au lancement de mon appli, je voudrais q
|
Derniers Blogs
TECHDAYS PARIS 2010 : CONNECTEZ VOS DONNéES à SHAREPOINT 2010 AVEC LES BUSINESS CONNECTIVITY SERVICESTECHDAYS PARIS 2010 : CONNECTEZ VOS DONNéES à SHAREPOINT 2010 AVEC LES BUSINESS CONNECTIVITY SERVICES par ROMELARD Fabrice
Animé par: Gaetan Bouveret et Julien Chomarat Business Connectivity Services (BCS) est dans SharePoint 2010 la version 2 de Business Data Catalog (BDC dans SharePoint 2007). Il s'agit de la solution permettant de visualiser des données provenan...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice [DIVERS] SUIVRE VOS SéRIES PRéFéRéS SUR LA TOILE[DIVERS] SUIVRE VOS SéRIES PRéFéRéS SUR LA TOILE par orion
Comme de nombreux geek, je suis un grand amateur de série TV et je rate régulièrement des épisodes de mes séries préférés. Une solution s'offre à vous avec ce merveilleux site : Tv Gorge - www.tvgorge.com Moteur de recherche à l'appui, vous pouvez ...
Cliquez pour lire la suite de l'article par orion TECHDAYS PARIS 2010 : LA BI DANS SHAREPOINT 2010TECHDAYS PARIS 2010 : LA BI DANS SHAREPOINT 2010 par ROMELARD Fabrice
Animé par: Vincent Bellet et Baptiste Giraudier La BI dans SharePoint 2010, Les nouveaux services d'application dans SP2010 et SQL Server Reporting services 2008 R2. La BI dans SharePoint est généralisée pour tous afin de permettre à tous les coll...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice TECHDAYS PARIS 2010 : PLAN DE MIGRATION VERS SHAREPOINT 2010TECHDAYS PARIS 2010 : PLAN DE MIGRATION VERS SHAREPOINT 2010 par ROMELARD Fabrice
Animé par: Arnault Nouvel et Antoine Dongois Le processus à prendre : Apprendre (découvrir la plateforme) Préparer (documenter l'historique et choisir la méthode de MAJ) Test (Test de MAJ) Implémenter (Effectuer la MAJ) Valid...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Logiciels
DB-MAIN (9.1.0)DB-MAIN (9.1.0)DB-MAIN is a data-modeling and data-architecture tool. It is designed to help developers and anal... Cliquez pour télécharger DB-MAIN Xilisoft DPG Convertisseur (5.1.37.0120)XILISOFT DPG CONVERTISSEUR (5.1.37.0120)Xilisoft DPG Convertisseur offre aux fans de Nintendo DS une bonne solution leur permettant de dé... Cliquez pour télécharger Xilisoft DPG Convertisseur GraphicsGale (2.01.01)GRAPHICSGALE (2.01.01)GraphicsGale est un logiciel de PixelArt avec de nombreuse fonctionnalités permettant de réalisé ... Cliquez pour télécharger GraphicsGale Architecte 3D (Platinum 2010)ARCHITECTE 3D (PLATINUM 2010)Architecte 3D Platinium vous permet de concevoir facilement les plans votre future maison, de l'é... Cliquez pour télécharger Architecte 3D TeamViewer 5 (TeamViewer 5)TEAMVIEWER 5 (TEAMVIEWER 5)Dépanner un ami,expliquer une manipulation devient un jeu d'enfant.
Prise en main d'un autre ord... Cliquez pour télécharger TeamViewer 5
|