All pastes #559316 Raw Edit

Palindrome (Not working)

public text v1 · immutable
·published 2007-06-11 18:30 UTC
rendered paste body
Option Explicit

Function Normalize(ByVal strPhrase As String) As String
    Dim intLCV As Integer
    Dim strNewPhrase As String
    
    strPhrase = LCase(strPhrase)
    
    For intLCV = 1 To Len(strPhrase)
        If Mid(strPhrase, intLCV, 1) Like "[a-z]" Then
            strNewPhrase = strNewPhrase & Mid(strPhrase, intLCV, 1)
        End If
    Next intLCV
    
    Normalize = strNewPhrase
End Function

Function IsPalindrome(ByVal strPhrase As String) As Boolean
    Dim intBegin As Integer
    Dim intEnd As Integer
    Dim blnPalindrome As Boolean
    
    intBegin = 1
    intEnd = Len(strPhrase)
    blnPalindrome = True
    
    Do While intBegin < Len(strPhrase) \ 2 And blnPalindrome = True
        If Mid(strPhrase, intBegin, 1) <> Mid(strPhrase, intEnd, 1) Then
            blnPalindrome = False
        Else
            intBegin = intBegin + 1
            intEnd = intEnd - 1
        End If
    Loop
    
    IsPalindrome = blnPalindrome

End Function

Sub FindPalindromes(ByVal strPhrase As String, ByRef strArray() As String)
    Dim intLCV As Integer
    Dim intPos As Integer
    
    strPhrase = Normalize(strPhrase)
    
    For intLCV = 2 To Len(strPhrase)
        intPos = 1
        Do While intPos + intLCV <= Len(strPhrase)
            If IsPalindrome(Mid(strPhrase, intPos, intLCV)) Then
                ReDim Preserve strArray(intLCV)
                strArray(intLCV) = Mid(strPhrase, intPos, intLCV)
            End If
            intPos = intPos + 1
        Loop
    Next intLCV
End Sub

Private Sub Form_Load()
    Dim strPalindromes() As String
    Dim intLCV As Integer
    
    Call FindPalindromes("Hello Madam, I'm Adam and this is my friend Bob", strPalindromes)
    
    For intLCV = LBound(strPalindromes) To UBound(strPalindromes)
        MsgBox strPalindromes(intLCV)
    Next intLCV
End Sub