begin process at 2012 02 10 23:05:44
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Multimedia

 > MINI SÉQUENSEUR

MINI SÉQUENSEUR


 Information sur la source

Note :
8 / 10 - par 1 personne
8,00 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :Multimedia Classé sous :directsound, sequencer, musique, wav, evildark Niveau :Débutant Date de création :25/02/2008 Date de mise à jour :27/02/2008 16:27:16 Vu / téléchargé :8 742 / 505

Auteur : EvildarkEurope

Ecrire un message privé
Site perso
Commentaire sur cette source (2)
Ajouter un commentaire et/ou une note

 Description

Cliquez pour voir la capture en taille normale
Il s'agit d'une petite boite à rythme de taille 9x9,
On peut jouer des sons à la suite en activant les cellules,
Ce programme utilise directsound7.

Source

  • Option Explicit
  • Const TX = 9 '<= 9
  • Const TY = 9 '<= 9
  • '------------------
  • Private DX As New DirectX7
  • Private DS As DirectSound
  • Private bufferDesc As DSBUFFERDESC
  • Private waveFormat As WAVEFORMATEX
  • Private Type KeyPad
  • Enabled As Boolean
  • Filename As String
  • Soundbuffer As DirectSoundBuffer
  • End Type
  • Dim Sequencer() As KeyPad
  • Private Tracker As Integer
  • '
  • Private Sub Form_Load()
  • Form1.Caption = " Séquencer v" & App.Major & "." & App.Minor & " " & App.Comments
  • ReDim Sequencer(1 To TX, 1 To TY)
  • Tracker = 0
  • If LedInit <> 0 Or SoundInit <> 0 Then
  • MsgBox "Erreur d'initialisation", vbExclamation
  • Unload Me
  • End If
  • Me.Show
  • AfficheLed
  • End Sub
  • '
  • Private Function LedInit() As Long
  • Dim X, Y As Integer
  • On Error GoTo Trap
  • For Y = 1 To TY
  • Load SelectSample(Y)
  • With SelectSample(Y)
  • .Left = 0
  • .Top = SelectSample(0).Height * (Y - 1) + LTempo.Height
  • .Visible = True
  • End With
  • For X = 1 To TX
  • Load Led1(Val(X & Y))
  • Load Led0(Val(X & Y))
  • With Led1(Val(X & Y))
  • .Left = Led1(0).Width * (X - 1) + Led1(0).Width
  • .Top = Led1(0).Height * (Y - 1) + LTempo.Height
  • .Visible = False
  • End With
  • With Led0(Val(X & Y))
  • .Left = Led0(0).Width * (X - 1) + Led0(0).Width
  • .Top = Led0(0).Height * (Y - 1) + LTempo.Height
  • .Visible = True
  • End With
  • Next: Next
  • Exit Function
  • Trap:
  • Debug.Print "LedInit /!\ " & Err.Description
  • LedInit = Err.Number
  • End Function
  • ' Initialise DirectSound
  • Private Function SoundInit() As Long
  • On Error GoTo Trap
  • Set DS = DX.DirectSoundCreate("")
  • DS.SetCooperativeLevel Form1.hWnd, DSSCL_PRIORITY
  • ' Initialise le buffer DirectSound
  • bufferDesc.lFlags = DSBCAPS_CTRLFREQUENCY Or DSBCAPS_CTRLPAN Or DSBCAPS_CTRLVOLUME Or DSBCAPS_STATIC
  • ' Initialise le format audio
  • waveFormat.nFormatTag = WAVE_FORMAT_PCM
  • waveFormat.nChannels = 2
  • waveFormat.lSamplesPerSec = 22050
  • waveFormat.nBitsPerSample = 16
  • waveFormat.nBlockAlign = waveFormat.nBitsPerSample / 8 * waveFormat.nChannels
  • waveFormat.lAvgBytesPerSec = waveFormat.lSamplesPerSec * waveFormat.nBlockAlign
  • Exit Function
  • Trap:
  • Debug.Print "Soundinit /!\ " & Err.Description
  • SoundInit = Err.Number
  • End Function
  • '
  • Private Sub Command_Click(Index As Integer)
  • Select Case Index
  • Case 0
  • Tempo.Enabled = True
  • Command(0).Visible = False
  • Case 1
  • Tempo.Enabled = False
  • Command(0).Visible = True
  • StopSequence
  • Case 2
  • Tempo.Enabled = False
  • Command(0).Visible = True
  • StopSequence
  • Tracker = 0
  • Case 3
  • If Tempo.Interval <= 1999 Then Tempo.Interval = Tempo.Interval + 50
  • Case 4
  • If Tempo.Interval >= 51 Then Tempo.Interval = Tempo.Interval - 50
  • End Select
  • AfficheLed
  • End Sub
  • '
  • Private Sub Led0_Click(Index As Integer)
  • Dim X, Y As Integer
  • X = Left(Index, 1)
  • Y = Right(Index, 1)
  • Sequencer(X, Y).Enabled = True
  • AfficheLed
  • End Sub
  • '
  • Private Sub Led1_Click(Index As Integer)
  • Dim X, Y As Integer
  • X = Left(Index, 1)
  • Y = Right(Index, 1)
  • Sequencer(X, Y).Enabled = False
  • AfficheLed
  • End Sub
  • '
  • Private Sub SelectSample_Click(Index As Integer)
  • On Error GoTo Abort:
  • With CMD
  • .DialogTitle = "Ouvrir un sample"
  • .InitDir = App.Path
  • .Filter = "Fichiers audio (*.wav)|*.wav"
  • End With
  • CMD.ShowOpen
  • Sequencer(1, Index).Filename = CMD.Filename
  • Call SoundLoad(Sequencer(1, Index).Filename, Index)
  • Exit Sub
  • Abort:
  • Sequencer(1, Index).Filename = ""
  • End Sub
  • ' Charge les sons en memoire
  • Private Sub SoundLoad(Filename As String, Index As Integer)
  • Dim X As Integer
  • 'On Error GoTo Trap
  • If Dir(Filename, vbNormal) = "" Then GoTo Trap:
  • For X = 1 To TX
  • Set Sequencer(X, Index).Soundbuffer = DS.CreateSoundBufferFromFile(Filename, bufferDesc, waveFormat)
  • Next
  • Exit Sub
  • Trap:
  • Debug.Print "Soundload /!\ " & Err.Description
  • End Sub
  • '
  • Private Sub Tempo_Timer()
  • On Error GoTo Error
  • Tracker = Tracker Mod TX + 1
  • AfficheLed
  • PlaySequence
  • DoEvents
  • Exit Sub
  • Error:
  • Command_Click (2)
  • End Sub
  • '
  • Private Sub PlaySequence()
  • Dim Y As Integer
  • On Error Resume Next
  • For Y = 1 To TY
  • If Sequencer(Tracker, Y).Enabled = True And Sequencer(1, Y).Filename <> "" Then
  • Call SoundStop(Val(Tracker & Y))
  • Call SoundPlay(Val(Tracker & Y), 0)
  • End If
  • Next
  • End Sub
  • '
  • Private Sub StopSequence()
  • Dim X, Y As Integer
  • On Error Resume Next
  • For X = 1 To TX
  • For Y = 1 To TY
  • If Sequencer(1, Y).Filename <> "" Then Call SoundStop(Val(X & Y))
  • Next: Next
  • End Sub
  • ' Joue un son
  • Private Sub SoundPlay(SoundID As Integer, Looped As Integer)
  • Dim X, Y As Integer
  • On Error GoTo Trap
  • X = Left(SoundID, 1)
  • Y = Right(SoundID, 1)
  • Sequencer(X, Y).Soundbuffer.Play Looped
  • Exit Sub
  • Trap:
  • Debug.Print "Soundplay /!\ " & Err.Description
  • End Sub
  • ' Stop un son
  • Private Sub SoundStop(SoundID As Integer)
  • Dim X, Y As Integer
  • On Error GoTo Trap
  • X = Left(SoundID, 1)
  • Y = Right(SoundID, 1)
  • Sequencer(X, Y).Soundbuffer.Stop
  • Exit Sub
  • Trap:
  • Debug.Print "Soundstop /!\ " & Err.Description
  • End Sub
  • '
  • Private Sub AfficheLed()
  • Dim X, Y As Integer
  • On Error GoTo Error
  • For Y = 1 To TY
  • For X = 1 To TX
  • If X = Tracker Then
  • Led0(Val(X & Y)).Picture = Skin(1).Picture
  • Led1(Val(X & Y)).Picture = Skin(3).Picture
  • Else
  • Led0(Val(X & Y)).Picture = Skin(0).Picture
  • Led1(Val(X & Y)).Picture = Skin(2).Picture
  • End If
  • If Sequencer(X, Y).Enabled = True Then
  • Led1(Val(X & Y)).Visible = True
  • Else
  • Led1(Val(X & Y)).Visible = False
  • End If
  • Next: Next
  • LTempo.Caption = "Wait, " & Tempo.Interval
  • Exit Sub
  • Error:
  • Debug.Print "AfficheLed /!\ " & Err.Description
  • End Sub
  • '
  • Private Sub Form_Unload(Cancel As Integer)
  • SoundUnload
  • LedUnload
  • End
  • End Sub
  • ' Libere la mémoire
  • Private Sub SoundUnload()
  • Set DS = Nothing
  • Set DX = Nothing
  • End Sub
  • '
  • Private Sub LedUnload()
  • Dim X, Y As Integer
  • On Error GoTo Error
  • For Y = 1 To TY
  • Unload SelectSample(Y)
  • For X = 1 To TX
  • Unload Led1(Val(X & Y))
  • Unload Led0(Val(X & Y))
  • Next: Next
  • Exit Sub
  • Error:
  • Debug.Print "LedUnload /!\ " & Err.Description
  • End Sub
