Palindrome en vb5

Résolu
quentin1811 -  
Bonjour,
Je dois présenter à mon prof d'info un programme en vb5 sur les palindromes.
Je n'arrive pas à trouver de solution a ce problème.
N'étant pas un expert en la matière, .... aidez moi :p
Le but de ce programme est de marquer une phrase avec des accents et des espaces .
ex : Noël a trop par rapport à Léon ou encore Élu par cette crapule ....
Et ensuite me dire si c est un palindrome ou non.

Merci d'avance.

Ps: pouvez vous mettre les explication en même merci.

voici ce que j ai commencé :

Private Sub Command1_Click()
Dim I As Integer
Dim Texte As String

Textmaj = UCase(Text1.Text)

For I = Len(Textmaj) To 1 Step -1
Texte = Texte & Mid(Textmaj, I, 1)
Next

If Texte = " " Then
Texte = Mid(Textmaj, I + 1, 1)
End If

If Textmaj = "" Then
MsgBox "Entrer un mot ou phrase ! ", vbOKOnly, "Attention"
End If
If Textmaj = Texte Then
Label2.Caption = " est un palindrome"
Else
Label2.Caption = " n'est pas un palindrome"
End If
End Sub

Private Sub Command2_Click()
For Each XFrm In Forms
Unload XFrm
Next XFrm
End Sub

il y a 2 bouttons ( un pour enter et un pour quitter programme) , 2 labels et un textbox

8 réponses

  1.  lermite222 Contributeur
    Je ne vois pas bien comment je pourrais expliquer mieux, enfin bon, je vais essayer.
    Chaque lettre a un code, par exemple A à le code 65 quelque soit l'affichage de la police l'aspect sera différent mais ce sera toujours un A.
    En partant de ce principe, le code ASCII de A étant 65 quelque soit sont affichage il serra toujours déterminer par le code 65 et 65+32 pour la lettre majuscule soit "a"
    Il découle que les lettres À;Á;Â;Ã;Ä;Å; ont respectivement les codes ASCII 192, 193,194 etc..
    En détectant ces codes il devient évident que leur remplacement par la lettre A (code 65) ne pose plus de difficulté d'ou le test 
        Case 192 To 196: Lettre = "A"

    Si le code détecter est compris entre 192 et 196 c'est que c'est un A avec un accent quelconque le remplacer par le code 65 soit "A" devient évident.
    Si quelqu'un peu mieux cerner la question je lui demanderait d'intervenir.
    A+
    1. quentin1811 Auteur
      bonsoir,

      J' ai consulté le lien que tu avais marqué sur les codes ASCII.
      Mais cela ne m'a pas trop "éclairci la tête".
      Pourrais tu me l'expliquer à l'aider d'un des cases de mon programme.

      Case 192 To 196: Lettre = "A"
      Case 224 To 229: Lettre = "a"
      Case 199: Lettre = "C"
      Case 231: Lettre = "c"
      Case 200 To 203: Lettre = "E"
      Case 232 To 235: Lettre = "e"
      Case 204 To 207: Lettre = "I"
      Case 236 To 239: Lettre = "i"
      Case 209: Lettre = "N"
      Case 241: Lettre = "n"
      Case 210 To 214: Lettre = "O"
      Case 242 To 246: Lettre = "o"
      Case 217 To 220: Lettre = "U"
      Case 249 To 252: Lettre = "u"
      Case 221 To 255: Lettre = "Y"

      Merci et joyeuses fêtes
      2. quentin1811 Auteur
        Ca marche youppiie un grand merci.
        J'aurais une denière petite question :
        je ne comprends pas trop les chiffres avec la fonction pour enlever les caractères
        2. lermite222 Contributeur
          Re,
          Avec le code ci-dessous (et le premier aussi) pas besoin d'enlever les accents pour vérifier si c'est un palindrome, que ce soit un mot ou une phrase. 
          Private Sub Command1_Click()
