Mini séquenseur
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.
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
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.