Option Explicit
Const TX = 9 '<= 9
Const TY = 9 '<= 9
'------------------
Private DX As New DirectX7
Private DS As DirectSound
Private bufferDesc As DSBUFFERDESC
Private waveFormat As WAVEFORMATEX
Private Type KeyPad
    Enabled As Boolean
    Filename As String
    Soundbuffer As DirectSoundBuffer
End Type
Dim Sequencer() As KeyPad
Private Tracker As Integer
'
Private Sub Form_Load()
Form1.Caption = " Séquencer v" & App.Major & "." & App.Minor & " " & App.Comments
ReDim Sequencer(1 To TX, 1 To TY)
Tracker = 0
If LedInit <> 0 Or SoundInit <> 0 Then
    MsgBox "Erreur d'initialisation", vbExclamation
    Unload Me
End If
Me.Show
AfficheLed
End Sub
'
Private Function LedInit() As Long
Dim X, Y As Integer
On Error GoTo Trap
For Y = 1 To TY
    Load SelectSample(Y)
    With SelectSample(Y)
        .Left = 0
        .Top = SelectSample(0).Height * (Y - 1) + LTempo.Height
        .Visible = True
    End With
For X = 1 To TX
    Load Led1(Val(X & Y))
    Load Led0(Val(X & Y))
    With Led1(Val(X & Y))
        .Left = Led1(0).Width * (X - 1) + Led1(0).Width
        .Top = Led1(0).Height * (Y - 1) + LTempo.Height
        .Visible = False
    End With
    With Led0(Val(X & Y))
        .Left = Led0(0).Width * (X - 1) + Led0(0).Width
        .Top = Led0(0).Height * (Y - 1) + LTempo.Height
        .Visible = True
    End With
