Soyez le premier à donner votre avis sur cette source.
Vue 12 133 fois - Téléchargée 1 629 fois
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
Je te remercie, je t'enverrai donc un Email pour plus d'info.
@+tard
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
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
best regards ,
laffreux
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.