Créer un fichier binaire de type midi ou autres (*.*)

Télécharger le projet
Commenter

Description

Tout d'abord je tiens à remercier XENTOR pour son aide et ses conseils précieux !!!

Ce code permet de créer par défaut des fichiers binaire.mid mais également des fichiers de tout format à condition de connaitre les "header" correspondant !?!

Par la suite ce programmme sera un générateur de mélodies aléatoires dirigées ( c'est à dire compatible avec la tonalité choisie ) et sauvegardées dans des fichiers.mid

Actuellement le fichier midi créé par défaut joue la note "LA" = 51 !!!
00 90 51 3C 8F 00 80 51 00

Source / Exemple : 


Option Explicit

Dim fichier As String
Dim canal As Byte
Dim x() As String
Dim chaine As String

Private Sub Command1_Click()
'création du fichier midi ---------------------------
On Error Resume Next
'CMD est le nom que j'ai donné à une boite CommonDialog
CMD.Filter = "Fichier MIDI (*.mid)|*.mid|All (*.*)|*.*"
CMD.DialogTitle = "Enregistrer le fichier sous !?! - ( fichier.mid ou fichier.* )"
CMD.ShowSave
'initialisation à chaque sauvegarde
Kill fichier
'création du nouveau fichier
fichier = CMD.FileName
canal = FreeFile
Open fichier For Binary As canal
'écrit dans le fichier ouvert le texte binaire saisi
écrire (Text1.Text)
Close canal
End Sub

Function codeAt(lettre As String) As Integer
'cette fonction renvoie le code ascii d'un caractère
Dim alpha As String
Dim k As Integer
alpha = "0123456789ABCDEF"
For k = 1 To 10
If lettre = Mid(alpha, k, 1) Then
codeAt = (k - 1) + 48
End If
Next
For k = 11 To 16
If lettre = Mid(alpha, k, 1) Then
codeAt = (k - 11) + 65
End If
Next
End Function

Function codeHex(L As String) As Integer
'cette fonction renvoie la valeur en base dix d'une chaine hexadécimale
'exemple: codeHex("4D") = 77
Dim gauche As Integer
Dim droite As Integer
Dim h As Integer
gauche = codeAt(Mid(L, 1, 1))
droite = codeAt(Mid(L, 2, 1))
'test si le premier caractère est un chiffre ou une lettre
'pour lui donner sa valeur HEXA-DIXAINE en base 10
If gauche >= 48 And gauche <= 57 Then
gauche = (gauche - 48) * 16
End If
If gauche >= 65 And gauche <= 70 Then
gauche = (gauche - 55) * 16
End If
'test si le deuxième caractère est un chiffre ou une lettre
'pour lui donner sa valeur HEXA-UNITE en base 10
If droite >= 48 And droite <= 57 Then
droite = droite - 48
End If
If droite >= 65 And droite <= 70 Then
droite = droite - 55
End If
h = gauche + droite
codeHex = h
End Function

Function écrire(mot As String)
'cette fonction permet d'écrire des codes Hexadécimaux dans un fichier binaire
Dim car As String * 1
Dim i As Integer
Dim m As String
For i = 1 To Len(mot) Step 3
m = Mid(mot, i, 2)
car = Chr(codeHex(m))
Put canal, , car
Next
End Function

Private Sub Form_Load()
atlas.Left = 2000
atlas.Top = 2000
End Sub

Conclusion :


J'aimerais amélioré un peu l'esthétique de mon programme et notamment ne faire apparaitre la SCROLLBAR de la TextBox que lorsque le texte dépasse du cadre et la faire disparaitre dans le cas contraire !!!
Ou bien utiliser une TextBox (sans scrollbar) et une SCROLLBAR séparée qui apparaisse et disparaisse selon les cas et faire en sorte que les deux marchent ensemble !!!

Si quelqu'un peut m'expliquer comment faire ça !?!
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (cs_carolito)