Next: Next
Exit Function

Trap:
Debug.Print "LedInit /!\ " & Err.Description
LedInit = Err.Number
End Function
' Initialise DirectSound
Private Function SoundInit() As Long
On Error GoTo Trap
Set DS = DX.DirectSoundCreate("")
DS.SetCooperativeLevel Form1.hWnd, DSSCL_PRIORITY
' Initialise le buffer DirectSound
bufferDesc.lFlags = DSBCAPS_CTRLFREQUENCY Or DSBCAPS_CTRLPAN Or DSBCAPS_CTRLVOLUME Or DSBCAPS_STATIC
' Initialise le format audio
waveFormat.nFormatTag = WAVE_FORMAT_PCM
waveFormat.nChannels = 2
waveFormat.lSamplesPerSec = 22050
waveFormat.nBitsPerSample = 16
waveFormat.nBlockAlign = waveFormat.nBitsPerSample / 8 * waveFormat.nChannels
waveFormat.lAvgBytesPerSec = waveFormat.lSamplesPerSec * waveFormat.nBlockAlign
Exit Function

Trap:
Debug.Print "Soundinit /!\ " & Err.Description
SoundInit = Err.Number
End Function
'
Private Sub Command_Click(Index As Integer)
Select Case Index
Case 0
    Tempo.Enabled = True
    Command(0).Visible = False
Case 1
    Tempo.Enabled = False
    Command(0).Visible = True
    StopSequence
Case 2
    Tempo.Enabled = False
    Command(0).Visible = True
    StopSequence
    Tracker = 0
Case 3
    If Tempo.Interval <= 1999 Then Tempo.Interval = Tempo.Interval + 50
Case 4
    If Tempo.Interval >= 51 Then Tempo.Interval = Tempo.Interval - 50
