Changer le papier-peint de windows avec fondu visuel

Soyez le premier à donner votre avis sur cette source.

Vue 14 474 fois - Téléchargée 813 fois

Description

Le programme ChangeWallpaper permet, comme son nom l'indique, de modifier le papier-peint de windows à intervalle donné.

Pour cela, le programme utilise un effet de fondu (grâce à l'opacité) lorsqu'une image est affichée. Ainsi, elle apparaît progressivement sur l'écran avant d'être installée en tant que papier-peint.

Si vous désirez changer de dossier "images" pendant l'exécution du programme, faites un clic droit sur l'icône représentant un ordinateur dans le systray et sélectionnez "Options".

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

azertyu7787
Messages postés
4
Date d'inscription
mardi 17 février 2009
Statut
Membre
Dernière intervention
29 avril 2010
-
Merci beaucoup pour ton aide. C'était une question de compilation.J'ai fait ca avec Visual Basic et ça marche très bien. Merci encore.
ludobd
Messages postés
19
Date d'inscription
samedi 12 juin 2004
Statut
Membre
Dernière intervention
3 décembre 2007
-
Bonjour,

Désolé pour le retard.

J'ai remarqué que vous avez modifié le code suivant :

Obj_Image.Position_Wallpaper = Traitement_Image.Position_image.centrer

en

Obj_Image.Position_Wallpaper = Traitement_Image.Position_image.etirer

mais avez-vous pensé à recompiler le projet afin que la modification du code soit prit en compte ?

Sinon la réponse est négative, je vous invite à le faire en passant par l'un des menus supérieur dans l'interface VB.

Je reste à votre disposition si vous avez d'autres questions.

Cordialement,
azertyu7787
Messages postés
4
Date d'inscription
mardi 17 février 2009
Statut
Membre
Dernière intervention
29 avril 2010
-
Pleazzz c'est possible d'avoir de l'aide??? apres redemarrage le logicielle met les images en centré meme si le fichier "Form_principale.vb" est modiffié.

'Nom du projet : ChangeWallpaper
'Développeur : ludobd
'Date de fin réalisation : 28 septembre 2007
'Explication : Ce projet a pour but de modifier, à interval donné, le papier-peint de windows.
' Pour cela, le programme utilise un effet de fondu (grace à l'opacité) lorsqu'une image
' est affichée. Ainsi, elle apparaît progressivement sur l'écran avant d'être installé
' en tant que papier-peint.

Option Explicit On

Public Class Form_principale

'API pour mettre l'image en wallpaper de windows et pour la gestion de l'écran de veille
Private Declare Auto Function SystemParametersInfo Lib "user32.dll" (ByVal uAction As Integer, ByVal uParam As Integer, ByVal lpvParam As String, ByVal fuWinIni As Integer) As Integer

'Wallpaper
Const SPI_SETDESKWALLPAPER = 20
Const SPIF_UPDATEINIFILE = 1
Const SPIF_SENDWININICHANGE = 2

'Index de l'image lu dans la liste aléatoire
Public num_image As Integer = 0

'Chemin complet de l'image lu dans le listbox LV_Liste_fichiers
Private Image_Lu As String = ""

'Nom du fichier image sauvegardé sur le disque dur après redimension
Private nom_image As String = "c:\ImageChangeWallpaper.bmp"

'Ratio de l'opacité pour l'apparition et la disparition de la form
Private Val_opacite_positif As Decimal = 0.02
Private Val_opacite_negatif As Decimal = 0.02

'Objet image
Dim Obj_Image As New Traitement_Image

#Region "Chargement de la form"

Private Sub Form_principale_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

'Gestion de la form
Me.Proprietes_Form()

'Définit la position de l'image en tant que wallpaper (centrer, mosaïque, étirer)
Obj_Image.Position_Wallpaper = Traitement_Image.Position_image.etirer

'Vérifie si la variable "dossier", dans les paramètres d'application, contient une valeur et la vérifie
Select Case (Me.verif_dossier_parametre)

