Soyez le premier à donner votre avis sur cette source.
Snippet vu 5 111 fois - Téléchargée 42 fois
'Public Property Get JouerMusique1() As Long 'JouerMusique = m_BackColor 'End Property '****************************************** '** Author: Marc Baril ** '** Date: 19/01/2002 ** '****************************************** '** Description: Simplification de ** '** Clsmultimdia ** '** Wav,Midi,AVI ** '****************************************** '** Tested: On Windows 98 and XP ** '** ** '****************************************** '1 - Ajouter les musiques et les sons dans un répetoire respectif de votre projet '2 - Ajouter Se module se module ainsi que Execution.frm dans votre projet '3 - Ajouter Initialiser dans le Form_Load ou Form_Initialize de votre projet '4 - Pour jouer une musique utiliser JouerMusique (Index de la musique) '5 - Pour jouer un son utiliser JouerSound (Index du son) '7 - Commande utilisé: JouerMusique,JouerSound,PauseMusique,StopMusique,ContinueMusique Dim IsInitialiser, IsNotReInitialiser, IsContainFileOnInit, IsGoodFileNameOnInit, IsGoodIndex, IsOkBeforeRead, IsGoodFile, IsGoosType, IsGoodName, IsGoodFolder As Boolean 'sur form fairre arbre des erreur.. Dim NbMusique, NbSound, NbVideo As Integer Dim LireMusique(60), LireSound(60), LireVideo(60) As String Dim Filepath As String Public Enum Type_Degrade Escalier = 1 Glisanto = 2 End Enum Public Enum Arret_Type Musique = 1 Sound = 2 Tout = 3 End Enum Public Sub Initialiser() Dim Find As String If Execution.MMPlayer.IsSoundCardEnabled Then Else: Message (6) Find = Dir(App.Path & "\Musique\" & "*.*") If Find <> "" Then Do If Find <> "." And Find <> ".." Then NbMusique = NbMusique + 1 LireMusique(NbMusique) = "\Musique\" & Find End If Find = Dir() Loop Until Find = "" End If Find = Dir(App.Path & "\Sound\" & "*.*") If Find <> "" Then Do If Find <> "." And Find <> ".." Then NbSound = NbSound + 1 LireSound(NbSound) = "\Sound\" & Find End If Find = Dir() Loop Until Find = "" End If Find = Dir(App.Path & "\Video\" & "*.*") If Find <> "" Then Do If Find <> "." And Find <> ".." Then NbVideo = NbVideo + 1 LireVideo(NbVideo) = "\Video\" & Find End If Find = Dir() Loop Until Find = "" End If End Sub '************************************************************************************ '************************************************************************************ '************************************************************************************ Public Sub JouerMusique(Index As Integer) If IsNumeric(Index) Then If Index <= NbMusique And Index > 0 Then Filepath = App.Path & LireMusique(Index) Execution.MMPlayer.FileName = Filepath Execution.MMPlayer.Play Else If Index = 0 Then Message (7) Else Message (8) End If Else Execution.MVPlayer.FileName = App.Path & "\Musique\" & Index End If End Sub Public Sub JouerSound(Index As Integer) If IsNumeric(Index) Then If Index <= NbSound And Index > 0 Then Filepath = App.Path & LireSound(Index) Execution.SMPlayer.FileName = Filepath Execution.SMPlayer.Play Else If Index = 0 Then Message (9) Else Message (10) End If Else Execution.MVPlayer.FileName = App.Path & "\Sound\" & Index End If End Sub Public Sub JouerVideo(Emplacement_X As Integer, Emplacement_Y As Integer, Largeur As Integer, Longueur As Integer, Nom_du_Video As String) Execution.Height = Longueur Execution.Width = Largeur Execution.Top = Emplacement_Y Execution.Left = Emplacement_X Execution.MVPlayer.Height = Longueur Execution.MVPlayer.Width = Largeur Execution.MVPlayer.Top = 0 Execution.MVPlayer.Left = 0 Execution.Show If IsNumeric(Nom_du_Video) Then If Nom_du_Video <= NbVideo And Nom_du_Video > 0 Then Filepath = App.Path & LireVideo(Nom_du_Video) Execution.MVPlayer.FileName = Filepath Execution.MVPlayer.Play Else If Nom_du_Video = 0 Then Message (7) Else Message (8) End If Else Execution.Show Execution.MVPlayer.FileName = App.Path & "\Video\" & Nom_du_Video End If End Sub '************************************************************************************ '************************************************************************************ '************************************************************************************ Public Sub StopMultimedia(Apliquation_sur As Integer) On Error Resume Next If Apliquation_sur = 1 Then Execution.MMPlayer.Stop If Apliquation_sur = 1 Then Execution.MMPlayer.CurrentPosition = 1 If Apliquation_sur = 2 Then Execution.SMPlayer.Stop If Apliquation_sur = 3 Then Execution.MMPlayer.Stop If Apliquation_sur = 3 Then Execution.MMPlayer.CurrentPosition = 1 If Apliquation_sur = 3 Then Execution.SMPlayer.Stop End Sub Public Sub PauseMusique() On Error Resume Next Execution.MMPlayer.Pause End Sub '************************************************************************************ '************************************************************************************ '************************************************************************************ Public Sub SautMusique(Saut_de_combien_de_seconde As Integer) On Error Resume Next If Execution.MMPlayer.PlayState <> mpPlaying Then Exit Sub Execution.MMPlayer.CurrentPosition = Execution.MMPlayer.CurrentPosition + Saut_de_combien_de_seconde End Sub Public Sub ContinueMusique() On Error Resume Next Execution.MMPlayer.Play End Sub '************************************************************************************ '************************************************************************************ '************************************************************************************ Public Sub VolumeMusique(Nouveau_Volume_en_pourcentage As Integer, Apliquation_sur As Integer) On Error Resume Next Volume = (Nouveau_Volume_en_pourcentage * 25) - 2500 If Apliquation_sur = 1 Then Execution.MMPlayer.Volume = Volume If Type_Volume = 2 Then Execution.SMPlayer.Volume = Volume If Apliquation_sur = 3 Then Execution.MMPlayer.Volume = Volume If Apliquation_sur = 3 Then Execution.SMPlayer.Volume = Volume Execution.MMPlayer.Mute = IIf(Volume + 2500 = 0, True, False) End Sub Public Sub DegradeMusique(Durée_du_dégrader As Integer, Nouveau_Volume_en_pourcentage As Integer, Type_De_dégrader As Integer) On Error Resume Next Dim VolumeActuel As Integer Dim Facteur As Integer VolumeActuel = Execution.MMPlayer.Volume Facteur = ((((Nouveau_Volume_en_pourcentage * 25) - 2500) - VolumeActuel) / Durée_du_dégrader) Durée_du_dégrader = IIf(Type_Deg = Escalier, Durée_du_dégrader, Durée_du_dégrader * 10) For I = 1 To Durée_du_dégrader If Type_De_dégrader = Escalier Then Execution.MMPlayer.Volume = Execution.MMPlayer.Volume + Facteur Else Execution.MMPlayer.Volume = Execution.MMPlayer.Volume + Facteur / 10 If I = Durée_du_dégrader Then Execution.MMPlayer.Volume = (Nouveau_Volume_en_pourcentage * 25) - 2500 Execution.MMPlayer.Mute = IIf(Execution.MMPlayer.Volume = -2500, True, False) DoEvents If Type_De_dégrader = Escalier Then Pause 1 Else Pause 0.1 Next I End Sub Public Sub BalanceMusique(Nouvelle_Balance_de_100_a_minus_100 As Integer, Apliquation_sur As Integer) On Error Resume Next If Apliquation_sur = 1 Then Execution.MMPlayer.Balance = Nouvelle_Balance_de_100_a_minus_100 * 50 If Apliquation_sur = 2 Then Execution.SMPlayer.Balance = Nouvelle_Balance_de_100_a_minus_100 * 50 If Apliquation_sur = 3 Then Execution.MMPlayer.Balance = Nouvelle_Balance_de_100_a_minus_100 * 50 If Apliquation_sur = 3 Then Execution.SMPlayer.Balance = Nouvelle_Balance_de_100_a_minus_100 * 50 End Sub Public Sub Message(Index As Integer) If Index = 7 Then MsgBox ("Un appel à la musique indexée 0 a été faite,changer l'indexe inexistant s,il s'agit d'une erreur de code et Vérifier que la musique désirée se trouve bien dans le répertoire Musique dans un sous dossier de votre projet") If Index = 8 Then MsgBox ("Un appel à la musique don l'index est inéxistante a été faite,mais la musique appelée n'existe pas.Vous devez changé cet indexe.") If Index = 9 Then MsgBox ("Un appel à un son indexé 0 a été faite,changer l'indexe inexistant s,il s'agit d'une erreur de code et Vérifier que le son désirée se trouve bien dans le répertoire Musique dans un sous dossier de votre projet") If Index = 10 Then MsgBox ("Un appel à un son d'on l'index est inéxistante a été faite,mais le son appelé n'existe pas.Vous devez changé cet indexe.") If Index = 11 Then MsgBox ("Les dossiers Musique et Sound dans votre projet son introuvable veyez les ajouter ,louverture du programme doit etre interompu.") End Sub '************************************************************************************ '************************************************************************************ 'Ajout pour simplifier la programmation '************************************************************************************ 'Pause permet plusieur fonction symultané,mais Sleep jele tout les controles 'Pause fontionne au 0.5 seconde et Sleep au miliemme Public Sub Pause(NbSec As Single) Dim Sortie As Single Sortie = Timer + NbSec DoEvents Do Until Timer >= Sortie Loop End Sub Private Sub UserControl_Resize() UserControl.Height = 720 UserControl.Width = 720 End Sub Maintenant la form execution avec du code de florant 'Code de Florent. 'Si vous ajoutez ce code dans un de vos programmes, citez-moi. Option Explicit Public OldWidth As Integer 'On va stocker l'ancienne largeur de la feuille dans cette variable Public OldHeight As Integer 'De même pour le hauteur Private Sub Form_Load() OldWidth = Width 'Au chargement, l'ancienne largeur de la feuille est la largeur actuelle OldHeight = Height 'De même pour la hauteur End Sub Private Sub Form_Resize() On Error Resume Next 'Si il y a une erreur, on continue Dim XCoeff As Single 'Le coefficient qui va nous servir pour la largeur et le placement horizontal des contrôles Dim YCoeff As Single 'De même pour la hauteur et le placement vertical des contrôles Dim Controle As Control 'Control représente n'importe quel contrôle de la feuille XCoeff = Width / OldWidth 'Un simple rapport entre la nouvelle largeur et l'ancienne YCoeff = Height / OldHeight 'Dee même pour la hauteur For Each Controle In Me 'Pour chaque controle de la feuille... Controle.Move Controle.Left * XCoeff, Controle.Top * YCoeff, Controle.Width * XCoeff, Controle.Height * YCoeff 'On le déplace et redimmentionne en même temps Next 'Et on passe au suivant OldWidth = Width 'On change l'ancienne largeur par la nouvelle OldHeight = Height 'De même avec la hauteur End Sub 'vérifier fichier 'Fichier_Existe= IIF(Dir(Path ) = "",true,false)
Sinon j'avoue que je n'ai pas tout compris...
A la place du enum, pourquoi tu ne créé pas seulmement une fonction ou une méthode qui demande en argument le numéro de la musique à jouer?
:o(
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.