Gadget diaporama
Description
Pour ceux qui n'ont pas Vista, voici le programme qu'il vous faut! Un "Gadget" qui se place en haut à gauche de votre écran. Diaporama en boucle de vos fichiers images,réglage des intervalles entre les images.Playlist musicale des fichiers sons: MP3,WMA et Wav. Quand tous les réglages sont fait vous pouvez "Minimiser" pour n'avoir que l'image. Deplacement par drag and drop. Option de transparence de l'arrière plan. Possibilité de défilement manuel et d'agrandissement de l'image.Medley musicale de 1, 2 ou 3 minutes.Le Diapo et le Medley peut se faire d'une façon aléatoire.
Je remercie: http://frederic.sigonneau.free.fr/
pour ses modules en VBA Excel
Le code du lancer au démarrage de Windows est de Kyliox que je remercie.
Source / Exemple :
Option Strict Off
Option Explicit On
Imports Microsoft.Win32
Imports System.IO
Imports System.Drawing.Imaging
Public Class Form1
Inherits System.Windows.Forms.Form
'Déplacez le form.
Private myFormDragging As Boolean = False
Private myPointClicked As Point
'Lancer au démarrage
Private o_ClefRegistre As RegistryKey = Registry.CurrentUser.OpenSubKey("Software\Microsoft\Windows\CurrentVersion\Run", True)
Private o_CR As Object = o_ClefRegistre.GetValue("Gadget_Diaporama")
Private Const CS_NOCLOSE As Integer = &H200
' ouvrir dans programme par défaut
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Integer, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Integer) As Integer
Dim fichier As String
#Region "Ouverture"
Private Sub cmdopen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdopen.Click
Dim a As New FolderBrowserDialog
Textsource.Text = "" 'effacement du chemin
FileListBox1.Items.Clear() 'effacement de la liste
'On arrête le diapo
tmrImage.Enabled = False
tmrImage.Stop()
cmdstart.Text = "&Start"
If a.ShowDialog = Windows.Forms.DialogResult.OK Then
On Error Resume Next
Textsource.Text = "" & a.SelectedPath & "\"
FileListBox1.Pattern = ComboBox1.Text
FileListBox1.Path = Textsource.Text
End If
If Textsource.Text = "" Then Exit Sub
FileListBox1.SelectedIndex = 0 'on sélectionne la 1ère image
LblImage.Text = FileListBox1.Items.Count 'on compte les fichiers
afficher_image()
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
ComboBox1.Text = "*.jpg"
ComboBox2.Text = "*.mp3"
RadioButton4.Checked = True
RadioButton7.Checked = True
'Check si la clef de registre "Gadget_Diaporama" existe dans le run
ToolStripMenuItemdemarrage.Checked = (o_CR IsNot Nothing)
'on empêche le formulaire principal d'aller dans la barre de tâche
Me.Hide()
NotifyIcon1.Visible = True
End Sub
' Ouvrir programme par défaut
Public Function OpenFile(ByRef File As String, Optional ByRef Parametres As String = "") As Object
ShellExecute(Handle.ToInt32, "Open", File, Parametres, My.Application.Info.DirectoryPath, 1)
OpenFile = 1
End Function
Private Sub PictureBox1_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles PictureBox1.DoubleClick
If Textsource.Text = "" Then
MsgBox("Il n'y a pas d'image!")
Exit Sub
End If
fichier = Textsource.Text & FileListBox1.Text
Try
'Ouvre le fichier dans son programme par défaut
OpenFile(fichier)
Catch ex As Exception
End Try
End Sub
#End Region
#Region "Diapo et Medley"
'images
Private Sub tmrImage_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmrImage.Tick
On Error Resume Next
cmdstart.Enabled = True
If RadioButton1.Checked = True Then
tmrImage.Interval = 2000 '2 secondes
ElseIf RadioButton2.Checked = True Then
tmrImage.Interval = 3000
ElseIf RadioButton3.Checked = True Then
tmrImage.Interval = 4000
ElseIf RadioButton4.Checked = True Then
tmrImage.Interval = 5000
ElseIf RadioButton5.Checked = True Then
tmrImage.Interval = 6000
ElseIf RadioButton6.Checked = True Then
tmrImage.Interval = 7000
End If
'Mode Aléatoire
Dim i As Integer = LblImage.Text 'nombre de fichiers
If CheckBox1.Checked = True Then
Randomize()
i = (LblImage.Text * Rnd() + 1) 'choix du fichier au hazard
FileListBox1.SelectedIndex = (i) 'on sélectionne le fichier
Else
'Mode normal
CheckBox1.Checked = False
Dim int As Integer = FileListBox1.SelectedIndex
If FileListBox1.SelectedItems.Count = 0 Then Exit Sub
int = FileListBox1.SelectedIndex + 1
Dim item As String = FileListBox1.SelectedItem
If FileListBox1.SelectedIndex = "" Then 'après la dernière image
FileListBox1.SetSelected(int, False)
FileListBox1.SelectedIndex = 0 'on redemarre à la 1ère image
FileListBox1.SetSelected(int, True)
End If
End If
afficher_image()
End Sub
Private Sub cmdstart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdstart.Click
'On démarre le diapo
If tmrImage.Enabled = True Then
cmdstart.Text = "&Start"
tmrImage.Stop()
Else
cmdstart.Text = "&Stop"
tmrImage.Start()
End If
End Sub
Private Sub afficher_image()
PictureBox1.Image = New System.Drawing.Bitmap(Textsource.Text & FileListBox1.Text)
PictureBox1.SizeMode = PictureBoxSizeMode.Zoom
End Sub
'Sons
Private Sub Timer_Medley_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer_Medley.Tick
On Error Resume Next
Timer_Medley.Enabled = True
If RadioButton7.Checked = True Then
Timer_Medley.Interval = 60000 '1 minute
ElseIf RadioButton8.Checked = True Then
Timer_Medley.Interval = 120000
ElseIf RadioButton9.Checked = True Then
Timer_Medley.Interval = 180000
End If
'Mode Aléatoire
Dim i As Integer = LblSon.Text 'nombre de fichiers
If CheckBox2.Checked = True Then
Randomize()
i = (LblSon.Text * Rnd() + 1) 'choix du fichier au hazard
FileListBox2.SelectedIndex = (i) 'on sélectionne le fichier
Else
'Mode normal
CheckBox2.Checked = False
Dim int As Integer = FileListBox2.SelectedIndex
If FileListBox2.SelectedItems.Count = 0 Then Exit Sub
int = FileListBox2.SelectedIndex + 1
Dim item As String = FileListBox2.SelectedItem
If FileListBox2.SelectedIndex = "" Then 'après le dernier fichier
FileListBox2.SetSelected(int, False)
FileListBox2.SelectedIndex = 0 'on redemarre au 1er fichier
FileListBox2.SetSelected(int, True)
End If
End If
'Joue le son
jouer_son()
Call Open()
Call Play()
End Sub
Private Sub cmdmedley_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdmedley.Click
'On démarre le medley
If Timer_Medley.Enabled = True Then
cmdmedley.Text = "&Medley"
Timer_Medley.Stop()
Else
cmdmedley.Text = "&Stop"
Timer_Medley.Start()
End If
End Sub
#End Region
#Region "FileListBox et ComboBox"
Private Sub ComboBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ComboBox1.SelectedIndexChanged
On Error Resume Next
FileListBox1.Pattern = ComboBox1.Text
End Sub
Private Sub ComboBox2_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ComboBox2.SelectedIndexChanged
On Error Resume Next
FileListBox2.Pattern = ComboBox2.Text
End Sub
Private Sub FileListBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles FileListBox1.SelectedIndexChanged
If FileListBox1.SelectedIndex <> -1 Then
'Ça ne sert à rien de vouloir monter si l'entrée est déjà tout en haut.
If FileListBox1.SelectedIndex > 0 Then cmdUp.Enabled = True Else cmdUp.Enabled = False
'Idem, inutile de vouloir descendre si on est déjà tout en bas.
If FileListBox1.SelectedIndex < FileListBox1.Items.Count - 1 Then cmdDown.Enabled = True Else cmdDown.Enabled = False
End If
End Sub
Private Sub FileListBox2_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles FileListBox2.Click
If FileListBox2.Text = "" Then
MsgBox("Il n'y a pas de fichier!")
Exit Sub
End If
jouer_son()
Call Open()
Call Play()
Timer_Medley.Enabled = True
End Sub
Private Sub FileListBox2_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles FileListBox2.SelectedIndexChanged
If FileListBox2.SelectedIndex <> -1 Then
'Ça ne sert à rien de vouloir monter si l'entrée est déjà tout en haut.
If FileListBox2.SelectedIndex > 0 Then cmdmonter.Enabled = True Else cmdmonter.Enabled = False
'Idem, inutile de vouloir descendre si on est déjà tout en bas.
If FileListBox2.SelectedIndex < FileListBox2.Items.Count - 1 Then cmddescendre.Enabled = True Else cmddescendre.Enabled = False
End If
End Sub
#End Region
#Region "UP and Down image et son"
'image
Private Sub cmdUp_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdUp.Click
Dim int As Integer = FileListBox1.SelectedIndex
If FileListBox1.SelectedItems.Count = 0 Then Exit Sub
int = FileListBox1.SelectedIndex - 1
Dim item As String = FileListBox1.SelectedItem
FileListBox1.SetSelected(int, True)
afficher_image()
End Sub
'image
Private Sub cmdDown_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdDown.Click
Dim int As Integer = FileListBox1.SelectedIndex
If FileListBox1.SelectedItems.Count = 0 Then Exit Sub
int = FileListBox1.SelectedIndex + 1
Dim item As String = FileListBox1.SelectedItem
FileListBox1.SetSelected(int, True)
afficher_image()
End Sub
'son
Private Sub cmdmonter_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdmonter.Click
Dim int As Integer = FileListBox2.SelectedIndex
If FileListBox2.SelectedItems.Count = 0 Then Exit Sub
int = FileListBox2.SelectedIndex - 1
Dim item As String = FileListBox2.SelectedItem
FileListBox2.SetSelected(int, True)
'Joue le son
jouer_son()
Call Open()
Call Play()
End Sub
'son
Private Sub cmddescendre_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmddescendre.Click
Dim int As Integer = FileListBox2.SelectedIndex
If FileListBox2.SelectedItems.Count = 0 Then Exit Sub
int = FileListBox2.SelectedIndex + 1
Dim item As String = FileListBox2.SelectedItem
FileListBox2.SetSelected(int, True)
'Joue le son
jouer_son()
Call Open()
Call Play()
End Sub
#End Region
#Region "Son"
Private Sub cmdson_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdson.Click
Dim b As New FolderBrowserDialog
On Error GoTo erropen
If bPlaying Then
Call Pause()
Timer_Medley.Enabled = False
Timer_Medley.Stop()
cmdmedley.Text = "&Medley"
End If
T_Chemin.Text = "" 'effacement du chemin
FileListBox2.Items.Clear() 'effacement de la liste
If b.ShowDialog = Windows.Forms.DialogResult.OK Then
On Error Resume Next
T_Chemin.Text = "" & b.SelectedPath & "\"
FileListBox2.Pattern = ComboBox2.Text
FileListBox2.Path = T_Chemin.Text
End If
If T_Chemin.Text = "" Then Exit Sub
FileListBox2.SelectedIndex = 0 'on sélectionne le 1er fichier
LblSon.Text = FileListBox2.Items.Count 'on compte les fichiers
jouer_son()
Call Open()
Call Play()
erropen:
End Sub
Private Sub jouer_son()
Call Pause()
strFileToPlay = T_Chemin.Text & FileListBox2.SelectedItem
strFileToPlay = """" & strFileToPlay & """"
End Sub
Private Sub cmdstopmusic_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdstopmusic.Click
'Arrete la lecture du son
Call Pause()
Timer_Medley.Enabled = False
Timer_Medley.Stop()
cmdmedley.Text = "&Medley"
End Sub
#End Region
#Region "Drag Drop"
Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
myFormDragging = True
myPointClicked = New Point(e.X, e.Y)
End Sub
Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
If myFormDragging Then
Dim aMoveToPoint As Point
'Utilisez la position de souris actuelle pour trouver l'endroit prévu.
aMoveToPoint = Me.PointToScreen(New Point(e.X, e.Y))
'Réglez la position basée sur où vous avez commencé.
aMoveToPoint.Offset(myPointClicked.X * -1, _
(myPointClicked.Y + SystemInformation.CaptionHeight + _
SystemInformation.BorderSize.Height) * -1)
'Déplacez le form.
Me.Location = aMoveToPoint
End If
End Sub
Private Sub Form1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp
myFormDragging = False
End Sub
#End Region
#Region "Lancer au démarrage"
Private Sub ToolStripMenuItemopen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripMenuItemopen.Click
Me.Show()
End Sub
Private Sub ToolStripMenuItemclose_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripMenuItemclose.Click
' on enlève l'icône de la zone de notification
NotifyIcon1.Visible = False
'On arrête le diapo
tmrImage.Enabled = False
tmrImage.Stop()
'On arrête le son
Call Pause()
Timer_Medley.Stop()
Timer_Medley.Enabled = False
End
End Sub
Private Sub ToolStripMenuItemdemarrage_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripMenuItemdemarrage.Click
If ToolStripMenuItemdemarrage.Checked Then
ToolStripMenuItemdemarrage.Checked = False
If o_CR IsNot Nothing Then
o_ClefRegistre.DeleteValue("Gadget_Diaporama")
o_CR = Nothing
End If
Else
o_ClefRegistre.SetValue("Gadget_Diaporama", My.Application.Info.DirectoryPath & "\Gadget_Diaporama.exe")
o_CR = o_ClefRegistre.GetValue("Gadget_Diaporama")
ToolStripMenuItemdemarrage.Checked = True
End If
End Sub
#End Region
#Region "Minimiser, Transparence et Quitter"
Private Sub cmdminimiser_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdminimiser.Click
If cmdminimiser.Text = "2" Then
cmdminimiser.Text = "1"
Me.Width = 160
Me.Height = 160
Else
cmdminimiser.Text = "2"
Me.Width = 350
Me.Height = 300
End If
End Sub
Private Sub cmdquitter_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdquitter.Click
'On arrête le diapo
tmrImage.Enabled = False
tmrImage.Stop()
cmdstart.Text = "&Start"
'On arrête le son
Call Pause()
Timer_Medley.Enabled = False
Timer_Medley.Stop()
cmdmedley.Text = "&Medley"
Me.Hide()
End Sub
Private Sub cmdtransparence_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdtransparence.Click
If PictureBox1.BackColor = Color.Gainsboro Then
cmdtransparence.Text = "&Opacité"
PictureBox1.BackColor = Color.Yellow
Else
cmdtransparence.Text = "&Transparence"
PictureBox1.BackColor = Color.Gainsboro
End If
End Sub
#End Region
End Class
Conclusion :
Je remercie: http://frederic.sigonneau.free.fr/
pour ses modules en VBA Excel
Le code du lancer au démarrage de Windows est de Kyliox que je remercie.
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.