Mini séquenseur

Soyez le premier à donner votre avis sur cette source.

Vue 10 601 fois - Téléchargée 760 fois

Description

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 / Exemple :


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

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
51
Date d'inscription
dimanche 11 décembre 2005
Statut
Membre
Dernière intervention
11 octobre 2014

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é
Messages postés
121
Date d'inscription
vendredi 17 octobre 2003
Statut
Membre
Dernière intervention
14 octobre 2016

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.

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.