Horloge diaporama

Télécharger le projet
Commenter

Description

Horloge qui fait diaporama: On peut changer la police et la couleur du texte.Transparence.Charger les images et les fichiers audios: MP3, WAV et WMA. La lancer au démarrage de windows,la mettre dans la zone de notification ou la lancer d'un click droit.
On peut charger des adresses URL de radios dans un fichier texte (pour cela j'ai emprunté le code à Bilo1000 que je remercie)
Utilisation d'imagelist et de listBox.
Nouveau design, utilisation de"drag and drop" pour déplacer le formulaire sans bordure.

Source / Exemple : 


Imports System
Imports System.Drawing

Public Class Form1
    Inherits System.Windows.Forms.Form
    Protected myGraphics As Graphics
    Private currentImage As Integer = 0
    'Déplacez la forme.
    Private myFormDragging As Boolean = False
    Private myPointClicked As Point
    'Diapo
    Private m_ControlCount As Int32 = 0
    'Enlever les bordures
    Dim isSizable As Boolean = True
    'Transparence
    Dim Value As Integer
    'Raccourci bureau
    Dim Bureau As IWshRuntimeLibrary.WshShell
    Dim Raccourci As IWshRuntimeLibrary.WshShortcut
    Dim Nom As String
    Dim WSHShell
    Dim BureauPath
    'Ajoutadresses
    Public url(100) As String
    Public texte(100) As String
    Public categorie(100) As Integer
    Public p As Integer
    Public numchaine As Integer
    Public Sub New()
        InitializeComponent()
        'La grandeur d'image implicite est 16 x 16, qui montre une plus grande image.
        imgList.ImageSize = New Size(255, 255)
        imgList.TransparentColor = Color.White
    End Sub
   
    Private Sub heureTimer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles heureTimer.Tick
        heureLabel.Text = My.Computer.Clock.LocalTime.ToLongTimeString
        dateLabel.Text = My.Computer.Clock.LocalTime.ToLongDateString
    End Sub
   
#Region "Diapo"
    Private Sub OuvrirToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles OuvrirToolStripMenuItem.Click
        ' On charge les images
        With OpenFileDialog1
            .CheckFileExists = True
            .FileName = "*.JPG"
            OpenFileDialog1.Multiselect = True
            If OpenFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then
                If Not (OpenFileDialog1.FileNames Is Nothing) Then
                    Dim i As Integer
                    For i = 0 To OpenFileDialog1.FileNames.Length - 1
                        addImage(OpenFileDialog1.FileNames(i))
                    Next i
                Else
                    addImage(OpenFileDialog1.FileName)
                End If
            End If
        End With
    End Sub
    Private Sub addImage(ByVal imageToLoad As String)
        'De la listBox à l'imagelist
        If imageToLoad <> "" Then
            imgList.Images.Add(Image.FromFile(imageToLoad))
            ListBox1.BeginUpdate()
            ListBox1.Items.Add(imageToLoad)
            ListBox1.EndUpdate()
        End If
    End Sub
    Private Sub DiaporamaToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DiaporamaToolStripMenuItem.Click
        'On démarre le diapo
        tmrImage.Enabled = True
        tmrImage.Start()
    End Sub
    Private Sub tmrImage_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmrImage.Tick
        'Remplir l'imagelist
        If imgList.Images.Empty <> True Then
            If imgList.Images.Count - 1 > currentImage Then
                currentImage += 1
            Else
                currentImage = 0
            End If
            ' Mettre l'image dans la PictureBox.
            PictureBox1.Image = imgList.Images(currentImage)
            'Augmentez le compte (s)
            m_ControlCount += 1
        End If
    End Sub
    Private Sub ArretToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ArretToolStripMenuItem1.Click
        'On arrête le diapo
        tmrImage.Enabled = False
        tmrImage.Stop()
    End Sub
#End Region
    
#Region "Son"
    Private Sub SoundToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SoundToolStripMenuItem.Click
        'On ouvre le fichier son :mp3,wav,wma.

        On Error GoTo erropen
        If bPlaying Then
            Call Pause()
            Timer_Renamed.Enabled = False
        End If
        OpenFileDialog1.Filter = "MP3 Files|*.mp3|CD AUDIO|*.cda|WAV AUDIO|*.wav|WMA AUDIO|*.wma|ALL Files|*.*"
        OpenFileDialog1.ShowDialog()
        If OpenFileDialog1.FileName = "" Or OpenFileDialog1.FileName = strFileToPlay Then
        Else
            strFileToPlay = OpenFileDialog1.FileName
            strFileToPlay = """" & strFileToPlay & """"
            'Chemin pour la Playlist
            txtchem.Text = OpenFileDialog1.FileName
            Call Open()
            Call Play()
            Timer_Renamed.Enabled = True
        End If
erropen:
        'Question demandant une réponse
        Dim answer As MsgBoxResult
        answer = MsgBox("Voulez-vous sauvegarder ce morceau dans votre Playlist?", MsgBoxStyle.YesNo)
        If answer = MsgBoxResult.Yes Then
            Dim new_value As String
            'On entre le chemin
            new_value = txtchem.Text
            If Len(new_value) = 0 Then Exit Sub
            Playlist.lstPlay.Items.Add(new_value)
            MsgBox("Le fichier " & txtchem.Text & " est sauvegarder dans votre Playlist", MessageBoxButtons.OK)
            txtchem.Text = ""
            Playlist.Show()
        End If
    End Sub
    Private Sub StopToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles StopToolStripMenuItem.Click
        'Arrete la lecture du son
        Call Pause()
        Timer_Renamed.Enabled = False
    End Sub
    Private Sub PlayToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles PlayToolStripMenuItem.Click
        'On joue le fichier son
        Call Play()
        Timer_Renamed.Enabled = True
    End Sub
   
    Private Sub ouvrirToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ouvrirToolStripMenuItem1.Click
        'Arrete la lecture du son
        Call Pause()
        Playlist.Show()

    End Sub
#End Region

#Region "Options"
    Private Sub ChargerToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ChargerToolStripMenuItem.Click
        'On charge l'image de fond
        'Pour éviter un bug si on n'ouvre pas
        On Error Resume Next
        With OpenFileDialog1
            .CheckFileExists = True
            .FileName = "*.JPG"
            .AddExtension = True
            .DefaultExt = "*.JPG"
            .ShowDialog()
            PictureBox1.Image = New System.Drawing.Bitmap(.FileName)
            PictureBox1.SizeMode = PictureBoxSizeMode.StretchImage
        End With
    End Sub
    Private Sub PoliceToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles PoliceToolStripMenuItem1.Click
        Dim myFontDialog As FontDialog
        myFontDialog = New FontDialog()
        If myFontDialog.ShowDialog() = Windows.Forms.DialogResult.OK Then
            heureLabel.Font = myFontDialog.Font
            dateLabel.Font = myFontDialog.Font
        End If
    End Sub
    Private Sub CouleursToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CouleursToolStripMenuItem.Click
        Dim MyDialog As New ColorDialog()
        'Permet àl'utilisateur de choisir une couleur personnalisée.
        MyDialog.AllowFullOpen = True
        'Permet à l'utilisateur de recevoir l'aide. (Le défaut est faux.)
        MyDialog.ShowHelp = True
        'Montre l'élection en couleur initiale à la couleur de texte actuelle,
        MyDialog.Color = heureLabel.ForeColor
        MyDialog.Color = dateLabel.ForeColor
        'Actualisez la couleur de boîte de texte si l'utilisateur clique OK 
        If (MyDialog.ShowDialog() = Windows.Forms.DialogResult.OK) Then
            heureLabel.ForeColor = MyDialog.Color
            dateLabel.ForeColor = MyDialog.Color
        End If
    End Sub
    Private Sub TransparenceToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TransparenceToolStripMenuItem.Click
        'On diminue l'opacité de moitié
        Me.Opacity -= 0.5
        If Value < 15 Then
            Me.Opacity = 0.5
        End If
        MsgBox(" 1 Click pour rétablir")
    End Sub
    Private Sub PictureBox1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles PictureBox1.Click
        'On rétablit l'opacité
        Me.Opacity += 0.5
    End Sub
    Private Sub LancerToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles LancerToolStripMenuItem.Click
        'On met l'exe dans la clé du registre
        Demarrage.IsRunningOnStartup("Horloge Diaporama")
        Call Demarrage.RunAtStartUp("Horloge Diaporama", My.Application.Info.DirectoryPath & "\Horloge Diaporama.exe")
        MsgBox("Sera opérationnel au prochain démarrage de Windows")
    End Sub
    Private Sub SupprimerToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SupprimerToolStripMenuItem.Click
        On Error Resume Next
        'On enlève l'exe de la clé du registre
        Demarrage.IsRunningOnStartup("Horloge Diaporama")
        Call Demarrage.StopRunningStartUp("Horloge Diaporama")
        MsgBox("Supprimé des applications lancées au démarrage de Windows")
    End Sub
    Private Sub MenuToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuToolStripMenuItem.Click
        'on met l'exe dans le menu contextuel.
        Dim Key As Microsoft.Win32.RegistryKey
        Key = My.Computer.Registry.LocalMachine.CreateSubKey("Software\Classes\Directory\shell\Horloge\command")
        My.Computer.Registry.SetValue("HKEY_LOCAL_MACHINE\Software\Classes\Directory\shell\Horloge\command", "", My.Application.Info.DirectoryPath & "\" & "Horloge.exe -o" & Chr(34) & "%L" & Chr(34))
        MsgBox("Menu Contextuel réussi")
    End Sub
    Private Sub DeleteToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DeleteToolStripMenuItem.Click
        'On ouvre le formulaire pour effacer la clé du menu contextuel.
        Form2.Show()
    End Sub
    Private Sub NotiToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NotiToolStripMenuItem.Click
        'Cachez la forme actuelle
        Me.Hide()
        'Mettez le texte de l'icône
        NI.Text = Me.Text
        'Montrez la forme à la barre d'outil d'icône
        NI.Visible = True
    End Sub
    Private Sub NI_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles NI.Click
        'Montrez la forme actuelle
        Me.Show()
        'Cachez la forme à la barre d'outil d'icône
        NI.Visible = False
    End Sub
    'Raccourci bureau
    Private Sub RacToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RacToolStripMenuItem1.Click
        'Il faut d'abord ajouter la référence wshom.ocx qui est dans C:\Windows\System32
        '(menu Projet=>Propriétés de.. Références , bouton Ajouter, Onglet Parcourir, aller dans C:\Windows\System32, cliquer sur wshom.ocx puis Ok) 
        Bureau = New IWshRuntimeLibrary.WshShell
        '   Chemin et nom du raccourci
        Nom = My.Computer.FileSystem.SpecialDirectories.Desktop & "\Horloge.lnk" 'pour 'Raccourci Bureau'
        Raccourci = CType(Bureau.CreateShortcut(Nom), IWshRuntimeLibrary.WshShortcut)
        '   Cible à exécuter
        Raccourci.TargetPath = My.Application.Info.DirectoryPath & "\Horloge.exe"
        '   Icône à utiliser, mettre l'icône dans le dossier 'Debug' de l'application
        Raccourci.IconLocation = My.Application.Info.DirectoryPath & "\2662.ico"
        '   Enregistrement du raccourci
        Raccourci.Save()
        MsgBox("Raccourci Bureau réussi")
    End Sub

    Private Sub DeletToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DeletToolStripMenuItem.Click
        WSHShell = CreateObject("Wscript.Shell")
        BureauPath = WSHShell.SpecialFolders("Desktop")
        'pour supprimer un raccourci du bureau
        Kill(BureauPath & "\Horloge.lnk")
        WSHShell = Nothing
        MsgBox("Supprimé du Bureau")
        End
    End Sub

    Private Sub aboutToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles aboutToolStripMenuItem.Click
        AboutBox1.Show()
    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 la forme.
            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
    'Bordure sizable
    Private Sub PictureBox3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles PictureBox3.Click
        If isSizable = False Then
            Me.FormBorderStyle = Windows.Forms.FormBorderStyle.Sizable
            Me.ToolTip2.SetToolTip(Me.PictureBox3, "Sans Bordure")
            isSizable = True
        Else
            Me.FormBorderStyle = Windows.Forms.FormBorderStyle.None
            Me.ToolTip2.SetToolTip(Me.PictureBox3, "Avec Bordure")
            isSizable = False
        End If
    End Sub
#End Region
#Region "Radio"
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        'Afficher les URL
        Dim fichier As String
        Dim champs(3) As String
        Dim SubItem As ToolStripMenuItem
        fichier = My.Application.Info.DirectoryPath & "\Radios.txt"
        Dim monStreamReader As New IO.StreamReader(fichier) 'Stream pour la lecture
        Dim ligne As String ' Variable contenant le texte de la ligne
        p = 0
        Do
            ligne = monStreamReader.ReadLine
            If (ligne > "") Then
                champs = ligne.Split(",")
                texte(p) = champs(0)
                url(p) = champs(1)
                categorie(p) = champs(2)
                SubItem = New ToolStripMenuItem(champs(0), Nothing, Nothing, "M" & p)
                AdresseToolStripMenuItem.DropDownItems.Add(SubItem)
                AddHandler SubItem.Click, AddressOf AdresseToolStripMenuItem_Click
                p += 1
            End If
        Loop Until ligne Is Nothing
        monStreamReader.Close()
    End Sub

    ' Enregistrement des radios
    Private Sub OpenToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles OpenToolStripMenuItem.Click
        ' On ouvre le formulaire Ajoutadresse
        Ajoutadresses.ShowDialog()
    End Sub

    Private Sub AdresseToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles AdresseToolStripMenuItem.Click
        'On ouvre l'adresse URL
        Call cliquersurmenu(sender.text)
        Me.AdresseToolStripMenuItem.Enabled = True
        'Arrete la lecture du son fichier audio
        Call Pause()
        Timer_Renamed.Enabled = False
    End Sub
    Public Sub cliquersurmenu(ByVal sender)
        Dim o As Integer
        For o = 0 To p - 1
            If texte(o) = sender Then
                numchaine = 3 ' On enregistre le numéro de chaine pour le mettre en favoris
                System.Diagnostics.Process.Start(url(o))
            End If
        Next
    End Sub
#End Region

  Private Sub PictureBox1_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles PictureBox1.DoubleClick
        'On quitte 
        End
    End Sub

End Class

Conclusion :


Playlist radio simplifiée
Playlist musicale
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (cs_Le Pivert)