Dim i As Integer
Dim Txt As String
Dim TxtR As String
    If Text1 = "" Then
        MsgBox "vous devez entrer une mot ou une phrase dans la saisie."
        Text1.SetFocus
        Exit Sub
    End If
    'Enlève les espaces pour avoir tout en un seul mot
    Txt = Trim(Text1.Text)
    For i = 1 To Len(Txt)
        If Mid(Txt, i, 1) = " " Then
            Txt = Left(Txt, i - 1) & Mid(Txt, i + 1)
        End If
    Next i
    'retourner le mot
    For i = Len(Txt) To 1 Step -1
        TxtR = TxtR & Mid(Txt, i, 1)
    Next

    'Détection du palindrome
    For i = 1 To Len(Txt)
        If Mid(Txt, i, 1) <> Mid(TxtR, Len(Txt) - i + 1, 1) Then Exit For
    Next i


    If i > Len(Txt) Then
        Label2.Caption = "C'est un palindrome"
    Else
        Label2.Caption = "Ce n'est pas un palindrome"
    End If
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub

          A+
          1. quentin1811 Auteur
            J' ai essayé :

            Private Sub Command1_Click()
            Dim txt As String
            Dim i As Integer

            If Text1.Text = "" Then
            MsgBox "Entrer un mot ou phrase ! ", vbOKOnly, "Attention"
            End If

            txt = Text1.Text
            For i = 1 To Len(txt)
            If Mid(txt, i, 1) = " " Then
            txt = Left(txt, i - 1) & Right(txt, Len(txt) - i)
            End If
            Next i

            txt = UCase(txt)

            If txt = JeRenverseMonString(txt) Then
            Label2.Caption = " est un palindrome"
            Else
            Label2.Caption = " n'est pas un palindrome"
            End If
            End Sub

            Function JeRenverseMonString(Byval StrTxt As String) As String
            For i = Len(StrTxt) To 1 Step -1
            JeRenverseMonString = JeRenverseMonString & Mid(StrTxt, i, 1)
            Next
            end Function

            Et lorsque je tape ma phrase, il m'affiche que ce n' est pas un palindrome alors qque oui .

            La phrase était : La mère Gide digère mal
            1. pijaku Modérateur
              Bah oui, je n'ai pas traité les accents..... Tu veux que je te fasses tout?
              Bon ok, c'est pas noël tous les jours. T'as intérêt à dire merci!! et à revenir ici pour expliquer chaque ligne afin de voir si tu as bien compris. Manquerais plus que ta prof me mette 2 heures de colle pour t'avoir filer le bouzin...

              Et donc avec la "petite" fonction supplémentaire : 

              Private Sub Command1_Click() 
Dim txt As String 
Dim i As Integer 

If Text1.Text = "" Then 
    MsgBox "Entrer un mot ou phrase ! ", vbOKOnly, "Attention" 
    Exit Sub
End If 

txt = Text1.Text

For i = 1 To Len(txt) 
    If Mid(txt, i, 1) = " " Then 
        txt = Left(txt, i - 1) & Right(txt, Len(txt) - i) 
    End If 
Next i 

txt = OteAccents(txt)

txt = UCase(txt)

If txt = JeRenverseMonString(txt) Then 
    Label2.Caption = " est un palindrome" 
Else 
    Label2.Caption = " n'est pas un palindrome" 
End If 
End Sub 

Function JeRenverseMonString(ByVal StrTxt As String) As String
Dim i As Integer

For i = Len(StrTxt) To 1 Step -1 
    JeRenverseMonString = JeRenverseMonString & Mid(StrTxt, i, 1) 
Next 
end Function

Function OteAccents(ByVal Mot As String) As String
Dim i As Integer, j As Integer
Dim Accents() As String, PasAccents() As String
    
Accents = Split("À;Á;Â;Ã;Ä;Å;à;á;â;ã;ä;å;Ç;ç;È;É;Ê;Ë;è;é;ê;ë;Ì;Í;Î;Ï;ì;í;î;ï;Ñ;ñ;Ò;Ó;Ô;Õ;Ö;ò;ó;ô;õ;ö;Ù;Ú;Û;Ü;ù;ú;û;ü;Ý;ý;ÿ;ß", ";")
PasAccents = Split("A;A;A;A;A;A;a;a;a;a;a;a;C;c;E;E;E;E;e;e;e;e;I;I;I;I;i;i;i;i;N;n;O;O;O;O;o;o;o;o;o;o;U;U;U;U;u;u;u;u;Y;y;y;ss", ";")
For i = 1 To Len(Mot)
    For j = 0 To UBound(Accents)
        If Mid(Mot, i, 1) = Accents(j) Then
            Mot = Left(Mot, i - 1) & PasAccents(j) & Right(Mot, Len(Mot) - i)
            Exit For
        End If
    Next j
Next i
OteAccents = Mot
End Function


              Remarque : on aurait pu alléger le code de la fonction en transformant d'abord txt en majuscule ce qui aurait permis de diminuer Accents et PasAccents de toutes les lettres minuscules...
              Mais bon cette fonction existe pour tout et peux resservir telle qu'elle dans un autre contexte...
            2. quentin1811 Auteur
              Salut. Un grand merci pour avoir fait la fonction mais il y a encore un petit souci.
              Il ne connait pas la fonction split
            3. lermite222 Contributeur
              Je me suis tromper, il faut effectivement ôter les accents. Et puisque Split ne fonctionne pas avec VB5 (dommage) remplace par... 

              Function OteAccents(ByVal Mot As String) As String
Dim i As Integer
Dim Lettre As String
    For i = 1 To Len(Mot)
        If Asc(Mid(Mot, i, 1)) > 122 Then
            Select Case Asc(Mid(Mot, i, 1))
            Case 192 To 196: Lettre = "A"
            Case 224 To 229: Lettre = "a"
            Case 199: Lettre = "C"
            Case 231: Lettre = "c"
            Case 200 To 203: Lettre = "E"
            Case 232 To 235: Lettre = "e"
            Case 204 To 207: Lettre = "I"
            Case 236 To 239: Lettre = "i"
            Case 209: Lettre = "N"
            Case 241: Lettre = "n"
            Case 210 To 214: Lettre = "O"
            Case 242 To 246: Lettre = "o"
            Case 217 To 220: Lettre = "U"
            Case 249 To 252: Lettre = "u"
            Case 221 To 255: Lettre = "Y"
            Case Else: Lettre = Mid(Mot, i, 1)
            End Select
            Mid(Mot, i, 1) = Lettre
        End If
    Next i
    OteAccents = Mot