'le dossier contient des images
Case 1 : Me.execute()

'le dossier ne contient aucune image
Case 2 : If MsgBox("Le dossier ""Images"" mémorisé ne contient plus d'images." & Chr(13) & Chr(13) & "Vous allez être redirigé vers la fenêtre des ""Paramètres"".", MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "Impossible d'exécuter le programme ""Change Wallpaper""") = MsgBoxResult.Ok Then
My.Forms.Form_parametres.Show()
End If

'le dossier n'existe plus sur le disque dur
Case 3 : If MsgBox("Le dossier ""Images"" mémorisé est introuvable sur le dique dur." & Chr(13) & Chr(13) & "Vous allez être redirigé vers la fenêtre des ""Paramètres"".", MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "Impossible d'exécuter le programme ""Change Wallpaper""") = MsgBoxResult.Ok Then
My.Forms.Form_parametres.Show()
End If

'le dossier n'a pas encore été définit par l'utilisateur
Case 4 : If MsgBox("Ceci est votre première exécution du programme ChangeWallpaper, aucun dossier ""Images"" n'a encore été mémorisé dans les paramètres de l'application." & Chr(13) & Chr(13) & "Vous allez être redirigé vers la fenêtre des ""Paramètres"".", MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "Impossible d'exécuter le programme ""Change Wallpaper""") = MsgBoxResult.Ok Then
My.Forms.Form_parametres.Show()
End If

End Select

End Sub

#End Region

#Region "Propriétés de la form : Dimension, Opacité, BorderStyle..."

Private Sub Proprietes_Form()

With Me
.FormBorderStyle = Windows.Forms.FormBorderStyle.None 'Aucune bordure
.Opacity = 0 'A l'ouverture de l'application, la form ne doit pas être visible
.ShowInTaskbar = False 'N'affiche pas la form dans la barre des tâches

'Dimension de la form
.Top = 0
.Left = 0
.Width = My.Computer.Screen.Bounds.Width
.Height = My.Computer.Screen.Bounds.Height
End With

End Sub

#End Region

#Region "Vérifie si le dossier dans les paramètres d'application contient une valeur, existe toujours et contient des images"

Private Function verif_dossier_parametre() As Integer

Dim valeur_retour As Integer = 0

'Valeur de retour :
'1 = le dossier contient des images
'2 = le dossier ne contient aucune image
'3 = le dossier n'existe plus sur le disque dur
'4 = le dossier n'a pas encore été définit par l'utilisateur

With My.MySettings.Default

'Vérifie si le paramètre "dossier" contient une chaine
If .dossier <> "" Then

'Vérifie si le dossier en question existe
If My.Computer.FileSystem.DirectoryExists(.dossier) = True Then

'On remplit le listview , cela permet de savoir si des fichiers images existent
Me.remplit_listbox(.dossier)

If Me.LB_Liste_fichiers.Items.Count <> 0 Then
valeur_retour = 1
Else
valeur_retour = 2
End If
Else
valeur_retour = 3
End If
Else
valeur_retour = 4
End If

End With

Return valeur_retour

End Function

#End Region

#Region "Execute : remplit le listbox, génère les nombres aléatoire..."

Public Sub execute()

'Efface les listbox
Me.LB_Liste_fichiers.Items.Clear()
Me.LB_Nbre_aleatoire.Items.Clear()

'Remplit le listview par le nom de dossier et fichiers
Me.remplit_listbox(My.MySettings.Default.dossier)

'Appel de la fonction de génération des nombres aléatoires
GenerateurNombre(Me.LB_Liste_fichiers.Items.Count)

'Dès que le programme est exécuté, on change une première fois le wallpaper
'de windows pour montrer que le programme est en cours d'exécution
Me.Fonctionnement()

'Définit l'interval de temps entre les photos et lance le timer pour les jouer
Me.Timer_AfficheImage.Interval = My.Settings.delai_image * 60000
Me.Timer_AfficheImage.Enabled = True

End Sub
#End Region

