81 lines
1.4 KiB
Text
81 lines
1.4 KiB
Text
|
' OPTION _EXPLICIT ' For QB64. In VB-DOS remove the underscore.
|
|||
|
|
|
|||
|
|
DIM txt$
|
|||
|
|
|
|||
|
|
' Palindrome
|
|||
|
|
CLS
|
|||
|
|
PRINT "This is a palindrome detector program."
|
|||
|
|
PRINT
|
|||
|
|
INPUT "Please, type a word or phrase: ", txt$
|
|||
|
|
|
|||
|
|
IF IsPalindrome(txt$) THEN
|
|||
|
|
PRINT "Is a palindrome."
|
|||
|
|
ELSE
|
|||
|
|
PRINT "Is Not a palindrome."
|
|||
|
|
END IF
|
|||
|
|
|
|||
|
|
END
|
|||
|
|
|
|||
|
|
|
|||
|
|
FUNCTION IsPalindrome (AText$)
|
|||
|
|
' Var
|
|||
|
|
DIM CleanTXT$, RvrsTXT$
|
|||
|
|
|
|||
|
|
CleanTXT$ = CleanText$(AText$)
|
|||
|
|
RvrsTXT$ = RvrsText$(CleanTXT$)
|
|||
|
|
|
|||
|
|
IsPalindrome = (CleanTXT$ = RvrsTXT$)
|
|||
|
|
|
|||
|
|
END FUNCTION
|
|||
|
|
|
|||
|
|
FUNCTION CleanText$ (WhichText$)
|
|||
|
|
' Var
|
|||
|
|
DIM i%, j%, c$, NewText$, CpyTxt$, AddIt%, SubsTXT$
|
|||
|
|
CONST False = 0, True = NOT False
|
|||
|
|
|
|||
|
|
SubsTXT$ = "AIOUE"
|
|||
|
|
CpyTxt$ = UCASE$(WhichText$)
|
|||
|
|
j% = LEN(CpyTxt$)
|
|||
|
|
|
|||
|
|
FOR i% = 1 TO j%
|
|||
|
|
c$ = MID$(CpyTxt$, i%, 1)
|
|||
|
|
|
|||
|
|
' See if it is a letter. Includes Spanish letters.
|
|||
|
|
SELECT CASE c$
|
|||
|
|
CASE "A" TO "Z"
|
|||
|
|
AddIt% = True
|
|||
|
|
CASE " ", "¡", "¢", "£"
|
|||
|
|
c$ = MID$(SubsTXT$, ASC(c$) - 159, 1)
|
|||
|
|
AddIt% = True
|
|||
|
|
CASE "‚"
|
|||
|
|
c$ = "E"
|
|||
|
|
AddIt% = True
|
|||
|
|
CASE "¤"
|
|||
|
|
c$ = "¥"
|
|||
|
|
AddIt% = True
|
|||
|
|
CASE ELSE
|
|||
|
|
AddIt% = False
|
|||
|
|
END SELECT
|
|||
|
|
|
|||
|
|
IF AddIt% THEN
|
|||
|
|
NewText$ = NewText$ + c$
|
|||
|
|
END IF
|
|||
|
|
NEXT i%
|
|||
|
|
|
|||
|
|
CleanText$ = NewText$
|
|||
|
|
|
|||
|
|
END FUNCTION
|
|||
|
|
|
|||
|
|
FUNCTION RvrsText$ (WhichText$)
|
|||
|
|
' Var
|
|||
|
|
DIM i%, c$, NewText$, j%
|
|||
|
|
|
|||
|
|
j% = LEN(WhichText$)
|
|||
|
|
FOR i% = 1 TO j%
|
|||
|
|
NewText$ = MID$(WhichText$, i%, 1) + NewText$
|
|||
|
|
NEXT i%
|
|||
|
|
|
|||
|
|
RvrsText$ = NewText$
|
|||
|
|
|
|||
|
|
END FUNCTION
|