A voir également:
- [VBS] taille écran
- Comment réduire la taille d'un fichier - Guide
- Double ecran - Guide
- Capture d'écran samsung - Guide
- Ecran noir pc - Guide
- Retourner ecran windows - Guide
8 réponses
Zakapuce
Messages postés
64
Date d'inscription
mercredi 2 janvier 2008
Statut
Membre
Dernière intervention
5 août 2011
7
30 janv. 2008 à 14:13
30 janv. 2008 à 14:13
ça prend 3 minutes sur Google :
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 CCDEVICENAME = 32
Private Const CCFORMNAME = 32
Private Const DM_BITSPERPEL = &H60000
Private Const DM_PELSWIDTH = &H80000
Private Const DM_PELSHEIGHT = &H100000
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
' Inputsim RetValue As Integer
RetValue = ChangeRes(800, 600, 32)
'
' Returns:1 = Resolution Successfully Ch
' anged
0 = Resolution Was Not Changed
Function ChangeRes(Width As Single, Height As Single, BPP As Integer) As Integer
On Error GoTo ERROR_HANDLER
Dim DevM As DEVMODE, I As Integer, ReturnVal As Boolean, _
RetValue, OldWidth As Single, OldHeight As Single, _
OldBPP As Integer
Call EnumDisplaySettings(0&, -1, DevM)
OldWidth = DevM.dmPelsWidth
OldHeight = DevM.dmPelsHeight
OldBPP = DevM.dmBitsPerPel
I = 0
Do
ReturnVal = EnumDisplaySettings(0&, I, DevM)
I = I + 1
Loop Until (ReturnVal = False)
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
DevM.dmPelsWidth = Width
DevM.dmPelsHeight = Height
DevM.dmBitsPerPel = BPP
Call ChangeDisplaySettings(DevM, 1)
RetValue = MsgBox("Do You Wish To Keep Your Screen Resolution To " & Width & "x" & Height & " - " & BPP & " BPP?", vbQuestion + vbOKCancel, "Change Resolution Confirm:")
If RetValue = vbCancel Then
DevM.dmPelsWidth = OldWidth
DevM.dmPelsHeight = OldHeight
DevM.dmBitsPerPel = OldBPP
Call ChangeDisplaySettings(DevM, 1)
MsgBox "Old Resolution(" & OldWidth & " x " & OldHeight & ", " & OldBPP & " Bit) Successfully Restored!", vbInformation + vbOKOnly, "Resolution Confirm:"
ChangeRes = 0
Else
ChangeRes = 1
End If
Exit Function
ERROR_HANDLER:
ChangeRes = 0
End Function
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 CCDEVICENAME = 32
Private Const CCFORMNAME = 32
Private Const DM_BITSPERPEL = &H60000
Private Const DM_PELSWIDTH = &H80000
Private Const DM_PELSHEIGHT = &H100000
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
' Inputsim RetValue As Integer
RetValue = ChangeRes(800, 600, 32)
'
' Returns:1 = Resolution Successfully Ch
' anged
0 = Resolution Was Not Changed
Function ChangeRes(Width As Single, Height As Single, BPP As Integer) As Integer
On Error GoTo ERROR_HANDLER
Dim DevM As DEVMODE, I As Integer, ReturnVal As Boolean, _
RetValue, OldWidth As Single, OldHeight As Single, _
OldBPP As Integer
Call EnumDisplaySettings(0&, -1, DevM)
OldWidth = DevM.dmPelsWidth
OldHeight = DevM.dmPelsHeight
OldBPP = DevM.dmBitsPerPel
I = 0
Do
ReturnVal = EnumDisplaySettings(0&, I, DevM)
I = I + 1
Loop Until (ReturnVal = False)
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
DevM.dmPelsWidth = Width
DevM.dmPelsHeight = Height
DevM.dmBitsPerPel = BPP
Call ChangeDisplaySettings(DevM, 1)
RetValue = MsgBox("Do You Wish To Keep Your Screen Resolution To " & Width & "x" & Height & " - " & BPP & " BPP?", vbQuestion + vbOKCancel, "Change Resolution Confirm:")
If RetValue = vbCancel Then
DevM.dmPelsWidth = OldWidth
DevM.dmPelsHeight = OldHeight
DevM.dmBitsPerPel = OldBPP
Call ChangeDisplaySettings(DevM, 1)
MsgBox "Old Resolution(" & OldWidth & " x " & OldHeight & ", " & OldBPP & " Bit) Successfully Restored!", vbInformation + vbOKOnly, "Resolution Confirm:"
ChangeRes = 0
Else
ChangeRes = 1
End If
Exit Function
ERROR_HANDLER:
ChangeRes = 0
End Function
essaye ceci
Private Sub Form_Load()
Dim X As Long
Dim Y As Long
' Largeur
X = (Screen.Width \ Screen.TwipsPerPixelX)
' Hauteur
Y = (Screen.Height \ Screen.TwipsPerPixelY)
MsgBox "Voila la résolution de l'écran: " & Chr$(13) & Chr$(13) & X & "x" & Y, vbOkOnly + vbInformation, "Résolution"
End Sub
By
Private Sub Form_Load()
Dim X As Long
Dim Y As Long
' Largeur
X = (Screen.Width \ Screen.TwipsPerPixelX)
' Hauteur
Y = (Screen.Height \ Screen.TwipsPerPixelY)
MsgBox "Voila la résolution de l'écran: " & Chr$(13) & Chr$(13) & X & "x" & Y, vbOkOnly + vbInformation, "Résolution"
End Sub
By
Utilisateur anonyme
30 janv. 2008 à 14:07
30 janv. 2008 à 14:07
Rebonjour,
J'ai mis le code dans mon script, mais il y a des erreurs. Je pense parce que c'est du Visual Basic, et non du Visual Basic SCRIPT (VBS).
Enfin, merci quand même.
J'ai mis le code dans mon script, mais il y a des erreurs. Je pense parce que c'est du Visual Basic, et non du Visual Basic SCRIPT (VBS).
Enfin, merci quand même.
tarek_dotzero
Messages postés
817
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
12 avril 2022
120
30 janv. 2008 à 14:31
30 janv. 2008 à 14:31
J'ai fait une petite recherche, mais j'ai rien trouvé pour le VBS, mais je pense que cela va aider
http://www.google.com/codesearch?hl=fr&q=+createobject+screen+vbs+show:kuV_P5dKAzc:trHQnsR6BiU:OEvYCGwzuGo&sa=N&cd=7&ct=rc&cs_p=http://gentoo.osuosl.org/distfiles/awstats-6.5.tar.gz&cs_f=awstats-6.5/wwwroot/js/awstats_misc_tracker.js
http://www.google.com/codesearch?hl=fr&q=+createobject+screen+vbs+show:kuV_P5dKAzc:trHQnsR6BiU:OEvYCGwzuGo&sa=N&cd=7&ct=rc&cs_p=http://gentoo.osuosl.org/distfiles/awstats-6.5.tar.gz&cs_f=awstats-6.5/wwwroot/js/awstats_misc_tracker.js
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Utilisateur anonyme
31 janv. 2008 à 21:26
31 janv. 2008 à 21:26
ZAKAPUCE J'AI DIT PAS DE VISUAL BASIC!
heu, dit, tarek_dotzero, j'ai rien compris à ce qu'il y a marqué sur la page!
C'est très compliqué!
heu, dit, tarek_dotzero, j'ai rien compris à ce qu'il y a marqué sur la page!
C'est très compliqué!
Polux31
Messages postés
6917
Date d'inscription
mardi 25 septembre 2007
Statut
Membre
Dernière intervention
1 novembre 2016
1 204
1 févr. 2008 à 06:47
1 févr. 2008 à 06:47
Les instructions sont les mêmes en VB et VBS ... voir : https://tahe.developpez.com/web/vbscript/?page=sommaire
Utilisateur anonyme
1 févr. 2008 à 19:58
1 févr. 2008 à 19:58
Je suis d'accord avec ce que tu dis, mais en VBS les forms n'existent pas. Alors Form1.Load (par ex.) ne veut rien dire pour Wscript.
Je vais tenter de trouver la résolution par le registre.
Je vais tenter de trouver la résolution par le registre.
Si tu travailles sous Windows, les WMI sont là pour ça...
Voici un code qui pourra t'aider ;)
Voici un code qui pourra t'aider ;)
Dim gfx, colours, horiz, vert strComputer = "." Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") Set colItems = objWMIService.ExecQuery _ ("Select * From Win32_DisplayConfiguration") For Each objItem in colItems gfx = "Name: " & objItem.DeviceName colours = "Color depth: " & objItem.BitsPerPel horiz = "Horizontal resolution: " & objItem.PelsWidth vert = "Vertical resolution: " & objItem.PelsHeight Next msgbox gfx & vbcrlf & colours & vbcrlf & horiz & vbcrlf & vert