|
Trouver une ressource
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !
HORLOGE DIAPORAMA
Information sur la source
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
- 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
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
Fichier Zip
Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !
-
Horloge
-
Horloge
|