Soyez le premier à donner votre avis sur cette source.
Vue 10 660 fois - Téléchargée 762 fois
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
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é
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.