Pc <-> rs232 <-> ampex

Soyez le premier à donner votre avis sur cette source.

Vue 12 037 fois - Téléchargée 1 611 fois

Télécharger le projet
Commenter

Description

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
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Signaler
agauthiers
Messages postés
33
Date d'inscription
mardi 28 décembre 2004
Statut
Membre
Dernière intervention
15 février 2005
 -
ok NeoCortex,
Je te remercie, je t'enverrai donc un Email pour plus d'info.

@+tard

agauthiers
Signaler
cs_NeoCortex
Messages postés
48
Date d'inscription
dimanche 17 juin 2001
Statut
Membre
Dernière intervention
11 décembre 2008
 -
Salut Agauthiers,

Il n'y a pas de probleme, pour les renseignement, si tu as une question ou autre mail moi.

Et Bonne fete a tous aussi.

NeoCortex
Signaler
agauthiers
Messages postés
33
Date d'inscription
mardi 28 décembre 2004
Statut
Membre
Dernière intervention
15 février 2005
 -
Salut NeoCortex,

Je viens de découvrir ton "émulation" de console Ampex
Même si je ne comprends pas tout, ta source me sera bien utile pour développer un projet similaire : un émulateur de console pour driver un automate industriel par rs232.
As-tu d'autres sources de la même veine ?
As-tu fait un dossier donnant plus de détails ?
Es-tu disponible pour répondre à quelques questions ?
Bon travail
Bonnes fêtes de fin d'année.
@++

agauthiers@ifrance.com
Signaler
Noiretulipe
Messages postés
165
Date d'inscription
mardi 21 janvier 2003
Statut
Membre
Dernière intervention
13 juillet 2008
 -
Benh mon gars tu as du bien te prendre la tête ... Mais, bon boulot au final !
Signaler
laffreuxjojo
Messages postés
6
Date d'inscription
mardi 25 février 2003
Statut
Membre
Dernière intervention
6 mai 2003
 -
dé nada ;;;;;mister Cortex
best regards ,
laffreux
Afficher les 8 commentaires
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_NeoCortex)