#Region "Remplit le listbox par les chemins et fichiers qui seront joués"

Sub remplit_listbox(ByVal chemin As String)

'Contient l'extension du fichier lu
Dim extension As String = ""

'Parcours le dossier "images" et ajoute les noms des fichiers dans la listbox
For Each lecture As String In FileIO.FileSystem.GetFiles(chemin)

extension = System.IO.Path.GetExtension(lecture) 'Récupère l'extension du fichier lu
extension = extension.ToLower 'Convertit l'extension en minuscule

'Si l'extension correspond à l'une des extensions du select case alors on ajoute le fichier dans le listview
Select Case extension
Case ".jpg" : Me.LB_Liste_fichiers.Items.Add(chemin & System.IO.Path.GetFileName(lecture))
Case ".jpeg" : Me.LB_Liste_fichiers.Items.Add(chemin & System.IO.Path.GetFileName(lecture))
Case ".bmp" : Me.LB_Liste_fichiers.Items.Add(chemin & System.IO.Path.GetFileName(lecture))
End Select

Next

End Sub

#End Region

#Region "Génération du nombre aléatoire"

Sub GenerateurNombre(ByVal LeNombre As Integer)

Dim NbreAleatoire As String 'Contient le nombre aléatoire
Dim result As Integer 'Variable de vérification du nombre aléatoire

Randomize()

Do

'Génération du nombre aléatoire.
'On note -1 en fin de formule pour éviter un erreur lorsque le nombre maxi de la liste sera atteint
NbreAleatoire = CStr(CInt(Int((LeNombre * Rnd()) + 1))) - 1

'Vérifie si le nombre aléatoire existe déjà dans la liste
result = Me.LB_Nbre_aleatoire.FindStringExact(NbreAleatoire)

'S'il n'existe pas on l'ajoute dans la liste
If result = -1 Then
Me.LB_Nbre_aleatoire.Items.Add(NbreAleatoire)
End If

'On répète la boucle jusqu'à ce que la liste des fichiers soit égale
'à la liste des nombres aléatoires. Ainsi tous les fichiers seront affichés
Loop Until Me.LB_Nbre_aleatoire.Items.Count = LeNombre
End Sub
#End Region

#Region "Timer : AfficheImage. Affiche les images du dossier sélectionné par l'utilisateur"

Private Sub Timer_AfficheImage_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer_AfficheImage.Tick

'Fonctionnement de ChangeWallpaper
Me.Fonctionnement()

End Sub

#End Region

#Region "Fonctionnement de ChangeWallpaper"

Private Sub Fonctionnement()

'Stocke le chemin de d'image dans la variable : Image_Lu
Me.Image_Lu = Me.LB_Liste_fichiers.Items.Item(Me.LB_Nbre_aleatoire.Items.Item(Me.num_image))

'On vérifie si le fichier lu existe toujours sur le disque dur.
'En effet, si l'utilisateur, à un moment donné, a supprimé les fichiers images contenu dans le dossier
'il y aurait un plantage du programme. Donc on prévoit.
If My.Computer.FileSystem.FileExists(Me.Image_Lu) = True Then

'Cache la form afin de la faire réapparaître progressivement
Me.Opacity = 0

'Redimensionne l'image aux dimensions de l'écran
Obj_Image.Redimensionner_Image(Me.Image_Lu)

'Sauvegarde l'image sur le disque dur
Obj_Image.Save_Image(Me.nom_image)

'Affiche l'image redimensionnée dans le picturebox
Me.PictureBox1.BackgroundImage = Obj_Image.Get_Image_redimensionnee 'Obj_Image.redimensionne_image(Me.Image_Lu, Me.nom_image)

'Active l'opacité pour faire apparaître la form progressivement
Me.Timer_opacite.Enabled = True

'Incrémente le numéro d'image afin de passer à l'image suivante
Me.num_image += 1

