Changer la resolution de l'ecran en vb

Soyez le premier à donner votre avis sur cette source.

Snippet vu 25 094 fois - Téléchargée 31 fois

Contenu du snippet

Ce bout de code permet de modifier la resolution de l'ecran à partir d'un programme VB, c'est un code VB.NET mis à jour à partir d'un code VB6, donc si quelqu'un à une autre methode purement DotNet je le remercie de la partager !

Source / Exemple :


'Faire l'import suivant 
Imports System.Runtime.InteropServices

'le code à placer dans un module par exemple :

Private Declare Auto Function EnumDisplaySettings Lib "user32.dll" (<MarshalAs(UnmanagedType.LPTStr)> ByVal lpszDeviceName As String, ByVal iModeNum As Int32, ByRef lpDevMode As DEVMODE) As Boolean
    Private Declare Auto Function ChangeDisplaySettings Lib "user32.dll" (ByRef lpDevMode As DEVMODE, ByVal dwFlags As Int32) As Int32
    Private Const DM_BITSPERPEL As Int32 = &H40000
    Private Const DM_PELSWIDTH As Int32 = &H80000
    Private Const DM_PELSHEIGHT As Int32 = &H100000

    Private Const DISP_CHANGE_SUCCESSFUL As Int32 = 0

    <StructLayout(LayoutKind.Sequential)> _
    Private Structure POINTL
        Public x As Int32
        Public y As Int32
    End Structure

    <StructLayout(LayoutKind.Explicit)> _
    Private Structure DEVMODE_union1
        ' struct {
        <FieldOffset(0)> Public dmOrientation As Int16
        <FieldOffset(2)> Public dmPaperSize As Int16
        <FieldOffset(4)> Public dmPaperLength As Int16
        <FieldOffset(6)> Public dmPaperWidth As Int16
        ' }
        <FieldOffset(0)> Public dmPosition As POINTL
    End Structure

    <StructLayout(LayoutKind.Explicit)> _
    Private Structure DEVMODE_union2
        <FieldOffset(0)> Public dmDisplayFlags As Int32
        <FieldOffset(0)> Public dmNup As Int32
    End Structure

    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _
    Private Structure DEVMODE
        Private Const CCDEVICENAME As Int32 = 32
        Private Const CCFORMNAME As Int32 = 32

        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=CCDEVICENAME)> _
        Public dmDeviceName As String
        Public dmSpecVersion As Int16
        Public dmDriverVersion As Int16
        Public dmSize As Int16
        Public dmDriverExtra As Int16
        Public dmFields As Int32
        Public u1 As DEVMODE_union1
        Public dmScale As Int16
        Public dmCopies As Int16
        Public dmDefaultSource As Int16
        Public dmPrintQuality As Int16
        Public dmColor As Int16
        Public dmDuplex As Int16
        Public dmYResolution As Int16
        Public dmTTOption As Int16
        Public dmCollate As Int16
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=CCFORMNAME)> _
        Public dmFormName As String
        Public dmUnusedPadding As Int16
        Public dmBitsPerPel As Int16
        Public dmPelsWidth As Int32
        Public dmPelsHeight As Int32
        Public u2 As DEVMODE_union2
        Public dmDisplayFrequency As Int32
        Public dmICMMethod As Int32
        Public dmICMIntent As Int32
        Public dmMediaType As Int32
        Public dmDitherType As Int32
        Public dmReserved1 As Int32
        Public dmReserved2 As Int32
        Public dmPanningWidth As Int32
        Public dmPanningHeight As Int32
    End Structure

    Public Function SetResolution(ByVal Width As Int32, ByVal Height As Int32, ByVal BitsPerPixel As Int16) As Boolean
        Dim dm As DEVMODE
        If Not EnumDisplaySettings(Nothing, 0, dm) Then
            Return False
        Else
            With dm
                .dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
                .dmPelsWidth = Width
                .dmPelsHeight = Height
                .dmBitsPerPel = BitsPerPixel
            End With
            Return (ChangeDisplaySettings(dm, 0) = DISP_CHANGE_SUCCESSFUL)
        End If
    End Function

'Pour changer la résolution il suffit d'appeler la methode SetResolution de la manière suivante :

'ex pour passer à un affichage 1024/768 en couleurs 32 bits

Debug.Assert(SetResolution(1024, 768, 32)

Conclusion :


Merci de reporter les bugs généres à cause de ce code, Thanks ;-)

A voir également

Ajouter un commentaire Commentaires
Messages postés
8
Date d'inscription
mercredi 31 décembre 2008
Statut
Membre
Dernière intervention
2 mai 2012

Merci du coup de pouce!
Juste un petit bémol, tout se passe bien mis à part que les icônes du bureau ne reconnaissent pas la nouvelle résolution (Pour ma part je les place à l'horizontal)..
La partie droite (sur [à peu près] 1/5e de la largeur d'écran n'est pas disponible pour le placement des icônes)... Peut-être y-a t-il une solution ?
Messages postés
15
Date d'inscription
jeudi 15 mai 2008
Statut
Membre
Dernière intervention
2 mai 2011

Etant débutant en VB.NET, serait il possible d'avoir une explication du code (la plus detaillée possible selon votre temps) car effectivement il fonctionne a merveille

Merci beaucoup
Messages postés
69
Date d'inscription
samedi 22 décembre 2007
Statut
Membre
Dernière intervention
12 mai 2013

Ben ouais, faut attribuer une valeur à toutes les variables déclarées... lol
Mais dans ce cas-là, ça fait rien de spécial. No worry ;))
Messages postés
257
Date d'inscription
jeudi 11 septembre 2008
Statut
Membre
Dernière intervention
22 décembre 2012
1
effectivement ta solution permet de ne plus avoir d'avertissement..


Cool
Messages postés
4
Date d'inscription
lundi 22 mars 2010
Statut
Membre
Dernière intervention
21 juillet 2010

On peut "corriger" le problème de la façon suivante :

Dim dm As DEVMODE = Nothing

Bonne continuation !
Afficher les 19 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.