Ce programme montre comment dialogué avec une console AMPEX via le port serie DB9 de votre PC.
Le programme permet de visualiser les bits envoyés et recus.
Il y a aussi un debut d'editeur graphique pour AMPEX
Toute la connexion est geré par MSCOMM32.
Ci dessous le module ou sont rangé la plupart des fonction utilisées dans le prog.
Source / Exemple :
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
Conclusion :
J'espere que ce code pourra aider quelque personne.
Donner vos remarques et commentaires.
Bonne Prog
NeoCortex
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.