regismalt
Messages postés2Date d'inscriptionmardi 17 mars 2009StatutMembreDernière intervention30 mars 2009
-
27 mars 2009 à 17:38
regismalt
Messages postés2Date d'inscriptionmardi 17 mars 2009StatutMembreDernière intervention30 mars 2009
-
30 mars 2009 à 04:18
Bonjour, je suis présentement des cours de percussion africaine et je désire me faire un outil pour entrer mes partitions et mes rythmes.
J'ai utilisé un métronome qu j'ai trouvé dans ce site comme point de départ.
Le problème que j'essaie de résoudre est que le son Wav à un tempo élévé est abrégé et ne sonne pas bien.
SVP, Pouvez-vous m'aider?
Le tempo est à 240 et la partition (Texte2) est B-AA--C-B-AA--C-
Ce rythme est le KuKu.
Je vous joint ci-dessous le code que j'ai ecrit jusqu'a présent:
CLASSE1:
Option Explicit
'-----------------------------------------------------
' Name : MMedia.cls
' Author : Peter Wright, For BG2VB4 & BG2VB5
'
' Notes : A multimedia class, which when turned
' : into an object lets you load and play
' : multimedia files, such as sound and
' : video.
'-----------------------------------------------------
' -=-=-=- PROPERTIES -=-=-=-
' Filename Determines the name of the current file
' Length The length of the file (Read Only)
' Position The current position through the file
' Status The current status of the object (Read Only)
' Wait True/False...tells VB to wait until play done
' -=-=-=- METHODS -=-=-=-=-
' mmOpen <Filename> Opens the requested filename
' mmClose Closes the current file
' mmPause Pauses playback of the current file
' mmStop Stops playback ready for closedown
' mmSeek Seeks to a position in the file
' mmPlay Plays the open file
'-------------------------------------------------------------
' NOTES
' -----
'
' Open a file, then play it. Pause it in response to a request
' from the user. Stop if you intend to seek to the start and
' play again. Close when you no longer want to play the file
'--------------------------------------------------------------
Private sAlias As String ' Used internally to give an alias name to
' the multimedia resource
Private sFilename As String ' Holds the filename internally
Private nLength As Single ' Holds the length of the filename
' internally
Private nPosition As Single ' Holds the current position internally
Private sStatus As String ' Holds the current status as a string
Private bWait As Boolean ' Determines if VB should wait until play
' is complete before returning.
'------------ API DECLARATIONS -------------
'note that this is all one code line:
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Public Sub mmOpen(ByVal sTheFile As String)
' Declare a variable to hold the value returned by mciSendString
Dim nReturn As Long
' Declare a string variable to hold the file type
Dim sType As String
' Opens the specified multimedia file, and closes any
' other that may be open
If sAlias <> "" Then
mmClose
End If
' Determine the type of file from the file extension
Select Case UCase$(Right$(sTheFile, 3))
Case "WAV"
sType = "Waveaudio"
Case "MP3"
sType = "MPEGVideo"
Case "AVI"
sType = "AviVideo"
Case "MID"
sType = "Sequencer"
Case Else
' If the file extension is not known then exit the subroutine
Exit Sub
End Select
sAlias = Right$(sTheFile, 3) & Minute(Now)
' At this point there is no file open, and we have determined the
' file type. Now would be a good time to open the new file.
' Note: if the name contains a space we have to enclose it in quotes
If InStr(sTheFile, " ") Then sTheFile = Chr(34) & sTheFile & Chr(34)
nReturn = mciSendString("Open " & sTheFile & " ALIAS " & sAlias & " TYPE " & sType & " wait", "", 0, 0)
End Sub
Public Sub mmClose()
' Closes the currently opened multimedia file
' Declare a variable to hold the return value from the mciSendString
' command
Dim nReturn As Long
' If there is no file currently open then exit the subroutine
If sAlias = "" Then Exit Sub
nReturn = mciSendString("Close " & sAlias, "", 0, 0)
sAlias = ""
sFilename = ""
End Sub
Public Sub mmPause()
' Pause playback of the file
' Declare a variable to hold the return value from the mciSendString
' command
Dim nReturn As Long
' If there is no file currently open then exit the subroutine
If sAlias = "" Then Exit Sub
nReturn = mciSendString("Pause " & sAlias, "", 0, 0)
End Sub
Public Sub mmPlay()
' Plays the currently open file, from the current position
' Declare a variable to hold the return value from the mciSendString
' command
Dim nReturn As Long
' If there is no file currently open, then exit the routine
If sAlias = "" Then Exit Sub
' Now play the file
If bWait Then
nReturn = mciSendString("Play " & sAlias & " wait", "", 0, 0)
Else
nReturn = mciSendString("Play " & sAlias, "", 0, 0)
End If
End Sub
Public Sub mmStop()
' Stop using a file totally, be it playing or whatever
' Declare a variable to hold the return value from mciSendString
Dim nReturn As Long
' If there is no file currently open then exit the subroutine
If sAlias = "" Then Exit Sub
nReturn = mciSendString("Stop " & sAlias, "", 0, 0)
End Sub
Public Sub mmWait()
' Stop using a file totally, be it playing or whatever
' Declare a variable to hold the return value from mciSendString
Dim nReturn As Long
' If there is no file currently open then exit the subroutine
If sAlias = "" Then Exit Sub
nReturn = mciSendString("Wait " & sAlias, "", 0, 0)
End Sub
Public Sub mmSeek(ByVal nPosition As Single)
' Seeks to a specific position within the file
' Declare a variable to hold the return value from the mciSendString
' function
Dim nReturn As Long
nReturn = mciSendString("Seek " & sAlias & " to " & nPosition, "", 0, 0)
End Sub
Property Get Filename() As String
' Routine to return a value when the programmer asks the
' object for the value of its Filename property
Filename = sFilename
End Property
Property Let Filename(ByVal sTheFile As String)
' Routine to set the value of the filename property, should the programmer
' wish to do so. This implies that the programmer actually wants to open
' a file as well so control is passed to the mmOpen routine
mmOpen sTheFile
End Property
Property Get Wait() As Boolean
' Routine to return the value of the object's wait property.
Wait = bWait
End Property
Property Let Wait(bWaitValue As Boolean)
' Routine to set the value of the object's wait property
bWait = bWaitValue
End Property
Property Get Length() As Single
' Routine to return the length of the currently opened multimedia file
' Declare a variable to hold the return value from the mciSendString
Dim nReturn As Long, nLength As Integer
' Declare a string to hold the returned length from the mci Status call
Dim sLength As String * 255
' If there is no file open then return 0
If sAlias = "" Then
Length = 0
Exit Property
End If
Property Let Position(ByVal nPosition As Single)
' Sets the Position property effectively by seeking
mmSeek nPosition
End Property
Property Get Position() As Single
' Returns the current position in the file
' Declare a variable to hold the return value from mciSendString
Dim nReturn As Integer, nLength As Integer
' Declare a variable to hold the position returned
' by the mci Status position command
Dim sPosition As String * 255
' If there is no file currently opened then exit the subroutine
If sAlias = "" Then Exit Property
' Get the position and return
nReturn = mciSendString("Status " & sAlias & " position", sPosition, 255, 0)
nLength = InStr(sPosition, Chr$(0))
Position = Val(Left$(sPosition, nLength - 1))
End Property
Property Get Status() As String
' Returns the playback/record status of the current file
' Declare a variable to hold the return value from mciSendString
Dim nReturn As Integer, nLength As Integer
' Declare a variable to hold the return string from mciSendString
Dim sStatus As String * 255
' If there is no file currently opened, then exit the subroutine
If sAlias = "" Then Exit Property
'*****************************************************************
' Voila, c'est juste un simple métronome pour les gratteux... ;-)
' Si vous avez des questions... lordwarren@hotmail.com
'*****************************************************************
Private Declare Function Beep Lib "KERNEL32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Private Declare Function Sleep Lib "KERNEL32" (ByVal dwMilliseconds As Long)
Private Declare Function GetSaveFileNameA Lib "comdlg32.dll" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Const SND_ASYNC = &H1 ' play asynchronously
Public Tempo As Integer
Public Frq As Integer
Public Dur As Byte
Public i As Byte
Dim Multimedia As New Class1
Dim uneNote As String
Dim i2 As Integer
Dim counter As Integer
Dim returnvalue As Boolean
Const DEF_DJEMBE_BLANK As String = "_"
Const DEF_DJEMBE_NONE As String = "-"
Const DEF_DJEMBE_BASSE As String = "B"
Const DEF_DJEMBE_BASSE_BASSE As String = "H"
Const DEF_DJEMBE_BASSE_CLAQUE As String = "J"
Const DEF_DJEMBE_BASSE_TONIQUE As String = "I"
Const DEF_DJEMBE_CLAQUE As String = "C"
Const DEF_DJEMBE_CLAQUE_COLLE As String = "D"
Const DEF_DJEMBE_CLAQUE_CLAQUE As String = "F"
Const DEF_DJEMBE_TONIQUE As String = "A"
Const DEF_DJEMBE_TONIQUE_CLAQUE As String = "E"
Const DEF_DJEMBE_TONIQUE_TONIQUE As String = "G"
Const DEF_DJEMBE_DBL_BASSE As String = "M"
Const DEF_DJEMBE_DBL_CLAQUE As String = "K"
Const DEF_DJEMBE_DBL_TONIQUE As String = "L"
Dim Snd_djembe_basse As New Class1
Dim Snd_djembe_basse_basse As New Class1
Dim Snd_djembe_basse_claque As New Class1
Dim Snd_djembe_basse_tonique As New Class1
Dim Snd_djembe_claque As New Class1
Dim Snd_djembe_claque_colle As New Class1
Dim Snd_djembe_claque_claque As New Class1
Dim Snd_djembe_tonique As New Class1
Dim Snd_djembe_tonique_claque As New Class1
Dim Snd_djembe_tonique_tonique As New Class1
'Snd_dun_open = new Sound();
'Snd_dun_open.attachSound('kenkeni_open');
'Snd_dun_close = new Sound();
'Snd_dun_close.attachSound('kenkeni_close');
'Snd_cloche_open = new Sound();
'Snd_cloche_open.attachSound('kenkeni_bell_open');
'Snd_cloche_close = new Sound();
'Snd_cloche_close.attachSound('kenkeni_bell_close');
Dim Snd_Click As New Class1
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Function SaveAsCommonDialog(Optional sTitle = "Save File", Optional sFilter As String, Optional sDefaultDir As String) As String
Const clBufferLen As Long = 255
Dim OFName As OPENFILENAME, sBuffer As String * clBufferLen
On Error GoTo ExitFunction
OFName.lStructSize = Len(OFName)
OFName.hwndOwner = GetActiveWindow 'or Me.hwnd in VB
OFName.hInstance = 0 'or App.hInstance in VB
If Len(sFilter) Then
OFName.lpstrFilter = sFilter
Else
OFName.lpstrFilter = "Text Files (*.txt)" & Chr$(0) & "*.txt" & Chr$(0) & "All Files (*.*)" & Chr$(0) & "*.*" & Chr$(0)
End If
OFName.lpstrFile = sBuffer
OFName.nMaxFile = clBufferLen 'Set max number of characters
OFName.lpstrFileTitle = sBuffer
OFName.nMaxFileTitle = clBufferLen 'Set max number of characters
'Set the initial directory
If Len(sDefaultDir) Then
OFName.lpstrInitialDir = sDefaultDir
Else
OFName.lpstrInitialDir = CurDir$
End If
OFName.lpstrTitle = sTitle
OFName.flags = 0
'Show dialog
If GetSaveFileNameA(OFName) Then
SaveAsCommonDialog = Left$(OFName.lpstrFile, InStr(1, OFName.lpstrFile, Chr(0)) - 1)
Else
SaveAsCommonDialog = ""
End If
ExitFunction:
On Error GoTo 0
End Function
Function BrowseForFile(sInitDir As String, Optional ByVal sFileFilters As String, Optional sTitle As String = "Open File", Optional lParentHwnd As Long) As String
Dim tFileBrowse As OPENFILENAME
Const clMaxLen As Long = 254
tFileBrowse.lStructSize = Len(tFileBrowse)
'Replace friendly deliminators with nulls
sFileFilters = Replace(sFileFilters, "|", vbNullChar)
sFileFilters = Replace(sFileFilters, ";", vbNullChar)
If Right$(sFileFilters, 1) <> vbNullChar Then
'Add final delimiter
sFileFilters = sFileFilters & vbNullChar
End If
'Select a filter
tFileBrowse.lpstrFilter = sFileFilters & "All Files (*.*)" & vbNullChar & "*.*" & vbNullChar
'create a buffer for the file
tFileBrowse.lpstrFile = String(clMaxLen, " ")
'set the maximum length of a returned file
tFileBrowse.nMaxFile = clMaxLen + 1
'Create a buffer for the file title
tFileBrowse.lpstrFileTitle = Space$(clMaxLen)
'Set the maximum length of a returned file title
tFileBrowse.nMaxFileTitle = clMaxLen + 1
'Set the initial directory
tFileBrowse.lpstrInitialDir = sInitDir
'Set the parent handle
tFileBrowse.hwndOwner = lParentHwnd
'Set the title
tFileBrowse.lpstrTitle = sTitle
'No flags
tFileBrowse.flags = 0
'Show the dialog
If GetOpenFileName(tFileBrowse) Then
BrowseForFile = Trim$(tFileBrowse.lpstrFile)
If Right$(BrowseForFile, 1) = vbNullChar Then
'Remove trailing null
BrowseForFile = Left$(BrowseForFile, Len(BrowseForFile) - 1)
End If
End If
End Function
Private Sub BtnStart_Click() Frq 100: Dur 50
Timer1.Enabled = Not Timer1.Enabled 'Inverse l'état du timer On/Off
CalculTempo
If BtnStart.Caption "Start" Then BtnStart.Caption "Stop" Else BtnStart.Caption = "Start" 'Change le label du bouton
i2 = 0
End Sub
Private Sub Command1_Click()
Dim nFileNum As Integer, sText As String, sNextLine As String, lLineCount As Long
Dim sFilePath As String
sFilePath = BrowseForFile("c:\Samajam4", "Partition File (*.txt);*.txt", "Open Partition")
'(general declaration)
'==================================
' Get a free file number
nFileNum = FreeFile
' Open a text file for input. inputbox returns the path to read the file
Open sFilePath For Input As nFileNum
lLineCount = 1
' Read the contents of the file
Do While Not EOF(nFileNum)
Line Input #nFileNum, sNextLine
'do something with it
'add line numbers to it, in this case!
sNextLine = sNextLine & vbCrLf
sText = sText & sNextLine
Loop
Text2.Text = Trim(sText)
' Close the file
Close nFileNum
End Sub
Private Sub Command2_Click()
Dim sFilePath As String
'obtain the next free file handle from the
'system and and save the text box contents
hFile = FreeFile
Open sFilePath + ".txt" For Output As #hFile
Print #hFile, Text2.Text
Close #hFile
End Sub
Private Sub FlatScrollBar1_Change()
Text1 = FlatScrollBar1.Value
CalculTempo
End Sub
Private Sub Form_Load()
Frq = 100 'Valeurs arbitraires, par défaut
Dur = 50
counter = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
End 'Faut tjs caser un End qlq part...
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode 'Selectionne en fonction de la touche pressée
Case vbKeyReturn
If Val(Text1) > 39 And Val(Text1) < 501 Then 'Si compris dans la marge (Un tempo > 300 c'est pas bon, et < 40 non plus)
FlatScrollBar1.Value = Val(Text1)
CalculTempo
End If
Case vbKeyUp
If Val(Text1) < 500 Then Text1 = Val(Text1) + 1 'J'adore augmenter les variales en pressant Haut ou Bas dans un champ
FlatScrollBar1.Value = Val(Text1)
Case vbKeyDown
If Val(Text1) > 40 Then Text1 = Val(Text1) - 1
FlatScrollBar1.Value = Val(Text1)
End Select
End Sub
Function CalculTempo()
Tempo = (60 / Val(Text1)) * 1000 'Calcul le nb de millisecondes en fonction du tempo défini
Timer1.Interval = Tempo
End Function
Private Sub Timer1_Timer()
Dim i3 As Integer
If Check1.Value = vbChecked Then
Timer1.Interval = Tempo / 2 If Frq 100 Then Frq 500: Dur = 50 Else Frq = 100: Dur = 20 'Bip long, bip cours, bip long....
Else
Timer1.Interval = Tempo Frq 500: Dur 50
End If
