4/5 (6 avis)
Vue 7 899 fois - Téléchargée 528 fois
Imports System.Windows.Forms Imports System.Windows.Forms.Application Imports System.IO Imports System Imports System.Windows Imports System.Text.RegularExpressions Public Class Form1 Private Structure Parametre Dim Deb As Integer 'début Dim Iter As Integer 'Nombre d'itérations Dim Pas As Integer 'pas de chaque itér. Dim Nom As String 'nom de la variable ( a par exemple) à remplacer par une valeur ds code généré Public Sub New(ByVal nom As String, ByVal deb As Integer, ByVal iter As Integer, ByVal pas As Integer) Me.Nom = nom Me.Deb = deb Me.Iter = iter Me.Pas = pas End Sub End Structure 'structure d'un paramètre contenu ds une des chaines du Modèle 'variables globales : Dim LM As New List(Of String) 'liste des chaines du Modèle Dim LC As New List(Of String) 'liste des chaines du Code Dim LP As New List(Of Parametre) 'liste des paramètres à gérer 'événements : Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load ActualiseLBModele() 'actualise les listbox Modele ActualiseLBCode() ' Code ActualiseLBParametres() ' Paramètres End Sub Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint e.Graphics.DrawString("Modèle :", Me.Font, Brushes.Black, _ ListBoxModele.Location.X + 18, ListBoxModele.Location.Y - 15) e.Graphics.DrawString("Code Généré :", Me.Font, Brushes.Black, _ ListBoxCode.Location.X + 18, ListBoxCode.Location.Y - 15) e.Graphics.DrawString("Variables : nom début itérations pas", Me.Font, Brushes.Black, _ ListBoxParametres.Location.X + 18, ListBoxParametres.Location.Y - 15) End Sub Private Sub ButtonModeleAjout_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonModeleAjout.Click 'ajout d'une ligne ds Modèle (en dernière position) Dim res As String res = Microsoft.VisualBasic.InputBox("Saisissez la ligne " & CStr(LM.Count + 1), "Entrée de la ligne suivante dans le modèle ") If res <> "" Then LM.Add(res) 'ligne ajoutée ActualiseLBModele() AjouteLigneParametres(res) 'ajouter les (nouveaux) paramètres contenus dans cette ligne ActualiseLBParametres() 'mise à jour de la listbox Paramètres Me.Refresh() 'refaire le dessin DoEvents() End If End Sub 'ajouter une ligne ds modèle Private Sub ButtonModeleRetrait_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonModeleRetrait.Click 'retirer la dernière ligne ds modèle If LM.Count <> 0 Then SupprimeLigneParametres(LM(LM.Count - 1)) 'supprimer les paramètres de la dernière ligne si aucune autre ligne ne les contient... ActualiseLBParametres() 'mise à jour de la listbox Paramètres LM.RemoveAt(LM.Count - 1) 'enlève la dernière ligne ActualiseLBModele() ButtonModeleRetrait.Text = "Modèle : retrancher ligne " & IIf(LM.Count <> 0, CStr(LM.Count), "") 'vider la listbox Code Généré pour rappeler la suppression d'une ligne ds le modèle LC.Clear() 'vider la liste ActualiseLBCode() ' actualiser la listebox Code généré ListBoxModele.SelectedIndex = LM.Count - 1 'rendre visible la dernière ligne Me.Refresh() 'refaire le dessin DoEvents() End If End Sub 'retirer la dernière ligne ds modèle Private Sub ButtonSauver_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonSauverFichier.Click 'sauver le code généré en fichier Dim savename As String = "" Dim dr As DialogResult Dim MyLines(LC.Count) As String Dim i As Integer dr = SaveFileDialog1.ShowDialog() If dr = DialogResult.OK Then 'sauvegarde confirmée savename = SaveFileDialog1.FileName 'recopier la liste des lignes de code en tableau For i = 0 To LC.Count - 1 MyLines(i) = LC(i) Next File.WriteAllLines(savename, MyLines) MessageBox.Show("Le fichier " & savename & " a été sauvegardé.") DoEvents() End If End Sub 'sauver le code généré en fichier Private Sub ListBoxParametres_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles ListBoxParametres.DoubleClick 'double-click sur un paramètre => modifier ses valeurs Dim ind, iter As Integer 'indice du paramètre choisi Dim res As String 'réponse de l'inputbox Dim param As Parametre 'paramètre à modifier Dim rg As New Regex("[0-9]") 'vérifier la chaine entrée ds inputbox ind = ListBoxParametres.SelectedIndex If ind <> -1 Then 'paramètre sélectionné param = LP(ind) 'les paramètres ds LP sont ds le mm ordre que ds ListBoxParametres 'choix du début Do res = InputBox("Valeur de début :", "Choisissez les valeurs du paramètre " & param.Nom, CStr(param.Deb)) Loop While res <> "" And Not rg.IsMatch(res) 'tant que Annuler ou réponse correcte (nombre entier) If res <> "" Then param.Deb = Val(res) 'choix du nombre d'itérations Do res = InputBox("Nombre d'itérations :", "Choisissez les valeurs du paramètre " & param.Nom, CStr(param.Iter)) Loop While res <> "" And Not rg.IsMatch(res) If res <> "" Then iter = IIf(Val(res) <> param.Iter, Val(res), 0) 'iter<>0 si le nbre d'itérations a été changé param.Iter = Val(res) End If 'choix du pas Do res = InputBox("Valeur du pas :", "Choisissez les valeurs du paramètre " & param.Nom, CStr(param.Pas)) Loop While res <> "" And Not rg.IsMatch(res) If res <> "" Then param.Pas = Val(res) 'change les valeurs du paramètre ds la liste LP LP.RemoveAt(ind) 'enlève l'ancien param. LP.Insert(ind, param) 'insère le nouveau If iter <> 0 Then 'modifier toutes les valeurs d'itération ds LP For ind = 0 To LP.Count - 1 param = LP(ind) param.Iter = iter LP.RemoveAt(ind) 'enlève l'ancien param. LP.Insert(ind, param) 'insère le nouveau Next End If ActualiseLBParametres() End If End Sub 'modifier les valeurs d'une variable Private Sub ButtonExplications_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonExplications.Click MessageBox.Show("Ce programme génère du code en partant du modèle qu'il reproduit un certain nombre de fois " & _ "(Itérations)." & vbCrLf & _ vbCrLf & "Le modèle est formé de lignes qui comportent des variables à modifier." & vbCrLf & _ "Le pas est la valeur (positive ou négative) ajoutée à chaque fois." & _ vbCrLf & vbCrLf & "Chaque variable est désignée par le symbole % : " & _ vbCrLf & vbTab & "Box%a donnera le mot Box suivi de la valeur de a" & _ vbCrLf & vbCrLf & "Les noms des variables peuvent être formés d'une lettre ou d'un chiffre." & _ vbCrLf & "Le symbole % peut cependant être utilisé suivi d'un espace : " & _ vbCrLf & vbTab & "E% perso donnera E%perso à la génération" & _ vbCrLf & vbCrLf & "Les valeurs d'une variable peuvent être modifiées par double-clic dans la liste des variables." & _ vbCrLf & vbCrLf & "Une ligne du modèle peut être modifiée par double-clic sur elle-même ou avec le bouton Editer." & _ vbCrLf & vbCrLf & "Le modèle peut être lu à partir du presse-papier (en format TXT comportant une ou plusieurs lignes)." & _ vbCrLf & vbCrLf & "Le code généré peut être copié dans le presse-papier (clipboard) ou sauvegardé en fichier.") End Sub 'donner qq explications Private Sub ButtonGeneration_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonGeneration.Click 'générer le code...et montrer le résultat Dim i As Integer If LP.Count <> 0 Then 'des parametres existent LC.Clear() 'vider la liste For i = 0 To LP(0).Iter - 1 'nbre d'itérations AjouteIteration(i) 'ajoute dans LC la ième itération du modèle Next Else LC.Clear() AjouteIteration(0) 'itère une fois, pour dire... End If ActualiseLBCode() Me.Refresh() 'refaire le dessin DoEvents() End Sub 'générer le code...et montrer le résultat Private Sub ButtonCopierPP_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonCopierPP.Click 'copier le code généré ds le clipboard Dim i As Integer Dim s As String = "" For i = 0 To LC.Count - 1 s &= LC(i) & vbCrLf Next My.Computer.Clipboard.SetText(IIf(s <> "", s, " "), TextDataFormat.Text) MessageBox.Show("Le code généré a été copié dans le presse-papier.") DoEvents() End Sub 'copier le code généré ds le clipboard Private Sub ButtonLireModelePP_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonLireModelePP.Click Dim i As Integer Dim s As String Dim lignes() As String Dim separateur As Char = vbCrLf If My.Computer.Clipboard.ContainsText(TextDataFormat.Text) Then 'texte ds clipboard 'récupérer le texte s = My.Computer.Clipboard.GetText(TextDataFormat.Text) 'et le décomposer en lignes lignes = s.Split(separateur) 'décompose en lignes If lignes.Length <> 0 Then 'lignes trouvées LM.Clear() 'vider le modèle LP.Clear() 'et les variables For i = 0 To lignes.Length - 1 lignes(i) = IIf(lignes(i).Substring(0, 1) <> vbLf, lignes(i), _ lignes(i).Substring(1, lignes(i).Length - 1)) 'enlever Lf (0x0A) en début de ligne If lignes(i) <> "" Then 'la dernière ligne du clipboard peut être vide LM.Add(lignes(i)) 'ligne ajoutée AjouteLigneParametres(lignes(i)) 'ajouter les (nouveaux) paramètres contenus cette ligne End If Next 'actualise les différentes listbox ActualiseLBModele() 'listbox du Modele ActualiseLBParametres() 'mise à jour de la listbox Paramètres LC.Clear() 'vider la liste ActualiseLBCode() ' actualiser la listebox Code généré Me.Refresh() 'refaire le dessin DoEvents() End If Else 'pas de texte ds le presse-papier MessageBox.Show("Il n'y a pas de texte dans le presse-papier...on essaye de m'embrouiller ? ;-)") End If End Sub Private Sub ListBoxModele_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles ListBoxModele.DoubleClick 'éditer une ligne du modèle Dim ind As Integer 'indice de la ligne choisie Dim ligne As String Dim old_ligne As String ind = ListBoxModele.SelectedIndex If ind <> -1 Then 'ligne sélectionnée 'les lignes ds ListBoxModele sont dans l'ordre de la liste LM old_ligne = LM(ind) ligne = InputBox("Modifiez la ligne " & CStr(ind + 1), "Modification d'une ligne du modèle ", LM(ind)) If ligne <> "" And ligne <> old_ligne Then 'à modifier LM.RemoveAt(ind) 'enlève l'ancienne ligne LM.Insert(ind, ligne) 'met la nouvelle à la mm place SupprimeLigneParametres(old_ligne) 'virer les paramètres de l'ancienne ligne AjouteLigneParametres(ligne) 'ajouter les (nouveaux) paramètres contenus dans cette ligne ActualiseLBParametres() 'mise à jour de la listbox Paramètres ActualiseLBModele() ListBoxModele.SelectedIndex = ind 'rendre visible la ligne éditée Me.Refresh() 'refaire le dessin DoEvents() End If End If End Sub 'éditer une ligne du modèle par double-clic Private Sub ButtonEditerLigne_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonEditerLigne.Click 'éditer une ligne du modèle par le bouton Dim res As String 'réponse de l'inputbox Dim rg As New Regex("[0-9]") 'vérifier la chaine entrée ds inputbox Dim ind As Integer 'indice de la ligne choisie Dim ligne As String Dim old_ligne As String 'choix du début Do res = InputBox("Entrez le numéro de la ligne à éditer : ", "Choisissez la ligne à éditer ") Loop While res <> "" And Not rg.IsMatch(res) 'jusqu'à ce que Annuler ou réponse correcte (nombre entier) If res <> "" Then 'édition confirmée ind = IIf(Val(res) > 0 And Val(res) < LM.Count + 1, Val(res) - 1, 0) old_ligne = LM(ind) ligne = InputBox("Modifiez la ligne " & CStr(ind + 1), "Modification d'une ligne du modèle ", LM(ind)) If ligne <> "" And ligne <> old_ligne Then 'à modifier LM.RemoveAt(ind) 'enlève l'ancienne ligne LM.Insert(ind, ligne) 'met la nouvelle à la mm place SupprimeLigneParametres(old_ligne) 'virer les paramètres de l'ancienne ligne AjouteLigneParametres(ligne) 'ajouter les (nouveaux) paramètres contenus dans cette ligne ActualiseLBParametres() 'mise à jour de la listbox Paramètres ActualiseLBModele() ListBoxModele.SelectedIndex = ind 'rendre visible la ligne éditée Me.Refresh() 'refaire le dessin DoEvents() End If End If End Sub 'éditer une ligne du modèle par le bouton 'routines : Private Sub ActualiseLBModele() 'met à jour la listbox Modele et le bouton ModeleRetrait Ligne ... Dim i As Integer ListBoxModele.Items.Clear() For i = 0 To LM.Count - 1 ListBoxModele.Items.Add(LM(i)) Next ButtonModeleRetrait.Text = "Modèle : retrancher ligne " & CStr(LM.Count) End Sub 'met à jour la listbox Modele Private Sub ActualiseLBCode() 'met à jour la listbox Code Dim i As Integer ListBoxCode.Items.Clear() For i = 0 To LC.Count - 1 ListBoxCode.Items.Add(LC(i)) Next End Sub 'met à jour la listbox Code Private Sub ActualiseLBParametres() 'met à jour la listbox Paramètres Dim i As Integer Dim p As Parametre ListBoxParametres.Items.Clear() For i = 0 To LP.Count - 1 p = LP(i) ListBoxParametres.Items.Add(vbTab & vbTab & p.Nom & " , " & vbTab & (p.Deb) & " , " _ & vbTab & CStr(p.Iter) & " , " & vbTab & CStr(p.Pas)) Next End Sub 'met à jour la listbox Paramètres Private Sub AjouteLigneParametres(ByVal s As String) 'cherche de nouveaux paramètres ds cette ligne : caractère % suivi d'une lettre 'et ajoute ces paramètres à la liste LP Dim p As New Parametre("", 1, 1, 1) ' = (nom,début,iteration,pas) Dim i, ind As Integer Dim separateur As Char = "%" Dim morceaux() As String 'morceaux de ligne séparés par % If LP.Count <> 0 Then p.Iter = LP(0).Iter 'nombre d'itérations déjà fixé ou modifié morceaux = s.Split(separateur) 'décompose la ligne en morceaux 'écarter les lignes vides... If morceaux.Length <> 0 And s <> "" Then 'plusieurs morceaux For i = IIf(s.Substring(0, 1) = "%", 0, 1) To morceaux.Length - 1 'analyser chaque paramètre possible 'en partant du 2ième morceau si la ligne ne commence pas par % If morceaux(i).Length > 0 Then If MorceauContientParametre(morceaux(i), p) Then 'paramètre trouvé -> p If Not LPContientParametre(p.Nom, ind) Then LP.Add(p) 'si nouveau End If End If 'si le morceau n'est pas réduit à "%" Next 'morceau suivant ( next i) End If 'si morceaux ( % est ds la ligne ) End Sub 'ajoute les (nouveaux)paramètres de la ligne à la liste LP Private Function MorceauContientParametre(ByVal m As String, ByRef p As Parametre) As Boolean 'analyse le morceau et modifie p.nom , retourne true si paramètre trouvé 'cette routine sert aussi pour retirer un paramètre de la liste si la ligne est supprimée Dim nom As String Dim res As Boolean = False nom = m.Substring(0, 1) '1er caractère en partant de la gauche If nom <> " " Then p.Nom = nom 'exemple : nom = "a" si "%a" ds la ligne res = True '1 paramètre trouvé End If 'si le nom est défini (morceau <> "% ") Return res End Function 'analyse le morceau et modifie p.nom , retourne true si paramètre trouvé Private Function LPContientParametre(ByVal nom As String, ByRef ind As Integer) As Boolean 'cherche si le paramètre de nom "param.Nom" est ds LP (sans tenir compte de ses valeurs) 'mémorise l'indice ds ind si demandé Dim i As Integer Dim res As Boolean = False For i = 0 To LP.Count - 1 If LP(i).Nom = nom Then res = True ind = i 'indice du parametre ds LP End If Next Return res End Function 'teste si LP contient ce paramètre Private Sub SupprimeLigneParametres(ByVal s As String) 'enlève les paramètres de cette ligne si aucune autre ligne ne les contient Dim p As New Parametre("", 1, 1, 1) ' = (nom,début,iteration,pas) Dim i, lig, ind As Integer Dim separateur As Char = "%" Dim morceaux() As String 'morceaux de ligne séparés par % Dim sup As Boolean morceaux = s.Split(separateur) 'décompose la ligne en morceaux If LM.Count <> 0 Then If morceaux.Length <> 0 And s <> "" Then 'plusieurs morceaux For i = IIf(s.Substring(0, 1) = "%", 0, 1) To morceaux.Length - 1 'analyser chaque paramètre possible 'en partant du 2ième morceau si la ligne ne commence pas par % If morceaux(i).Length > 0 Then If MorceauContientParametre(morceaux(i), p) Then 'paramètre trouvé -> p.Nom sup = True 'supprimer ce parametre à priori If LM.Count > 1 Then 'sinon, une seule ligne ds modèle, sup=True For lig = 0 To LM.Count - 2 'pour chaque ligne du modèle sauf la dernière ligne If LM(lig).Contains("%" & p.Nom) Then sup = False 'car paramètre ds autre ligne Next End If 'si plus d'une ligne ds modele If sup Then LPContientParametre(p.Nom, ind) 'bonne question ! (le parm. à supprimer peut être ds plusieurs morceaux) ' c'est aussi pour avoir l'indice i If LPContientParametre(p.Nom, ind) Then LP.RemoveAt(ind) 'vire le param de la liste End If End If 'si le morceau contient un parametre End If 'si le morceau n'est pas réduit à "%" Next 'morceau suivant ( next i) End If 'si morceaux ( % est ds la ligne ) End If ' si LM.Count<>0 End Sub 'enlève les paramètres de la ligne à la liste LP ci-nécessaire Private Sub AjouteIteration(ByVal iter As Integer) 'ajoute dans LC la ième itération du modèle Dim i, m, ind As Integer Dim p As New Parametre("", 1, 1, 1) ' = (nom,début,iteration,pas) Dim separateur As Char = "%" Dim morceaux() As String 'morceaux de ligne séparés par % Dim ligne_code As String 'ligne de code générée If iter <> 0 Then LC.Add(" ") For i = 0 To LM.Count - 1 'pour chaque ligne du modèle ligne_code = "" morceaux = LM(i).Split(separateur) 'décompose la ligne en morceaux If morceaux.Length <> 0 And LM(i) <> "" Then 'plusieurs morceaux : paramètres ? If LM(i).Substring(0, 1) <> "%" Then ligne_code = morceaux(0) 'premier morceau sans code For m = IIf(LM(i).Substring(0, 1) = "%", 0, 1) To morceaux.Length - 1 'analyser chaque paramètre possible 'en partant du 2ième morceau si la ligne ne commence pas par % If morceaux(m).Length > 0 Then If MorceauContientParametre(morceaux(m), p) Then 'paramètre trouvé -> p LPContientParametre(p.Nom, ind) 'permet d'avoir l'indice du paramètre p = LP(ind) 'permet d'avoir les valeurs du paramètre ligne_code &= CStr(p.Deb + iter * p.Pas) 'valeur du paramètre ligne_code &= morceaux(m).Substring(1, morceaux(m).Length - 1) 'reste du morceau Else 'le caractère % est suivi d'un espace : enlever l'espace ligne_code &= "%" End If Else 'le caractère % n'est pas suivi d'un autre caractère (ex : %%) : le recopier ligne_code &= "%" End If 'si le morceau n'est pas réduit à "%" Next 'morceau suivant ( next i) Else 'reproduire la ligne telle quelle (pas de variable) ligne_code = LM(i) End If 'si morceaux ( % est ds la ligne ) LC.Add(ligne_code) Next 'ligne i suivante ds modele End Sub 'ajoute dans LC la ième itération du modèle End Class
13 mai 2010 à 22:45
13 mai 2010 à 11:16
13 mai 2010 à 01:14
la programmatiuon est lart des faigant, l'intelligence aussi est l'arme fatale des faignants contre le temps, ceci dit ; les faignant sont les geans les plus inteligeant dans la vie, ce qui implique que la technologie numérique actuelle est le resultat directe des faignants inteligeants, ce qui ront tres connexe l'inteligence et le mainéantise.
Un vrai cadeau pour les faignants, et merci
8 mai 2010 à 14:06
Epiloguer sur cela est complètement stérile.
8 mai 2010 à 11:09
Exemple : GeoplanW (logiciel de dessin dans le plan, excellent par ailleurs) où on peut être amené à incrémenter un objet (=plusieurs lignes de code) 20 ou 30 fois !!
Ce genre de programme m'aurait évité de grosses pertes de temps, et puis il y a plus intéressant à faire ...
Je suis curieux d'avoir l'avis de ceux qui en ont l'usage.
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.