End Function
            4.  pijaku Modérateur
              Salut Lermitte222, quentin1811,
              Bonne idée de passer par les caractères ascii. De loin la meilleure.
              A+
          2. quentin1811 Auteur
            Merci.
            En fait, on note une phrase et le programme va la transformer par
            suppression des espaces et de tous accents présents.
            1. quentin1811 Auteur
              il ne connait pas la fonction Replace
            2. pijaku Modérateur
              Bonjour,
              Au clic sur le bouton "Entrer" :
              1- On teste si le textbox est vide : 
              If Text1.Text = "" Then 
    MsgBox "Entrer un mot ou phrase ! ", vbOKOnly, "Attention" 
End If

              2- On enlève les espaces inutiles
              Si Replace n'est pas une fonction valide, il faut boucler sur tous les caractères et supprimer les espaces : 
              Dim txt As String
Dim i As Integer
txt = Text1.Text 
For i = 1 To Len(txt)
    If Mid(txt, i, 1) = " " Then
        txt = Left(txt, i - 1) & Right(txt, Len(txt) - i)
    End If
Next

              3- On passe en majuscule la chaine : 
              txt = UCase(txt)

              4- On teste s'il s'agit d'un palindrome :
              - peut être la fonction StrReverse existe et alors : 
              If txt = StrReverse(txt) Then
   Label2.Caption = " est un palindrome" 
Else 
    Label2.Caption = " n'est pas un palindrome" 
End If

              - ou alors StrReverse n'existe pas et il faut la créer : 
              Function JeRenverseMonString(Byval StrTxt As String) As String
For i = Len(StrTxt) To 1 Step -1
    JeRenverseMonString = JeRenverseMonString & Mid(StrTxt, i, 1)
Next
end Function

              et l'utiliser : 
              If txt = JeRenverseMonString(txt) Then
   Label2.Caption = " est un palindrome" 
Else 
    Label2.Caption = " n'est pas un palindrome" 
End If


              Ce qui nous donne : 
              Private Sub Command1_Click() 
Dim txt As String
Dim i As Integer

If Text1.Text = "" Then 
    MsgBox "Entrer un mot ou phrase ! ", vbOKOnly, "Attention" 
End If

txt = Text1.Text 
For i = 1 To Len(txt)
    If Mid(txt, i, 1) = " " Then
        txt = Left(txt, i - 1) & Right(txt, Len(txt) - i)
    End If
Next i

txt = UCase(txt)

If txt = JeRenverseMonString(txt) Then
   Label2.Caption = " est un palindrome" 
Else 
    Label2.Caption = " n'est pas un palindrome" 
End If
End Sub

Function JeRenverseMonString(Byval StrTxt As String) As String
For i = Len(StrTxt) To 1 Step -1
    JeRenverseMonString = JeRenverseMonString & Mid(StrTxt, i, 1)
Next
end Function


              J'ai bon?
          3. lermite222 Contributeur
            Bonjour,
            Pour un prochain exercice essaye de faire les test dans le bon ordre, par exemple tu teste si le texte est vide APRES TRAITEMENT, faut faire ça AVANT...
            Je n'ai plus que le VB6, j'ai essayé de n'employer que des fonctions qui faisaient déjà partie de la panoplie des fonctions des versions précédentes.
            Si ce n'est pas le cas tu dis ont les remplaceras.
            Le code complet pour tes deux boutons... 

            Option Explicit 

Private Sub Command1_Click() 
Dim i As Integer 
Dim Txt As String 
Dim TxtR As String 
    If Text1 = "" Then 
        MsgBox "vous devez entrer une mot ou une phrase dans la saisie." 
        Text1.SetFocus 
        Exit Sub 
    End If 
    'Enlève les espaces pour avoir tout en un seul mot 
    Txt = Replace(Text1.Text, " ", "") 
     
    'retourner le mot 
    For i = Len(Txt) To 1 Step -1 
        TxtR = TxtR & Mid(Txt, i, 1) 
    Next 

    'Détection du palindrome 
    For i = 1 To Len(Txt) 
        If Mid(Txt, i, 1) <> Mid(TxtR, Len(Txt) - i + 1, 1) Then Exit For 
    Next i 


    If i > Len(Txt) Then 
        Label2.Caption = "C'est un palindrome" 
    Else 
        Label2.Caption = "Ce n'est pas un palindrome" 
    End If 
End Sub 

Private Sub Command2_Click() 
    Unload Me 
End Sub

            Par contre..
            Le but de ce programme est de marquer une phrase avec des accents et des espaces
            Ça je n'ai pas compris.
            A+
            Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
            NOTE : Je ne répond pas aux MP pour les questions techniques.

            Discussions similaires

            palindrome
            chaimaeraji

            3 réponses