TheGameCreators - CodeBase - Even larger collection of Text Functions

Return to the CodeBase listing

Category: Text

Version: 1.0

Information

Uploaded: 3rd Mar 2005 17:19

Modified: 1st Jan 1970 01:00

Author: Duffer

Summary

pretty self explanatory - just lots and lots of text functions and perhaps more accessible bin and hex functions...

Full Description

DarkBASIC Professional Source Code

` This code was downloaded from The Game Creators

` It is reproduced here with full permission

` http://www.thegamecreators.com

FUNCTION DecToBin$(value AS INTEGER, length AS INTEGER)

a AS INTEGER

testvalue AS INTEGER

a = 1

REPEAT

a = a * 2

UNTIL a > value

a = a / 2

testvalue = value

a$ = ""

REPEAT

IF a <= testvalue

a$ = a$ + "1"

testvalue = testvalue - a

ELSE

a$ = a$ + "0"

ENDIF

a = a / 2

UNTIL a <= 0

ll = LEN(a$)

IF length > ll

aa = length - ll

FOR r = 1 TO aa

a$ = "0" + a$

NEXT r

ENDIF

ENDFUNCTION a$

FUNCTION BinToDec(text$ AS STRING)

l = LEN(text$)

bit AS INTEGER

bit = 1

value AS INTEGER

FOR r = l TO 1 STEP -1

IF MID$(text$,r) = "1"

value = value + bit

ENDIF

bit = bit * 2

NEXT r

ENDFUNCTION value

FUNCTION DecToHex$(value AS INTEGER,length AS INTEGER)

b$ = HEX$(value)

blen = LEN(b$)

choice = 0

IF length > blen

choice = 1

c = length - blen

FOR r = 1 TO c

b$ = "0" + b$

NEXT r

ENDIF

IF choice < 1

blen = LEN(b$)

counter = 0

FOR r = 1 to blen

IF MID$(b$,r) = "0"

counter = r

ENDIF

NEXT r

IF counter > 0

c = blen - counter

b$ = RIGHT$(b$,c)

ENDIF

blen = LEN(b$)

c = blen MOD 2

IF c <> 0

b$ = "0" + b$

ENDIF

a$ = b$

ENDFUNCTION a$

FUNCTION BinToHex$(text$ AS STRING)

a AS INTEGER

a = BinToDec(text$)

b$ = DecToHex$(a,0)

ENDFUNCTION b$

FUNCTION HexToDec(hextext$ AS STRING)

hlen = LEN(hextext$)

test = hlen MOD 2

IF test = 1

hextext$ = "0" + hextext$

ENDIF

hlen = LEN(hextext$)

bytes = hlen / 2

IF bytes < 1

bytes = 1

ENDIF

DIM bitsections$(bytes)

nibble$ = hextext$

FOR r = 1 TO bytes

a$ = RIGHT$(nibble$,2)

FOR t = 0 TO 255

h$ = HEX$(t)

hh = LEN(h$)

xx = hh MOD 2

IF xx = 1

h$ = "0" + h$

ENDIF

IF h$ = a$

bina$ = DecToBin$(t,8)

bitsections$(r) = bina$

ENDIF

NEXT t

ll = LEN(nibble$)

lll = ll - 2

IF lll > 0

nibble$ = LEFT$(nibble$,lll)

ENDIF

NEXT r

a$ = ""

FOR r = 1 TO bytes

a$ = bitsections$(r) + a$

NEXT r

a AS INTEGER

a = BinToDec(a$)

ENDFUNCTION a

FUNCTION DecToRevBin$(value AS INTEGER, length AS INTEGER)

a AS INTEGER

testvalue AS INTEGER

a = 1

REPEAT

a = a * 2

UNTIL a > value

a = a / 2

testvalue = value

a$ = ""

REPEAT

IF a <= testvalue

a$ = a$ + "1"

testvalue = testvalue - a

ELSE

a$ = a$ + "0"

ENDIF

a = a / 2

UNTIL a <= 0

ll = LEN(a$)

IF length > ll

aa = length - ll

FOR r = 1 TO aa

a$ = "0" + a$

NEXT r

ENDIF

ll = LEN(a$)

b$ = ""

FOR r = ll TO 1 STEP -1

b$ = b$ + MID$(a$,r)

NEXT r

a$ = b$

ENDFUNCTION a$

FUNCTION DecToRevHex$(value AS INTEGER,length AS INTEGER)

b$ = HEX$(value)

blen = LEN(b$)

choice = 0

IF length > blen

choice = 1

c = length - blen

FOR r = 1 TO c

b$ = "0" + b$

NEXT r

ENDIF

IF choice < 1

blen = LEN(b$)

counter = 0

FOR r = 1 to blen

IF MID$(b$,r) = "0"

counter = r

ENDIF

NEXT r

IF counter > 0

c = blen - counter

b$ = RIGHT$(b$,c)

ENDIF

blen = LEN(b$)

c = blen MOD 2

IF c <> 0

b$ = "0" + b$

ENDIF

a$ = b$

ll = LEN(a$)

b$ = ""

FOR r = ll TO 1 STEP -2

b$ = b$ + MID$(a$,r-1) + MID$(a$,r)

NEXT r

a$ = b$

ENDFUNCTION a$

FUNCTION RevHexToDec(hextext$ as STRING)

hlen = LEN(hextext$)

test = hlen MOD 2

IF test = 1

hextext$ = "0" + hextext$

ENDIF

hlen = LEN(hextext$)

bytes = hlen / 2

IF bytes < 1

bytes = 1

ENDIF

DIM bitsections$(bytes)

nibble$ = hextext$

FOR r = 1 TO bytes

a$ = LEFT$(nibble$,2)

FOR t = 0 TO 255

h$ = HEX$(t)

hh = LEN(h$)

xx = hh MOD 2

IF xx = 1

h$ = "0" + h$

ENDIF

IF h$ = a$

bina$ = DecToBin$(t,8)

bitsections$(r) = bina$

ENDIF

NEXT t

ll = LEN(nibble$)

lll = ll - 2

IF lll > 0

nibble$ = RIGHT$(nibble$,lll)

ENDIF

NEXT r

a$ = ""

FOR r = 1 TO bytes

a$ = bitsections$(r) + a$

NEXT r

a AS INTEGER

a = BinToDec(a$)

ENDFUNCTION a

FUNCTION RevBinToDec(text$ AS STRING)

l = LEN(text$)

bit AS INTEGER

bit = 1

value AS INTEGER

FOR r = 1 TO l

IF MID$(text$,r) = "1"

value = value + bit

ENDIF

bit = bit * 2

NEXT r

ENDFUNCTION value

FUNCTION HexToBin$(hextext$ AS STRING)

a AS INTEGER

a = HexToDec(hextext$)

a$ = DecToBin$(a,0)

ENDFUNCTION a$

FUNCTION BinToRevHex$(text$ AS STRING)

a AS INTEGER

a = BinToDec(text$)

b$ = DecToRevHex$(a,0)

ENDFUNCTION b$

FUNCTION RevBinToRevHex$(text$ AS STRING)

a AS INTEGER

a = RevBinToDec(text$)

b$ = DecToRevHex$(a,0)

ENDFUNCTION b$

FUNCTION DecToBinToRevBinToDec(value AS INTEGER)

IF value = 0

EXITFUNCTION value

ENDIF

IF value < 0

value = 0

EXITFUNCTION value

ENDIF

a$ = DecToRevBin$(value,0)

value = BinToDec(a$)

ENDFUNCTION value

FUNCTION RevHexToRevBin$(text$ AS STRING)

a AS INTEGER

a = RevHexToDec(text$)

b$ = DecToRevBin$(a,0)

ENDFUNCTION b$

FUNCTION PutBitInDec(OriginalDecAmount AS INTEGER, PositionInString AS INTEGER, Bit AS INTEGER)

value = 0

ENDFUNCTION value

FUNCTION Extract$(maintext$ AS STRING,firstletter AS INTEGER,lastletter AS INTEGER)

a$ = ""

mlen = LEN(maintext$)

IF firstletter < 1

firstletter = 1

ENDIF

IF firstletter > mlen

firstletter = mlen

ENDIF

IF firstletter > lastletter

firstletter = lastletter

ENDIF

FOR r = firstletter TO lastletter

a$ = a$ + MID$(maintext$,r)

NEXT r

ENDFUNCTION a$

FUNCTION Copy$(maintext$ AS STRING,firstletter AS INTEGER,lastletter AS INTEGER)

a$ = ""

mlen = LEN(maintext$)

IF firstletter < 1

firstletter = 1

ENDIF

IF firstletter > mlen

firstletter = mlen

ENDIF

IF firstletter > lastletter

firstletter = lastletter

ENDIF

FOR r = firstletter TO lastletter

a$ = a$ + MID$(maintext$,r)

NEXT r

ENDFUNCTION a$

FUNCTION Search(maintext$ AS STRING,querytext$ AS STRING, startpos AS INTEGER)

result = 0

IF maintext$ = ""

EXITFUNCTION a

ENDIF

IF querytext$ = ""

EXITFUNCTION a

ENDIF

alen = LEN(maintext$)

blen = LEN(querytext$)

IF blen > alen

EXITFUNCTION result

ENDIF

maintext$ = UPPER$(maintext$)

querytext$ = UPPER$(querytext$)

IF blen = alen

IF querytext$ = maintext$

result = 1

EXITFUNCTION result

ENDIF

IF querytext$ <> maintext$

result = 0

EXITFUNCTION result

ENDIF

clen = (alen - blen) + 1

blenminus = blen - 1

IF startpos > clen

result = 0

EXITFUNCTION result

ENDIF

FOR r = startpos TO clen

rr = r + blenminus

IF querytext$ = Extract$(maintext$,r,rr)

result = r

ENDIF

NEXT r

ENDFUNCTION result

FUNCTION SensitiveSearch(maintext$ AS STRING,querytext$ AS STRING, startpos AS INTEGER)

result = 0

IF maintext$ = ""

EXITFUNCTION a

ENDIF

IF querytext$ = ""

EXITFUNCTION a

ENDIF

alen = LEN(maintext$)

blen = LEN(querytext$)

IF blen > alen

EXITFUNCTION result

ENDIF

IF blen = alen

IF querytext$ = maintext$

result = 1

EXITFUNCTION result

ENDIF

IF querytext$ <> maintext$

result = 0

EXITFUNCTION result

ENDIF

clen = (alen - blen) + 1

blenminus = blen - 1

IF startpos > clen

result = 0

EXITFUNCTION result

ENDIF

FOR r = startpos TO clen

rr = r + blenminus

IF querytext$ = Extract$(maintext$,r,rr)

result = r

ENDIF

NEXT r

ENDFUNCTION result

FUNCTION Instr(maintext$ AS STRING,querytext$ AS STRING, startpos AS INTEGER)

result = 0

IF maintext$ = ""

EXITFUNCTION a

ENDIF

IF querytext$ = ""

EXITFUNCTION a

ENDIF

alen = LEN(maintext$)

blen = LEN(querytext$)

IF blen > alen

EXITFUNCTION result

ENDIF

maintext$ = UPPER$(maintext$)

querytext$ = UPPER$(querytext$)

IF blen = alen

IF querytext$ = maintext$

result = 1

EXITFUNCTION result

ENDIF

IF querytext$ <> maintext$

result = 0

EXITFUNCTION result

ENDIF

clen = (alen - blen) + 1

blenminus = blen - 1

IF startpos > clen

result = 0

EXITFUNCTION result

ENDIF

FOR r = startpos TO clen

rr = r + blenminus

IF querytext$ = Extract$(maintext$,r,rr)

result = r

ENDIF

NEXT r

ENDFUNCTION result

FUNCTION Count(maintext$ AS STRING, searchstring$ AS STRING, startpos AS INTEGER)

a = 0

IF maintext$ = ""

EXITFUNCTION a

ENDIF

IF searchstring$ = ""

EXITFUNCTION a

ENDIF

alen = LEN(maintext$)

blen = LEN(searchstring$)

IF blen > alen

EXITFUNCTION a

ENDIF

IF blen = alen

IF searchstring$ = maintext$

a = 1

EXITFUNCTION a

ENDIF

IF searchstring$ <> maintext$

a = 0

EXITFUNCTION a

ENDIF

clen = (alen - blen) + 1

blenminus = blen - 1

IF startpos > clen

a = 0

EXITFUNCTION a

ENDIF

FOR r = startpos TO clen

rr = r + blenminus

IF querytext$ = Extract$(maintext$,r,rr)

a = a + 1

ENDIF

NEXT r

ENDFUNCTION a

FUNCTION String$(repeatstring$ AS STRING, repititions AS INTEGER)

a$ = ""

IF repititions < 1

EXITFUNCTION a$

ENDIF

IF repeatstring$ = ""

EXITFUNCTION a$

ENDIF

FOR r = 1 TO repititions

a$ = a$ + repeatstring$

NEXT r

ENDFUNCTION a$

FUNCTION Min$(firststring$ AS STRING, secondstring$ AS STRING)

a$ = ""

IF firststring$ > secondstring$

a$ = secondstring$

ENDIF

IF secondstring$ > firststring$

a$ = firststring$

ENDIF

ENDFUNCTION a$

FUNCTION Max$(firststring$ AS STRING, secondstring$ AS STRING)

a$ = ""

IF firststring$ > secondstring$

a$ = firststring$

ENDIF

IF secondstring$ > firststring$

a$ = secondstring$

ENDIF

IF firststring$ = secondstring$

a$ = firststring$

ENDIF

ENDFUNCTION a$

FUNCTION LTrim$(maintext$ AS STRING,trimfromleft AS INTEGER)

a$ = maintext$

IF a$ = ""

EXITFUNCTION a$

ENDIF

alen = LEN(maintext$)

IF trimfromleft >= alen

EXITFUNCTION a$

ENDIF

a = alen - trimfromleft

a$ = RIGHT$(a$,a)

ENDFUNCTION a$

FUNCTION RTrim$(maintext$ AS STRING,trimfromright AS INTEGER)

a$ = maintext$

IF a$ = ""

EXITFUNCTION a$

ENDIF

alen = LEN(maintext$)

IF trimfromright >= alen

EXITFUNCTION a$

ENDIF

a = alen - trimfromright

a$ = LEFT$(a$,a)

ENDFUNCTION a$

FUNCTION ScrollLeft$(maintext$ AS STRING)

IF maintext$ = ""

EXITFUNCTION maintext$

ENDIF

alen = LEN(maintext$)

IF alen = 1

EXITFUNCTION maintext$

ENDIF

a$ = ""

a$ = RIGHT$(maintext$,1) + LEFT$(maintext$, (alen-1))

ENDFUNCTION a$

FUNCTION ScrollRight$(maintext$ AS STRING)

IF maintext$ = ""

EXITFUNCTION maintext$

ENDIF

alen = LEN(maintext$)

IF alen = 1

EXITFUNCTION maintext$

ENDIF

a$ = ""

a$ = LEFT$(maintext$,1) + RIGHT$(maintext$, (alen-1))

ENDFUNCTION a$

FUNCTION Title$(maintext$ AS STRING)

a$ = ""

IF maintext$ = ""

EXITFUNCTION a$

ENDIF

alen = LEN(maintext$)

IF alen = 1

a$ = UPPER$(maintext$)

EXITFUNCTION a$

ENDIF

a$ = UPPER$(Copy$(maintext$,1,1))

FOR r = 2 TO alen

a$ = a$ + Copy$(maintext$,r,r)

NEXT r

ENDFUNCTION a$

FUNCTION Sentence$(maintext$ AS STRING)

a$ = Title$(maintext$)

a$ = a$ + "."

ENDFUNCTION a$

FUNCTION Flip$(maintext$ AS STRING)

IF maintext$ = ""

EXITFUNCTION maintext$

ENDIF

alen = LEN(maintext$)

a$ = ""

FOR r = alen to 1 STEP -1

b$ = Copy$(a$,r,r)

a$ = a$ + b$

NEXT r

ENDFUNCTION a$

FUNCTION Insert$(maintext$ AS STRING, texttoinsert$ AS STRING, insertionpoint AS INTEGER)

IF insertionpoint < 0

insertionpoint = 0

ENDIF

a$ = ""

IF texttoinsert$ = ""

EXITFUNCTION maintext$

ENDIF

IF insertionpoint = 0

a$ = texttoinsert$ + maintext$

EXITFUNCTION a$

ENDIF

alen = LEN(maintext$)

blen = LEN(texttoinsert$)

IF insertionpoint = (alen + 1)

a$ = maintext$ + texttoinsert$

EXITFUNCTION a$

ENDIF

IF insertionpoint > (alen + 1)

a$ = maintext$ + SPACE$(insertionpoint - alen + 1) + texttoinsert$

EXITFUNCTION a$

ENDIF

a$ = LEFT$(maintext$,insertionpoint) + texttoinsert$ + RIGHT$(maintext$,(alen-insertionpoint))

ENDFUNCTION a$

FUNCTION Overwrite$(maintext$ AS STRING, texttooverwrite$ AS STRING, insertionpoint AS INTEGER)

IF insertionpoint < 0

insertionpoint = 0

ENDIF

a$ = ""

IF texttooverwrite$ = ""

EXITFUNCTION maintext$

ENDIF

alen = LEN(maintext$)

blen = LEN(texttooverwrite$)

IF insertionpoint = 0

a$ = texttooverwrite$ + RIGHT$(maintext$,(alen-blen))

EXITFUNCTION a$

ENDIF

IF insertionpoint = (alen + 1)

a$ = maintext$ + texttooverwrite$

EXITFUNCTION a$

ENDIF

IF insertionpoint > (alen + 1)

a$ = maintext$ + SPACE$(insertionpoint - alen + 1) + texttooverwrite$

EXITFUNCTION a$

ENDIF

a$ = LEFT$(maintext$,insertionpoint) + texttooverwrite$

b = insertionpoint + blen

a$ = a$ + RIGHT$(maintext$,b)

ENDFUNCTION a$

FUNCTION Cut$(maintext$ AS STRING, cutoutstartpos AS INTEGER, cutoutfinishpos AS INTEGER)

a$ = ""

IF maintext$ = ""

EXITFUNCTION a$

ENDIF

IF cutoutstartpos < 1

cutoutstartpos = 1

ENDIF

IF cutoutfinishpos < cutoutstartpos

cutoutfinishpos = cutoutstartpos

ENDIF

alen = LEN(maintext$)

IF cutoutfinishpos > alen

cutoutfinishpos = alen

ENDIF

IF cutoutstartpos = 1

IF alen - cutoutfinishpoint = 0

cutoutfinishpoint = cutoutfinishpoint + 1

ENDIF

a$ = RIGHT$(maintext$,(alen - cutoutfinishpos))

EXITFUNCTION a$

ENDIF

IF cutoutstartpos > 1

a$ = LEFT$(maintext$,(cutoutstartpos - 1))

IF cutoutfinishpos < alen

a$ = a$ + RIGHT$(maintext$,alen - cutoutfinishpos)

EXITFUNCTION a$

ENDIF

IF cutoutfinishpos = alen

a$ = LEFT$(maintext$,(cutoutstartpos - 1))

EXITFUNCTION a$

ENDIF

ENDFUNCTION a$

FUNCTION FilterOut$(maintext$ AS STRING, filteroutstring$ AS STRING)

a$ = maintext$

IF maintext$ = ""

EXITFUNCTION a$

ENDIF

alen = LEN(maintext$)

blen = LEN(filteroutstring$)

IF blen >= alen

a$ = ""

EXITFUNCTION a$

ENDIF

IF filteroutstring$ = maintext$

a$ = ""

EXITFUNCTION a$

ENDIF

clen = alen - blen + 1

dlen = blen - 1

b$ = ""

r = 1

REPEAT

c$ = Copy$(maintext$,r,(r+dlen))

IF c$ = filteroutstring$

r = r + blen

ELSE

b$ = b$ + Copy$(maintext$,r,r)

r = r + 1

ENDIF

UNTIL r > clen

ENDFUNCTION b$

FUNCTION FindStartPositionOfNextWord(maintext$ AS STRING, startpos AS INTEGER)

a$ = ""

a = 0

IF maintext$ = ""

EXITFUNCTION a

ENDIF

alen = LEN(maintext$)

IF startpos >= alen

EXITFUNCTION a

ENDIF

c$ = Copy$(maintext$,startpos,startpos)

l1:

IF c$ = " "

r = startpos

REPEAT

d$ = Copy$(maintext$,r,r)

IF d$ <> " "

a = r

EXIT

ENDIF

r = r + 1

UNTIL r > alen

ENDIF

IF c$ <> " "

r = startpos

REPEAT

d$ = Copy$(maintext$,r,r)

IF d$ = " "

c$ = " "

startpos = r

EXIT

ENDIF

r = r + 1

UNTIL r > alen

IF c$ = " "

GOTO l1

ENDIF

ENDFUNCTION a

FUNCTION Min(firstvalue AS INTEGER, secondvalue AS INTEGER)

result = 0

IF firstvalue < secondvalue

result = firstvalue

ENDIF

IF secondvalue < firstvalue

result = secondvalue

ENDIF

IF firstvalue = secondvalue

result = firstvalue

ENDIF

ENDFUNCTION result

FUNCTION Max(firstvalue AS INTEGER, secondvalue AS INTEGER)

result = 0

IF firstvalue < secondvalue

result = secondvalue

ENDIF

IF secondvalue < firstvalue

result = firstvalue

ENDIF

IF firstvalue = secondvalue

result = firstvalue

ENDIF

ENDFUNCTION result

FUNCTION Odd(testvalue AS INTEGER)

v AS INTEGER

v = testvalue MOD 2

result = 0

IF v = 1

result = 1

ENDIF

ENDFUNCTION result

FUNCTION Even(testvalue AS INTEGER)

v AS INTEGER

v = testvalue MOD 2

result = 0

IF v = 0

result = 1

ENDIF

ENDFUNCTION result

Download

Please login to download

Comments

No comments yet.

CodeBase - Even larger collection of Text Functions - better Hex, Dec and Bin functions...

Information

Summary

Full Description

DarkBASIC Professional Source Code

Download

Screen Shot

Author

Comments

Author Name:	Duffer
CodeBase Entries:	4