HORLOGE DIAPORAMA

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

Télécharger le zip

16 décembre 2007 11:09:35 :

On peut changer l'image de fond

16 décembre 2007 11:51:37 :

Ajout du zip. j'ai du enlever les images le dossier était trop lourd. Il reste 2 images. pour en ajouter vous allez dans imagelist (collection) et n'oubliez pas de rectifier le programme du nombre d'images.

17 décembre 2007 09:17:08 :

Enlever un timer qui était en double

17 décembre 2007 14:35:08 :

J'ai remanié le code: maintenant on peut charger les images du diapo, ensuite on clique sur StartDiaporama. Jai fait cela en associant une listBox à une imagelist

20 décembre 2007 11:17:37 :

Jai ajouter le son wav, grâce à la classe de "nicoenglbert" et le lancement au démarrage de windows au module de "yvesyves" Je les remercie tous les deux .

20 décembre 2007 16:34:36 :

Je me suis aperçu qu'en chargeant le diapo image, on pouvait ouvrir n'importe quel fichier, wav par exemple ce qui creer un bug.Je l'ai corrigé en forçant l'ouverture en JPG.

29 décembre 2007 15:53:48 :

on peut la mettre dans la zone de notification ou la lancer d'un click droit. On peut charger des adresses http de radio ou autres

02 janvier 2008 19:16:51 :

On peut lire les fichiers audios: MP3, WAV et WMA

06 janvier 2008 12:00:31 :

Utilisation de"drag and drop" pour déplacer le formulaire sans bordure.

04 février 2008 14:30:46 :

J'ai mis la playlist radio dans un fichier texte

26 février 2008 10:38:58 :

Ajout d'une suppression de "Favoris Radio", avec le snippet de "sebmafate" et "Raccourci Bureau" du cours VB Net de Philippe Lasserel. Je les remercie tout les deux.

14 mars 2008 18:07:19 :

Ajout d'une Playlist musicale.Si vous le désirez vous pouvez enregistrer le morceau que vous écoutez dans une Playlist, tout ce fait automatiquement. Vous rappelez votre Playlist quand vous le désirez et avec un double click, vous écoutez le morceau choisi.