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 2012] SESSION WEBMATRIX 2 : LE COUTEAU SUISSE GRATUIT POUR VOS DéVELOPPEMENTS WEB - SLIDES[TECHDAYS 2012] SESSION WEBMATRIX 2 : LE COUTEAU SUISSE GRATUIT POUR VOS DéVELOPPEMENTS WEB - SLIDES par gpommier
Suite à la session que j'ai présenté sur WebMatrix 2, vous pouvez trouver les slides ici, ainsi que les démos en packages nuget : démos1 et démos2 J'en profite pour remercier chaleureusement tous ceux qui sont venus très nombreux à cette sess...
Cliquez pour lire la suite de l'article par gpommier [SHAREPOINT] LES SESSIONS TECHDAYS 2012.[SHAREPOINT] LES SESSIONS TECHDAYS 2012. par Patrick Guimonet
Voici donc pour ceux qui n'ont pas pu venir, ou ceux qui n'ont pas pu toutes les suivre la liste des sessions SharePoint aux TechDays 2012, que je mettrais à jour dès que les liens des vidéo seront disponibles. Ou ici : http...
Cliquez pour lire la suite de l'article par Patrick Guimonet TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3 par ROMELARD Fabrice
Speaker: Bernard Ourghanlian Cette session est comme chaque jour transmise en live par BrainSonic, et j'ai donc suivi cette troisième pleinière par ce moyen sur mon iPad . Elle est dédiée comme chaque année à la mise en perspective de l'é...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice MISHRA READER : UN LECTEUR RSS TRèS ZUNE STYLE EN OPEN SOURCE !MISHRA READER : UN LECTEUR RSS TRèS ZUNE STYLE EN OPEN SOURCE ! par Vko
Hier durant une session dédiée aux Techdays 2012, j'ai eu le plaisir d'annoncer la sortie de la Béta 2 de Mishra Reader. C'est quoi ? Pour les utilisateurs, c'est une vraie expérience de lecture de flux RSS sur Windows. Rien à voir avec les produit...
Cliquez pour lire la suite de l'article par Vko [FRAMEWORK 4] LES TASKS ET LE THREAD UI[FRAMEWORK 4] LES TASKS ET LE THREAD UI par fathi
Je viens de passer quelques temps au TechDay's et j'ai pu voir pas mal de session intéressante. Par contre une chose m'a un peu étonné lors de certaines de ces sessions qui abordaient les améliorations du framework .NET (donc le 4.5) : en gros, bea...
Cliquez pour lire la suite de l'article par fathi
Logiciels
Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System Easy-Planning (1.0.0.1)EASY-PLANNING (1.0.0.1)Basé sur les mêmes principes que MyPlanning, Easy-Planning permet de créer des plannings sous la ... Cliquez pour télécharger Easy-Planning COLLECTOR PLUS (3.00B)COLLECTOR PLUS (3.00B)COLLECTOR PLUS version 3.00B est un logiciel utilisant une base de données alimentée par :
- L... Cliquez pour télécharger COLLECTOR PLUS PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V7.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V7.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO LettresFaciles 2011 (8.0.0.1)LETTRESFACILES 2011 (8.0.0.1)LettresFaciles est un logiciel facilitant la création et la rédaction de lettres types.
Son inte... Cliquez pour télécharger LettresFaciles 2011
|