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
COMMENT MAPPER UNE VUE SQL SUR UNE COLLECTION DE COMPLEX TYPE?COMMENT MAPPER UNE VUE SQL SUR UNE COLLECTION DE COMPLEX TYPE? par Matthieu MEZIL
Avec EF, les vues doivent être mappées sur des entity types. Le problème c'est que les entity types doivent avoir une clé. Avec EF, nous avons les complex type qui n'ont pas de clé mais les vues ne peuvent pas être mappées dessus. Avec EF4, il est possibl...
Cliquez pour lire la suite de l'article par Matthieu MEZIL [WF4] UN BINDING ACTIVITY/ACTIVITYDESIGNER QUI PASSE MAL?[WF4] UN BINDING ACTIVITY/ACTIVITYDESIGNER QUI PASSE MAL? par JeremyJeanson
Certain d'entre vous on peut être vécu cette situation embarrassante après quelques temps passer avec WF4 : Au début avec mon " ActivityDesigner" , tout allait bien. Et puis un jour j'ai au des problèmes de " Binding" . Alors nous sommes allé sur le site ...
Cliquez pour lire la suite de l'article par JeremyJeanson MYTIC - SHAREPOINT 2010 : DéJà UN MYTHE MICROSOFT ?MYTIC - SHAREPOINT 2010 : DéJà UN MYTHE MICROSOFT ? par junarnoalg
La prochaine session de MyTIC aura lieu à Namur, le 23 mars prochain. Pendant presque une heure, nous parlerons de SharePoint 2010. Voici un aperçu du programme.
Accueil : 17h30 Début de la session : 18h00 - Les nouvelles int...
Cliquez pour lire la suite de l'article par junarnoalg
Forum
DéFILEMENT TEXTEDéFILEMENT TEXTE par germany1970
Cliquez pour lire la suite par germany1970
Logiciels
Academy System (10.9.4.0)ACADEMY SYSTEM (10.9.4.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System Xilisoft Convertisseur Vidéo Ultimate (5.1.39.0305)XILISOFT CONVERTISSEUR VIDéO ULTIMATE (5.1.39.0305)Xilisoft Convertisseur Vidéo Ultimate est un outil puissant de conversion vidéo, facile à utilise... Cliquez pour télécharger Xilisoft Convertisseur Vidéo Ultimate Xilisoft DVD Ripper Ultimate (5.0.64.0304)XILISOFT DVD RIPPER ULTIMATE (5.0.64.0304)Xilisoft DVD Ripper Ultimate est un logiciel excellent pour copier et convertir DVD vers presque ... Cliquez pour télécharger Xilisoft DVD Ripper Ultimate Rigs of Rods (63.3)RIGS OF RODS (63.3)c'est un jeu de multi-simulation camions,autobus voitures, avions, bateaux, hélicoptère avec défo... Cliquez pour télécharger Rigs of Rods
|