Determine if a string has all the same characters: Difference between revisions
Content deleted Content added
Line 288: | Line 288: | ||
| '4444 444k' | 9 | no | ' ' | 20 | 5 | |
| '4444 444k' | 9 | no | ' ' | 20 | 5 | |
||
|-------------|--------|----------|----------|-----|----------| |
|-------------|--------|----------|----------|-----|----------| |
||
</pre> |
|||
=={{header|BASIC}}== |
|||
==={{header|QuickBASIC}}=== |
|||
Works with QBASIC, VB-DOS, PDS 7.x |
|||
<lang QBASIC> |
|||
DECLARE SUB DifChar (sString AS STRING, wc AS INTEGER, dc AS STRING) |
|||
DIM i AS INTEGER |
|||
DIM s AS STRING |
|||
DIM dc AS STRING |
|||
DATA "", " ", "2", "333",".55","tttTTT", "4444 444k", "FIN" |
|||
' Main program cycle |
|||
CLS |
|||
PRINT "Program SameChar" |
|||
PRINT "Determines if a string has the same character or not." |
|||
PRINT |
|||
DO |
|||
READ s |
|||
IF s = "FIN" THEN EXIT DO |
|||
DifChar s, i, dc |
|||
PRINT "'"; s; "' of length"; LEN(s); |
|||
IF i < 2 THEN |
|||
PRINT "contains all the same character." |
|||
ELSE |
|||
PRINT "is different at possition"; STR$(i); ": '"; dc; "' (0x"; HEX$(ASC(dc)); ")" |
|||
END IF |
|||
LOOP |
|||
PRINT |
|||
PRINT "End of program run." |
|||
END |
|||
SUB DifChar (sString AS STRING, wc AS INTEGER, dc AS STRING) |
|||
' Var |
|||
DIM c AS STRING |
|||
' Look for the distinct char |
|||
c = LEFT$(sString, 1) |
|||
wc = 1 |
|||
dc = "" |
|||
DO WHILE wc < LEN(sString) |
|||
IF MID$(sString, wc, 1) <> c THEN dc = MID$(sString, wc, 1): EXIT DO |
|||
wc = wc + 1 |
|||
LOOP |
|||
IF dc = "" THEN wc = 1 |
|||
END SUB |
|||
</lang> |
|||
{{out}} |
|||
<pre> |
|||
Program SameChar |
|||
Determines if a string has the same character or not. |
|||
'' of length 0 contains all the same character. |
|||
' ' of length 3 contains all the same character. |
|||
'2' of length 1 contains all the same character. |
|||
'333' of lenght 3 contains all the same character. |
|||
'.55' of length 3 is different at possition 2: '5' (0x35) |
|||
'tttTTT' of length 6 is different at possition 4: 'T' (0x54) |
|||
'4444 444k' of length 9 is different at possition 5: ' ' (0x20) |
|||
End of program run. |
|||
</pre> |
</pre> |
||