'Vérifie que la variable num_image ne soit pas supérieure aux nombres de fichiers du listbox
'sinon l'application plantera. Comme on veut que l'on joue Advitam Aeternam les images contenues dans le dossier,
'on réinitialise l'index à 0. Ainsi, si l'index des images arrives au nombre maximum de fichiers de la listbox, on repare
'de 0 pour jouer de nouveau la série d'image en fonction de la liste aléatoire
If Me.num_image >= Me.LB_Liste_fichiers.Items.Count Then
Me.num_image = 0
End If

Else

'On arrête le timer
Me.Timer_AfficheImage.Enabled = False

'Cas ou l'image lu a été supprimée, on renvoit l'utilisateur vers la fenêtre des paramètres
If MsgBox("L'image devant être prochainement joué est introuvable." & Chr(13) & Chr(13) & "Vous allez être redirigé vers la fenêtre des ""Paramètres"" afin de choisir un dossier ""Images"" valide.", MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "Impossible d'exécuter le programme ""Change Wallpaper""") = MsgBoxResult.Ok Then

'Affiche la form des paramètres
My.Forms.Form_parametres.Show()

End If

End If

End Sub

#End Region

#Region "Timer : Opacité positif"

Private Sub Timer_opacite_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer_opacite.Tick

'Fait apparaître progressivement la form
Me.Opacity += Me.Val_opacite_positif

'Si la form est visible complètement
If Me.Opacity >= 1 Then

'On désactive le timer de l'opacité
Me.Timer_opacite.Enabled = False

'Applique l'image à l'arrière plan de windows
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Me.nom_image, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)

'Cache la form de façon à voir le bureau de windows apparaître progressivement
Me.Timer_opacite_negatif.Enabled = True

End If

End Sub

#End Region

#Region "Timer : Opacité négatif"

Private Sub Timer_opacite_negatif_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer_opacite_negatif.Tick

'Fait disparaitre progressivement la form
Me.Opacity -= Me.Val_opacite_negatif

'Si la form n'est plus visible
If Me.Opacity <= 0 Then

'On désactive le timer de l'opacité
Me.Timer_opacite_negatif.Enabled = False

End If
End Sub

#End Region

#Region "Gestion du menu de l'icône placée dans le systray"

#Region "Paramètres"

Private Sub ParamètresToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ParamètresToolStripMenuItem.Click

'Affiche la form de paramètrage
My.Forms.Form_parametres.Show()

End Sub

#End Region

#Region "Quitter"

Private Sub QuitterToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles QuitterToolStripMenuItem.Click

My.Settings.Save()

'Quitte l'application
Me.Dispose()

End Sub
#End Region

#End Region

End Class

Public Class Traitement_Image

'Cette classe permet de :
'- positionner le wallpaper en mode centrer, étirer ou mosaïque dans les propriétés d'affichage,
'- redimensionner une image aux dimensions de l'écran,
'- sauvegarder l'image redimensionnée sur le disque dur.

'Type de position du wallpaper dans les propriétés d'affichage
Public Enum Position_image
centrer
etirer
mosaique
End Enum

'Variables de la classe
Private TileWallpaper As String = ""
Private WallpaperStyle As String = ""
Private Image_redimensionnee As Bitmap = Nothing

#Region "Affecte les variables en fonction du type de position (centrer, étirer, mosaïque)"

WriteOnly Property Position_Wallpaper() As Position_image

Set(ByVal value As Position_image)

'Affecte les valeures aux variables
Select Case value
Case Position_image.centrer : Me.TileWallpaper = "0"
Me.WallpaperStyle = "0"

Case Position_image.mosaique : Me.TileWallpaper = "1"
Me.WallpaperStyle = "0"

Case Position_image.etirer : Me.TileWallpaper = "0"
Me.WallpaperStyle = "2"
End Select

'Modifie les valeurs dans la base des registres
With Microsoft.Win32.Registry.CurrentUser.OpenSubKey("Control Panel\Desktop", True)

.SetValue("TileWallpaper", Me.TileWallpaper.ToString)
.SetValue("WallpaperStyle", Me.WallpaperStyle.ToString)

End With

