Accueil > > > MODIFIER CORRECTEMENT LA RESOLUTION DE L'ECRAN
 MODIFIER CORRECTEMENT LA RESOLUTION DE L'ECRAN
 Information sur la source
 Description
J'ai trouvé plusieurs sources pour modifier la résolution d'écran sur ce site, mais à chaque fois, la barre des taches n'était pas déplacée. Si on augmentait la résolution, on se retrouvait avec une barre des taches vers le milieu de l'écran, et en la réduisant, on avait une barre des taches en dehors de l'écran. Cette source corrige ce problème. MISE A JOUR : - La fonction SetRes est plus "intelligente" : lorsqu'un paramètre passé est identique à la valeur courante, cette dernière n'est plus modifiée. - Les fonctions GetResX et GetResY font maintenant directement appel aux API (plus de Screen.). Avec l'ancienne méthode, lorqu'on testait la résolution juste après l'avoir modifiée, on avait les anciennes valeurs.
 Source
- Option Explicit
-
- 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 Type DEVMODE
- dmDeviceName As String * 32
- 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 * 32
- dmUnusedPadding As Integer
- dmBitsPerPel As Integer
- dmPelsWidth As Long
- dmPelsHeight As Long
- dmDisplayFlags As Long
- dmDisplayFrequency As Long
- End Type
- Public Enum EnumSetRes
- SUCCES = 0
- ECHEC = -2
- End Enum
-
- Public Function GetNbCoul() As Integer
- Dim dmEcran As DEVMODE
- Dim blTMP As Boolean
- blTMP = EnumDisplaySettings(0, -1, dmEcran)
- GetNbCoul = dmEcran.dmBitsPerPel
- End Function
- Public Function GetResX() As Integer
- Dim dmEcran As DEVMODE
- EnumDisplaySettings 0, -1, dmEcran
- GetResX = dmEcran.dmPelsWidth
- ' GetResX = Screen.Width \ Screen.TwipsPerPixelX
- End Function
- Public Function GetResY() As Integer
- Dim dmEcran As DEVMODE
- EnumDisplaySettings 0, -1, dmEcran
- GetResY = dmEcran.dmPelsHeight
- ' GetResY = Screen.Height \ Screen.TwipsPerPixelY
- End Function
- Public Function SetRes(ByVal RezX As Single, ByVal RezY As Single, ByVal NbCoul As Integer) As EnumSetRes
- If RezX = GetResX And RezY = GetResY And NbCoul = GetNbCoul Then Exit Function
- Dim dmEcran As DEVMODE
- Dim blTMP As Boolean, lgTMP As Long
- blTMP = EnumDisplaySettings(0, -1, dmEcran)
- 'dmEcran.dmFields = 1835008
- If RezX <> GetResX Then dmEcran.dmFields = &H80000
- If RezY <> GetResY Then dmEcran.dmFields = dmEcran.dmFields Or &H100000
- If NbCoul <> GetNbCoul Then dmEcran.dmFields = dmEcran.dmFields Or &H100000
- dmEcran.dmPelsWidth = RezX
- dmEcran.dmPelsHeight = RezY
- dmEcran.dmBitsPerPel = NbCoul
- Call ChangeDisplaySettings(dmEcran, 1)
- blTMP = SendMessage(65535, 27, 0, 0)
- Dim ScInfo As Long
- ScInfo = RezY * 2 ^ 16 + RezX
- SendMessage &HFFFF&, &H7E, ByVal NbCoul, ByVal ScInfo
- SetRes = lgTMP
- End Function
Option Explicit
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 Type DEVMODE
dmDeviceName As String * 32
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 * 32
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Public Enum EnumSetRes
SUCCES = 0
ECHEC = -2
End Enum
Public Function GetNbCoul() As Integer
Dim dmEcran As DEVMODE
Dim blTMP As Boolean
blTMP = EnumDisplaySettings(0, -1, dmEcran)
GetNbCoul = dmEcran.dmBitsPerPel
End Function
Public Function GetResX() As Integer
Dim dmEcran As DEVMODE
EnumDisplaySettings 0, -1, dmEcran
GetResX = dmEcran.dmPelsWidth
' GetResX = Screen.Width \ Screen.TwipsPerPixelX
End Function
Public Function GetResY() As Integer
Dim dmEcran As DEVMODE
EnumDisplaySettings 0, -1, dmEcran
GetResY = dmEcran.dmPelsHeight
' GetResY = Screen.Height \ Screen.TwipsPerPixelY
End Function
Public Function SetRes(ByVal RezX As Single, ByVal RezY As Single, ByVal NbCoul As Integer) As EnumSetRes
If RezX = GetResX And RezY = GetResY And NbCoul = GetNbCoul Then Exit Function
Dim dmEcran As DEVMODE
Dim blTMP As Boolean, lgTMP As Long
blTMP = EnumDisplaySettings(0, -1, dmEcran)
'dmEcran.dmFields = 1835008
If RezX <> GetResX Then dmEcran.dmFields = &H80000
If RezY <> GetResY Then dmEcran.dmFields = dmEcran.dmFields Or &H100000
If NbCoul <> GetNbCoul Then dmEcran.dmFields = dmEcran.dmFields Or &H100000
dmEcran.dmPelsWidth = RezX
dmEcran.dmPelsHeight = RezY
dmEcran.dmBitsPerPel = NbCoul
Call ChangeDisplaySettings(dmEcran, 1)
blTMP = SendMessage(65535, 27, 0, 0)
Dim ScInfo As Long
ScInfo = RezY * 2 ^ 16 + RezX
SendMessage &HFFFF&, &H7E, ByVal NbCoul, ByVal ScInfo
SetRes = lgTMP
End Function
 Conclusion
Le fichier ZIP contient un projet de test très simple.
Je vous recommande de tester ce code dans un programm compilé, car l'environnement de développement de VB peut (parfois) planter lors du changement de résolution (c'est également la cas si vous la changez avec le Panneau de Configuration).
Ce code a été testé et fonctionne sous :
- Win95
- Win98SE
- WinXP
- WinME
- WinNT4 (SP6)
- Win2k
Si vous testez ce code sous une autre version de Windows, merci de laisser un commentaire afin d'indiquer si ce code fonctionne ou non.
 Sources du même auteur
 Sources de la même categorie
 Commentaires et avis
|
Derniers Blogs
 [WP7] DYNAMICALLY CHANGE STARTUP PAGE[WP7] DYNAMICALLY CHANGE STARTUP PAGE par KooKiz
Let's say that you want to allow the user to customize the startup page of your application. You can easily change the startup page by editing the 'NavigationPage' attribute in the manifest file. But the manifest cannot be modified once the applicatio...
Cliquez pour lire la suite de l'article par KooKiz SESSION SILVERLIGHT 5 3D : SLIDES ET DEMOSSESSION SILVERLIGHT 5 3D : SLIDES ET DEMOS par Groc
Durant les techdays, j'ai eu le plaisir d'animer une session sur Silverlight 5 et la 3D avec Simon Ferquel. Comme promis, voici nos slides et mes démos (celles avec le viper BSG) ici et là. Pour mémoire, les démos utilisent toutes le viper BSG...
Cliquez pour lire la suite de l'article par Groc [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
Logiciels
 Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.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 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
|