81 lines
1.4 KiB
Plaintext
81 lines
1.4 KiB
Plaintext
' 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%, NewText$, j%
|
||
|
||
j% = LEN(WhichText$)
|
||
FOR i% = 1 TO j%
|
||
NewText$ = MID$(WhichText$, i%, 1) + NewText$
|
||
NEXT i%
|
||
|
||
RvrsText$ = NewText$
|
||
|
||
END FUNCTION
|