End Select
AfficheLed
End Sub
'
Private Sub Led0_Click(Index As Integer)
Dim X, Y As Integer
X = Left(Index, 1)
Y = Right(Index, 1)
Sequencer(X, Y).Enabled = True
AfficheLed
End Sub
'
Private Sub Led1_Click(Index As Integer)
Dim X, Y As Integer
X = Left(Index, 1)
Y = Right(Index, 1)
Sequencer(X, Y).Enabled = False
AfficheLed
End Sub
'
Private Sub SelectSample_Click(Index As Integer)
On Error GoTo Abort:
With CMD
    .DialogTitle = "Ouvrir un sample"
    .InitDir = App.Path
    .Filter = "Fichiers audio (*.wav)|*.wav"
End With
CMD.ShowOpen
Sequencer(1, Index).Filename = CMD.Filename
Call SoundLoad(Sequencer(1, Index).Filename, Index)
Exit Sub

Abort:
Sequencer(1, Index).Filename = ""
End Sub
' Charge les sons en memoire
Private Sub SoundLoad(Filename As String, Index As Integer)
Dim X As Integer
'On Error GoTo Trap
If Dir(Filename, vbNormal) = "" Then GoTo Trap:
For X = 1 To TX
    Set Sequencer(X, Index).Soundbuffer = DS.CreateSoundBufferFromFile(Filename, bufferDesc, waveFormat)
Next
Exit Sub

Trap:
Debug.Print "Soundload /!\ " & Err.Description
End Sub
'
Private Sub Tempo_Timer()
On Error GoTo Error
Tracker = Tracker Mod TX + 1
AfficheLed
PlaySequence
DoEvents
Exit Sub

Error:
Command_Click (2)
End Sub
'
Private Sub PlaySequence()
Dim Y As Integer
On Error Resume Next
For Y = 1 To TY
    If Sequencer(Tracker, Y).Enabled = True And Sequencer(1, Y).Filename <> "" Then
        Call SoundStop(Val(Tracker & Y))
        Call SoundPlay(Val(Tracker & Y), 0)
    End If
Next
End Sub
'
Private Sub StopSequence()
Dim X, Y As Integer
On Error Resume Next
For X = 1 To TX
For Y = 1 To TY
    If Sequencer(1, Y).Filename <> "" Then Call SoundStop(Val(X & Y))
Next: Next
End Sub
' Joue un son
Private Sub SoundPlay(SoundID As Integer, Looped As Integer)
Dim X, Y As Integer
On Error GoTo Trap
X = Left(SoundID, 1)
Y = Right(SoundID, 1)
Sequencer(X, Y).Soundbuffer.Play Looped
Exit Sub

Trap:
Debug.Print "Soundplay /!\ " & Err.Description
End Sub
' Stop un son
Private Sub SoundStop(SoundID As Integer)
Dim X, Y As Integer
On Error GoTo Trap
X = Left(SoundID, 1)
Y = Right(SoundID, 1)
Sequencer(X, Y).Soundbuffer.Stop
Exit Sub

Trap:
Debug.Print "Soundstop /!\ " & Err.Description
End Sub
'
Private Sub AfficheLed()
Dim X, Y As Integer
On Error GoTo Error
For Y = 1 To TY
For X = 1 To TX
    If X = Tracker Then
        Led0(Val(X & Y)).Picture = Skin(1).Picture
        Led1(Val(X & Y)).Picture = Skin(3).Picture
    Else
        Led0(Val(X & Y)).Picture = Skin(0).Picture
        Led1(Val(X & Y)).Picture = Skin(2).Picture
    End If
    If Sequencer(X, Y).Enabled = True Then
        Led1(Val(X & Y)).Visible = True
    Else
        Led1(Val(X & Y)).Visible = False
    End If
Next: Next
LTempo.Caption = "Wait, " & Tempo.Interval
Exit Sub

Error:
Debug.Print "AfficheLed /!\ " & Err.Description
End Sub
'
Private Sub Form_Unload(Cancel As Integer)
SoundUnload
LedUnload
End
End Sub
' Libere la mémoire
Private Sub SoundUnload()
Set DS = Nothing
Set DX = Nothing
End Sub
'
Private Sub LedUnload()
Dim X, Y As Integer
On Error GoTo Error
For Y = 1 To TY
    Unload SelectSample(Y)
For X = 1 To TX
    Unload Led1(Val(X & Y))
    Unload Led0(Val(X & Y))
Next: Next
Exit Sub

Error:
Debug.Print "LedUnload /!\ " & Err.Description
End Sub


 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Historique

25 février 2008 01:07:15 :
?

 Sources du même auteur