End Set

End Property
#End Region

#Region "Obtient les valeurs des variables privées"

'TileWallpaper
ReadOnly Property Get_TileWallpaper()
Get
Return Me.TileWallpaper
End Get

End Property

'Wallpaper
ReadOnly Property Get_WallpaperStyle()
Get
Return Me.WallpaperStyle
End Get

End Property

'Image_redimensionnee
ReadOnly Property Get_Image_redimensionnee()
Get
Return Me.Image_redimensionnee
End Get

End Property

#End Region

#Region "Redimensionne l'image au format de l'écran"

Public Sub Redimensionner_Image(ByVal chemin_complet_image_original As String)

'Image original
Dim img_original As Drawing.Image = Drawing.Image.FromFile(chemin_complet_image_original)

'Image redimensionnée au format de l'écran
Dim img_redim As Bitmap = Nothing

'Correspond au % de réduction de l'image (hauteur et largeur)
Dim Taux As Decimal = 0.0

'Différences (largeur et hauteur) entre la taille de l'écran et la taille de l'image à redimensionner
Dim diff_hauteur As Integer
Dim diff_largeur As Integer

'Nouvelles coordonnées (hauteur et largeur) après redimensionnement de l'image
Dim La_Hauteur As Integer = 0
Dim La_Largeur As Integer = 0

'Vérifie si la largeur ou la hauteur de l'image est plus grande que celle de l'écran
If (img_original.Height > My.Computer.Screen.Bounds.Height) Or (img_original.Width > My.Computer.Screen.Bounds.Width) Then

'Récupération des différences (largeur et hauteur) entre
'la taille de l'écran et la taille de l'image à redimensionner
diff_hauteur = img_original.Height - My.Computer.Screen.Bounds.Height
diff_largeur = img_original.Width - My.Computer.Screen.Bounds.Width

'Vérifie si c'est la hauteur ou la largeur qui dépasse le plus
If diff_hauteur > diff_largeur Then

'Le "100 - ...." stipule que la photo dépasse de tant de % par rapport à la taille de l'écran
Taux = 100 - (My.Computer.Screen.Bounds.Height / img_original.Height * 100)

'Hauteur supérieure à la largeur
La_Hauteur = img_original.Height - (img_original.Height * Taux / 100)
La_Largeur = img_original.Width - (img_original.Width * Taux / 100)

Else

Taux = 100 - (My.Computer.Screen.Bounds.Width / img_original.Width * 100)
'Largeur supérieure à la hauteur
La_Largeur = img_original.Width - (img_original.Width * Taux / 100)
La_Hauteur = img_original.Height - (img_original.Height * Taux / 100)

End If

'Affecte la nouvelle largeur et hauteur à img_redim
img_redim = New Bitmap(img_original, La_Largeur, La_Hauteur)

Else

'Si la largeur et la hauteur de l'image d'origine sont inférieures à la taille de l'écran
'alors on conserve les dimensions de l'image originale
img_redim = New Bitmap(img_original, img_original.Width, img_original.Height)

End If

'Valorise la variable privée : img_redimensionnée
Me.Image_redimensionnee = img_redim

End Sub

#End Region

#Region "Sauvegarde l'image"

Public Sub Save_Image(ByVal chemin_complet_image As String)

'Sauvegarde l'image sur le disque dur au format BMP
Me.Image_redimensionnee.Save(chemin_complet_image.ToString, Imaging.ImageFormat.Bmp)

End Sub

#End Region

End Class
azertyu7787
Messages postés
4
Date d'inscription
mardi 17 février 2009
Statut
Membre
Dernière intervention
29 avril 2010
-
S'il vous plais j'ai un problème avec le logicielle. Je n'arrive pas a changer l'affichage pour que ca soit étirer au lieux d'être centré. Quelqu'un peut il m'éclairer??
azertyu7787
Messages postés
4
Date d'inscription
mardi 17 février 2009
Statut
Membre
Dernière intervention
29 avril 2010
-
très bon logicielle merci

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.