Attribute VB_Name = "fonction_perso"
Public Function gotoxy(ligne%, colonne%, msc As MSComm)
msc.Output = Chr(27) + "=" & Chr(ligne) & Chr(colonne)
End Function
Public Sub Ouvrir_fichier(cd1 As CommonDialog, txt As TextBox)
'fonction d'ouverture de fichier texte
On Error GoTo oups
'ouverture du msdialogue
cd1.ShowOpen
Dim CheminFichier As String
Dim a As Long
'recuperation du chemin du fichier desirer
CheminFichier = cd1.FileName
a = FreeFile()
'ouverture du fichier texte dans a
Open CheminFichier For Input As #a
'recuperation de a dans txt.text
     txt.Text = Input(LOF(a), a)
'fermeture du fichier
Close #a
'gestion des erreur
oups:
If Err.Number = 62 Then
MsgBox Err.Number & "Il faut selectionner des fichier de type .txt"
End If

End Sub

Public Function Graph(pic As PictureBox, msg As TextBox, taille As Integer, bin1 As TextBox, bin2 As TextBox)
On Error GoTo oups
'effacement du graph precedent
pic.Cls
'*********************************************************************
'calcul de l'echelle                                                 *
'calcul de la longueur pour 1                                        *
lon = (pic.Width / (Len(msg.Text))) / taille '                       *
'calcul de la hauteur de 1                                           *
hau = pic.Height / 5 '                                               *
'*********************************************************************
'appel de la fonction créant les axes
Axe pic, msg, taille
'reglage de l'epaisseur des traits du graph
pic.DrawWidth = 2
Dim posx As Integer
Dim cpt As Integer
cpt = 0
Dim i As Integer
'boucle de parcours du message complet a envoyer
For i = 1 To Len(msg.Text) Step 1
    'recuperation du caractere courant
    cara = Asc(Mid(msg.Text, i, 1))
    'convertion du caractere en binaire
    Bin cara, bin1, bin2
    'verification de la parité
    Dim parit As Integer
    If bin2.Text = Int(bin2 / 2) * 2 Then
        parit = 0
    Else
        parit = 1
    End If
    
    'ajout bit du nombre de bit de stop
        
    'ajout du bit de start et des bits de parité et de stop
    bin1.Text = "0" & bin1.Text & parit & Form3.bstop.Text
    bin1.Refresh
    'boucle couleur
    If cpt = 13 Then
    cpt = 0
    Else
    cpt = cpt + 1
    End If
    'calcule de la position
    Dim psx As Integer
    psx = lon * taille * (i - 1)
    'boucle de parcours du nombre binaire
    For j = 0 To taille - 1 Step 1
        If Mid(bin1.Text, j + 1, 1) = 0 Then
        'pour le cas ou la valeur binaire vaut 1 donc +12V
                pic.Line (psx + lon * j, hau)-(psx + lon * j + lon, hau), QBColor(cpt) 'vbRed
        Else
        'pour le cas ou la valeur binaire vaut 0 donc -12V
                pic.Line (psx + lon * j, hau * 4)-(psx + lon * j + lon, hau * 4), QBColor(cpt) 'vbRed
        End If
        'mise en place des lignes certicals
        If Mid(bin1.Text, j + 1, 1) = 0 Then
            If Mid(bin1.Text, j + 2, 1) = 1 Then
                pic.Line (psx + lon * j + lon, hau)-(psx + lon * j + lon, hau * 4), QBColor(cpt) 'si av = 0 et ap = 1
            Else
                pic.Line (psx + lon * j + lon, hau)-(psx + lon * j + lon, hau), QBColor(cpt) 'si av = 0 et ap = 0
            End If
            Else
            If Mid(bin1.Text, j + 2, 1) = 1 Then
                pic.Line (psx + lon * j + lon, hau * 4)-(psx + lon * j + lon, hau * 4), QBColor(cpt) 'si av = 1 et ap = 1
            Else
                pic.Line (psx + lon * j + lon, hau * 4)-(psx + lon * j + lon, hau), QBColor(cpt) 'si av = 1 et ap = 0
            End If
        End If
    Next
Next
oups:
If Err.Number = 11 Then
MsgBox "Il faut saisir un caractere" & vbNewLine & "dans la zone de texte"

End If
End Function

Public Function Bin(chaine As Variant, txt As TextBox, txt2 As TextBox)
On Error GoTo oups
'algorithme de la convertion binaire
Dim bi As Integer
Dim res2 As Integer
bi = chaine
Dim res
While bi > 0
    dec = Int(bi - Int(bi / 2) * 2)
    bi = Int(bi / 2)
    res = dec & res
    res2 = res2 + dec
Wend
txt.Text = res
txt2.Text = res2
'invertion du code binaire
If Form4.Check2 = 1 Then
Inver txt
End If
'gestion des erreurs
oups:
If Err.Number = 11 Then
MsgBox "Il faut saisir un caractere" & vbNewLine & "dans la zone de texte"

End If
End Function

Public Function Axe(pic As PictureBox, msg As TextBox, taille As Integer)
pic.DrawWidth = 1
'*********************************************************************
'calcul de l'echelle                                                 *
'calcul de la longueur pour 1                                        *
lon = (pic.Width / (Len(msg.Text))) / taille '                       *
'calcul de la hauteur de 1                                           *
hau = pic.Height / 5 '                                               *
'*********************************************************************
'affichage des axe
For l = 1 To Len(msg) + 1
pic.Line (lon * taille * l, 0)-(lon * taille * l, pic.Height), vbBlack
Next
pic.Line (0, pic.Height / 2)-(pic.Width, pic.Height / 2)

End Function

Public Function Inver(txt As TextBox)
'invertion du code binaire
Dim temp As String
Dim res As String
temp = txt.Text
i = Len(temp)
While i >= 1
res = res & Mid(temp, i, 1)
i = i - 1
Wend
txt.Text = res
End Function

Public Function SaveSous(txt As TextBox)
    Dim titre As String
    titre = InputBox("Nom du fichier a sauvegarder :", "Liaison serie", "sanstitre")
    If titre <> vbNullString Then
        Dim vari As Integer
        vari = FreeFile
        contenu = txt.Text
        Open App.Path & "\" & titre & ".txt" For Output As #vari
        Print #vari, contenu
        Close vari
    End If
End Function