Source avec Zip Source avec une capture DNS REDIRECTION
Source avec Zip Source avec une capture JEU DE CARTES CELEBRE ONLINE
Source avec Zip Source avec une capture CUBE SYSTEM
Source avec Zip Source avec une capture SYNARCHIVEUR 1.3
Source avec Zip Source avec une capture EDITEUR DE NEWSLETTERS

 Sources de la même categorie

Source avec Zip Source .NET (Dotnet) MON LECTEUR MP3 par kentharold
Source avec Zip Source avec une capture LECTEUR MULTIMÉDIA par lartiguef
Source avec Zip Source avec une capture RENOMMER SOUS-TITRES par memejoueur
Source .NET (Dotnet) "PARLEUR" EN VB 2010 par clementgeek41
Source avec Zip Source avec une capture CHANGER LE VOLUME SYSTÉME SANS ACTIVEX par kayoub5

 Sources en rapport avec celle ci

Source avec Zip CHARLIE'S LAUNCH WAVE MACHINE par CHAR As Human
Source avec Zip LECTURE SON WAV EN BOUCLE PRE-DEFINIT par bayanathicham
Source avec Zip JOUER UN SON WAV AVEC DX SOUND 7 par bayanathicham
Source avec Zip Source avec une capture CDTRACKSXTRACTOR V1.0 POUR EXTRAIRE LES PISTES DES CD AUDIO... par soldier8514
Source avec Zip TARAMINOMP3 par Taramino

Commentaires et avis

Commentaire de Chrysostome le 04/03/2008 08:07:47 8/10

Salut,
comme personne n'a encore posté, je viens d'essayer et il me semble très bien fait. Je vais regarder le code maintenant. Encore bravo.

Commentaire de EvildarkEurope le 05/03/2008 00:02:46

Merci beaucoup du coup d'oeil,
j'ai fait ce prog pour passer le temps, il ne faut pas s'attendre a quelque chose de compliquer ( je n'ai pas négliger le codage pour autant ).

Ma conclusion aprés le dévelopement de ce programme :
je suis plus douer pour faire clignoté des Led que dans le rôle d'un musicien.
sinon c'est géniale pour faire du bruit ^^ et je félicite le premier qui me joue quelque chose de audible avec cela xD
héhé

 Ajouter un commentaire


Discussions en rapport avec ce code source dans le forum

Problème de musique *.wav et de touche de clavier [ par Max2034 ] Salut!J'essaye de mettre de la musique et faire bouger un bonhomme dans mon programme, dans VB6, mais rien ne fonctionne. J'ai essayer ceci mais rien Lire 2 fichiers .wav en même temps [ par mstarsup5 ] Bonjour à tous,Je suis entrain d'essayer de programmer un petit jeu, et j'aimerais pouvoir mettre à la fois une musique de fond et des petits bruits d Comment avoir la duree d'un fichier wav chargé avec DirectSound (7 ou 8) [ par 753654 ] Salut a toute et a tous voila , tout est expliqué dans le titre : Comment avoir la duree d'un fichier wav chargé avec DirectSound (7 ou 8)[^^confus2][ générer sur disque du wav en mixant des wav + gestion volume complexe [ par jcsydney ] Bonjour   <p class="MsoNormal" sty Rechercher dans une chaine [ par Le newbie ] Salut.J'ai une chaine "C:\toto tata\test toto.wav 1/0/230/4268/51023/41023 toto radioreveil machin"Je voudrais seulement récupérer la valeur de la cha Lire/Ecrire Entête fichier Wav [ par EvilGost ] Bonjour à tous,voilà, j'ai un problème bien épineux. Je dois lire et écrire une entête d'un fichier wav. Je m'explique, j'ai une appli (qui n'est pas Jouer un son en cliquant sur un fichier WAV de l'explorateur [ par Cpapy ] Bonjour à tous,Je voudrais écouter un fichier WAV  en cliquant sur son nom  dans l'explorateur Windows.Le code ci-dessous marche correctement lorsqu'i Intégrer des Fichiers .wav dans projet [ par wallace1 ] comment inclure des fichiers .wav dans mon projet (VB 2005) pour qu'il puisse ensuite sous l'action d'un bouton être déposé dans un répertoire quelcon Code pour lier bouton et fichiers .wav ? [ par wallace1 ] On m'a partiellement aidé pour mon projet (en VB2005)(Merci Jack).Une autre partie consiste sous l'action d'un bouton de déposer des fichiers sons (.w Arreter un fichier WAV en VB6 [ par Azm ] Bonjour,Comment arreter le joue de son WAV en VB6Merci.


Nos sponsors


Sondage...

Comparez les prix

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

Photothèque

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 6,287 sec (3)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales