'===========================================================================
' Subject: MATHEMATICAL FUNCTIONS             Date: 08-27-97 (18:40)       
'  Author: Michael S. Halpin                  Code: QB, QBasic, PDS        
'  Origin: calvarygames@juno.com            Packet: ALGOR.ABC
'===========================================================================
'Function.Bas
'       By Michael S. Halpin
'
'This program is released to public domain.  Anyone may incorporate any part
'or the entire program into theirs.  All I as in return is a little credit.
'Just put my name in the credits under special thanks to or a similar category.
'If you were not going to use credits well you are going to now.  And if you
'are one of those infringing gluttons that hog all the credit then you don't
'belong on the internet.  And don't use this program.  If you do and don't
'give me credit, and I do check, and I find out about it I will boycott you
'and you software and hunt you for the rest of your days.  All this can be
'avoided if you just give me credit.
'
'Copyright 1997-98
'       Michael S. Halpin
'               All Rights Reserved.
'
'If you have any questions, comments, or concerns you can contact me at CalvaryGames@Juno.Com.
'You can check us out on the web at http://members.aol.com/calvrygame
'
'! ! ! ! ! ! ! ! ! Attention all QB 4.5 Users ! ! ! ! ! ! ! ! ! ! !
'Some of the function like Hex2Dec and Oct2Dec may not work well with
'QB 4.5 due to it inability to properly calculate numbers.  You may get an
'over flow error.  This is NOT my fault I will try to find away around this
'for the future.  It should work fine in Power Basic.
'
'* * * * * * Built-In Mathematical Basic Functions * * * * * * *
'
'Declare Function Int(Number)        'Converts Decimals to lowest possible integers.
'Declare Function Hex$(Number)       'Converts Integers to hexidecimal.
'Declare Function Oct$(Number)       'Converts integers to octal.
'Declare Function Abs$(Number)       'Sets a number to absolute value. (1 = 1, -1 = 1)
'Declare Function Sqr(Number)        'Finds the square rood of a number.
'Declare Function Sgn(Number)        'Tells wether a number is positiver, negative, or zero.
'Declare Function Sin(Number)        'Returns the sine of a number.
'Declare Function Cos(Number)        'Returns the cosine of a number.
'Declare Function Log(Number)        'Returns the logarithm of a number (Base E).
'Declare Function Tan(Number)        'Returns the tangent of a number
'Declare Function Val(String)        'Returns the value of a string. (thus "2443" = 2443)
'Declare Funtion CInt(Number)        'Rounds a decimal to an integer using the first number after the decimal.  (eg. 1.5 = 2 but 1.45 = 1)
'
'* * * * * * Extended Mathematical Basic Functions * * * * * * *
DECLARE FUNCTION XRoot (X, Number)              'Finds the X root of the Number.  (Ex. XRoot(4, 81) = 4 | (4*4*4*4)=81)
DECLARE FUNCTION XLog (X, Number)               'Finds the log of the Number using the Base X.
DECLARE FUNCTION Distance (X1, Y1, X2, Y2)      'Calculates using the distance formula.
DECLARE FUNCTION Hex2Dec# (HexNumber$)          'Converts Hex Numbers to Decimal (Supports up to number FFFFFFFF).
DECLARE FUNCTION Oct2Dec (OctNumber$)           'Converts octal numbert to decimal (Supports up to number 77777777).
DECLARE FUNCTION Bin$ (Number)                  'Converts decimal to binary in sting format up to 255.
DECLARE FUNCTION CBin (Number)                  'Converts decimal to binary in integer format up to 255.
DECLARE FUNCTION Bin2Dec (Number)               'Converts Binary to Decimal up to 11111111.
DECLARE FUNCTION Round (Number)                 'Rounds number to the highest integer better than CInt. (eg. 1.5 = 2 and 1.4444445 = 2)
DECLARE FUNCTION Reverse (Number)               'Makes a negitive positive and a positive negative.
DECLARE FUNCTION Format$ (Number#, NumberPlaces) 'Formats a number to read only a certain number of places after the decimal in string format. (ex Format$(45.2154654, 2) becomes 45.21)
DECLARE FUNCTION Pyt (A, B)                     'Calculates the length of the hypotenuse of a right triangle using the pythagorean theorem.
DECLARE SUB Quad (A, B, C)                      'Calculates using the quadratic formula.

DIM SHARED Quad1, Quad2, Buffer AS STRING * 1
CONST PI = 3.141592654#

FUNCTION Bin$ (Number)

IF Number >= 128 THEN Value$ = "1": Number = Number - 128 ELSE Value$ = "0"
IF Number >= 64 THEN Value$ = Value$ + "1": Number = Number - 64 ELSE Value$ = Value$ + "0"
IF Number >= 32 THEN Value$ = Value$ + "1": Number = Number - 32 ELSE Value$ = Value$ + "0"
IF Number >= 16 THEN Value$ = Value$ + "1": Number = Number - 16 ELSE Value$ = Value$ + "0"
IF Number >= 8 THEN Value$ = Value$ + "1": Number = Number - 8 ELSE Value$ = Value$ + "0"
IF Number >= 4 THEN Value$ = Value$ + "1": Number = Number - 4 ELSE Value$ = Value$ + "0"
IF Number >= 2 THEN Value$ = Value$ + "1": Number = Number - 2 ELSE Value$ = Value$ + "0"
IF Number >= 1 THEN Value$ = Value$ + "1": Number = Number - 1 ELSE Value$ = Value$ + "0"

Bin$ = Value$

END FUNCTION

FUNCTION Bin2Dec (Number)

IF Number >= 10000000 THEN Number = Number - 10000000: Value = 128 ELSE Value = 0
IF Number >= 1000000 THEN Number = Number - 1000000: Value = Value + 64
IF Number >= 100000 THEN Number = Number - 100000: Value = Value + 32
IF Number >= 10000 THEN Number = Number - 10000: Value = Value + 16
IF Number >= 1000 THEN Number = Number - 1000: Value = Value + 8
IF Number >= 100 THEN Number = Number - 100: Value = Value + 4
IF Number >= 10 THEN Number = Number - 10: Value = Value + 2
IF Number >= 1 THEN Number = Number - 1: Value = Value + 1

Bin2Dec = Value

END FUNCTION

FUNCTION CBin (Number)
IF Number >= 128 THEN Value$ = "1": Number = Number - 128 ELSE Value$ = "0"
IF Number >= 64 THEN Value$ = Value$ + "1": Number = Number - 64 ELSE Value$ = Value$ + "0"
IF Number >= 32 THEN Value$ = Value$ + "1": Number = Number - 32 ELSE Value$ = Value$ + "0"
IF Number >= 16 THEN Value$ = Value$ + "1": Number = Number - 16 ELSE Value$ = Value$ + "0"
IF Number >= 8 THEN Value$ = Value$ + "1": Number = Number - 8 ELSE Value$ = Value$ + "0"
IF Number >= 4 THEN Value$ = Value$ + "1": Number = Number - 4 ELSE Value$ = Value$ + "0"
IF Number >= 2 THEN Value$ = Value$ + "1": Number = Number - 2 ELSE Value$ = Value$ + "0"
IF Number >= 1 THEN Value$ = Value$ + "1": Number = Number - 1 ELSE Value$ = Value$ + "0"

CBin = VAL(Value$)

END FUNCTION

FUNCTION Distance (X1, Y1, X2, Y2)

Distance = SQR((X1 - X2) ^ 2 + (Y1 - Y2) ^ 2)

END FUNCTION

FUNCTION Format$ (Number#, NumberPlaces)


Num$ = LTRIM$(RTRIM$(STR$(Number#)))
Value$ = LEFT$(Num$, (INSTR(Num$, ".") + NumberPlaces))
Format$ = Value$


END FUNCTION

FUNCTION Hex2Dec# (HexNumber$)

Number$ = LTRIM$(RTRIM$(UCASE$(HexNumber$)))
Buffer$ = ""
Value# = 0

IF LEN(Number$) = 8 THEN
        Buffer = LEFT$(Number$, 1)
        Number$ = RIGHT$(Number$, 7)
END IF

IF Buffer = "1" THEN Value# = Value# + (268435456 * 1)
IF Buffer = "2" THEN Value# = Value# + (268435456 * 2)
IF Buffer = "3" THEN Value# = Value# + (268435456 * 3)
IF Buffer = "4" THEN Value# = Value# + (268435456 * 4)
IF Buffer = "5" THEN Value# = Value# + (268435456 * 5)
IF Buffer = "6" THEN Value# = Value# + (268435456 * 6)
IF Buffer = "7" THEN Value# = Value# + (268435456 * 7)
IF Buffer = "8" THEN Value# = Value# + (268435456 * 8)
IF Buffer = "9" THEN Value# = Value# + (268435456 * 9)
IF Buffer = "A" THEN Value# = Value# + (268435456 * 10)
IF Buffer = "B" THEN Value# = Value# + (268435456 * 11)
IF Buffer = "C" THEN Value# = Value# + (268435456 * 12)
IF Buffer = "D" THEN Value# = Value# + (268435456 * 13)
IF Buffer = "E" THEN Value# = Value# + (268435456 * 14)
IF Buffer = "F" THEN Value# = Value# + (268435456 * 15)
Buffer = ""

IF LEN(Number$) = 7 THEN
        Buffer = LEFT$(Number$, 1)
        Number$ = RIGHT$(Number$, 6)
END IF

IF Buffer = "1" THEN Value# = Value# + (16777216 * 1)
IF Buffer = "2" THEN Value# = Value# + (16777216 * 2)
IF Buffer = "3" THEN Value# = Value# + (16777216 * 3)
IF Buffer = "4" THEN Value# = Value# + (16777216 * 4)
IF Buffer = "5" THEN Value# = Value# + (16777216 * 5)
IF Buffer = "6" THEN Value# = Value# + (16777216 * 6)
IF Buffer = "7" THEN Value# = Value# + (16777216 * 7)
IF Buffer = "8" THEN Value# = Value# + (16777216 * 8)
IF Buffer = "9" THEN Value# = Value# + (16777216 * 9)
IF Buffer = "A" THEN Value# = Value# + (16777216 * 10)
IF Buffer = "B" THEN Value# = Value# + (16777216 * 11)
IF Buffer = "C" THEN Value# = Value# + (16777216 * 12)
IF Buffer = "D" THEN Value# = Value# + (16777216 * 13)
IF Buffer = "E" THEN Value# = Value# + (16777216 * 14)
IF Buffer = "F" THEN Value# = Value# + (16777216 * 15)
Buffer = ""

IF LEN(Number$) = 6 THEN
        Buffer = LEFT$(Number$, 1)
        Number$ = RIGHT$(Number$, 5)
END IF

IF Buffer = "1" THEN Value# = Value# + (1048576 * 1)
IF Buffer = "2" THEN Value# = Value# + (1048576 * 2)
IF Buffer = "3" THEN Value# = Value# + (1048576 * 3)
IF Buffer = "4" THEN Value# = Value# + (1048576 * 4)
IF Buffer = "5" THEN Value# = Value# + (1048576 * 5)
IF Buffer = "6" THEN Value# = Value# + (1048576 * 6)
IF Buffer = "7" THEN Value# = Value# + (1048576 * 7)
IF Buffer = "8" THEN Value# = Value# + (1048576 * 8)
IF Buffer = "9" THEN Value# = Value# + (1048576 * 9)
IF Buffer = "A" THEN Value# = Value# + (1048576 * 10)
IF Buffer = "B" THEN Value# = Value# + (1048576 * 11)
IF Buffer = "C" THEN Value# = Value# + (1048576 * 12)
IF Buffer = "D" THEN Value# = Value# + (1048576 * 13)
IF Buffer = "E" THEN Value# = Value# + (1048576 * 14)
IF Buffer = "F" THEN Value# = Value# + (1048576 * 15)
Buffer = ""

IF LEN(Number$) = 5 THEN
        Buffer = LEFT$(Number$, 1)
        Number$ = RIGHT$(Number$, 4)
END IF

IF Buffer = "1" THEN Value# = Value# + (65536 * 1)
IF Buffer = "2" THEN Value# = Value# + (65536 * 2)
IF Buffer = "3" THEN Value# = Value# + (65536 * 3)
IF Buffer = "4" THEN Value# = Value# + (65536 * 4)
IF Buffer = "5" THEN Value# = Value# + (65536 * 5)
IF Buffer = "6" THEN Value# = Value# + (65536 * 6)
IF Buffer = "7" THEN Value# = Value# + (65536 * 7)
IF Buffer = "8" THEN Value# = Value# + (65536 * 8)
IF Buffer = "9" THEN Value# = Value# + (65536 * 9)
IF Buffer = "A" THEN Value# = Value# + (65536 * 10)
IF Buffer = "B" THEN Value# = Value# + (65536 * 11)
IF Buffer = "C" THEN Value# = Value# + (65536 * 12)
IF Buffer = "D" THEN Value# = Value# + (65536 * 13)
IF Buffer = "E" THEN Value# = Value# + (65536 * 14)
IF Buffer = "F" THEN Value# = Value# + (65536 * 15)
Buffer = ""

IF LEN(Number$) = 4 THEN
        Buffer = LEFT$(Number$, 1)
        Number$ = RIGHT$(Number$, 3)
END IF

IF Buffer = "1" THEN Value# = Value# + (4096 * 1)
IF Buffer = "2" THEN Value# = Value# + (4096 * 2)
IF Buffer = "3" THEN Value# = Value# + (4096 * 3)
IF Buffer = "4" THEN Value# = Value# + (4096 * 4)
IF Buffer = "5" THEN Value# = Value# + (4096 * 5)
IF Buffer = "6" THEN Value# = Value# + (4096 * 6)
IF Buffer = "7" THEN Value# = Value# + (4096 * 7)
IF Buffer = "8" THEN Value# = Value# + (4096 * 8)
IF Buffer = "9" THEN Value# = Value# + (4096 * 9)
IF Buffer = "A" THEN Value# = Value# + (4096 * 10)
IF Buffer = "B" THEN Value# = Value# + (4096 * 11)
IF Buffer = "C" THEN Value# = Value# + (4096 * 12)
IF Buffer = "D" THEN Value# = Value# + (4096 * 13)
IF Buffer = "E" THEN Value# = Value# + (4096 * 14)
IF Buffer = "F" THEN Value# = Value# + (4096 * 15)
Buffer = ""

IF LEN(Number$) = 3 THEN
        Buffer = LEFT$(Number$, 1)
        Number$ = RIGHT$(Number$, 2)
END IF

IF Buffer = "1" THEN Value# = Value# + (256 * 1)
IF Buffer = "2" THEN Value# = Value# + (256 * 2)
IF Buffer = "3" THEN Value# = Value# + (256 * 3)
IF Buffer = "4" THEN Value# = Value# + (256 * 4)
IF Buffer = "5" THEN Value# = Value# + (256 * 5)
IF Buffer = "6" THEN Value# = Value# + (256 * 6)
IF Buffer = "7" THEN Value# = Value# + (256 * 7)
IF Buffer = "8" THEN Value# = Value# + (256 * 8)
IF Buffer = "9" THEN Value# = Value# + (256 * 9)
IF Buffer = "A" THEN Value# = Value# + (256 * 10)
IF Buffer = "B" THEN Value# = Value# + (256 * 11)
IF Buffer = "C" THEN Value# = Value# + (256 * 12)
IF Buffer = "D" THEN Value# = Value# + (256 * 13)
IF Buffer = "E" THEN Value# = Value# + (256 * 14)
IF Buffer = "F" THEN Value# = Value# + (256 * 15)
Buffer = ""

IF LEN(Number$) = 2 THEN
        Buffer = LEFT$(Number$, 1)
        Number$ = RIGHT$(Number$, 1)
END IF

IF Buffer = "1" THEN Value# = Value# + (16 * 1)
IF Buffer = "2" THEN Value# = Value# + (16 * 2)
IF Buffer = "3" THEN Value# = Value# + (16 * 3)
IF Buffer = "4" THEN Value# = Value# + (16 * 4)
IF Buffer = "5" THEN Value# = Value# + (16 * 5)
IF Buffer = "6" THEN Value# = Value# + (16 * 6)
IF Buffer = "7" THEN Value# = Value# + (16 * 7)
IF Buffer = "8" THEN Value# = Value# + (16 * 8)
IF Buffer = "9" THEN Value# = Value# + (16 * 9)
IF Buffer = "A" THEN Value# = Value# + (16 * 10)
IF Buffer = "B" THEN Value# = Value# + (16 * 11)
IF Buffer = "C" THEN Value# = Value# + (16 * 12)
IF Buffer = "D" THEN Value# = Value# + (16 * 13)
IF Buffer = "E" THEN Value# = Value# + (16 * 14)
IF Buffer = "F" THEN Value# = Value# + (16 * 15)
Buffer = ""

IF LEN(Number$) = 1 THEN
        Buffer = LEFT$(Number$, 1)
END IF

IF Buffer = "1" THEN Value# = Value# + (1 * 1)
IF Buffer = "2" THEN Value# = Value# + (1 * 2)
IF Buffer = "3" THEN Value# = Value# + (1 * 3)
IF Buffer = "4" THEN Value# = Value# + (1 * 4)
IF Buffer = "5" THEN Value# = Value# + (1 * 5)
IF Buffer = "6" THEN Value# = Value# + (1 * 6)
IF Buffer = "7" THEN Value# = Value# + (1 * 7)
IF Buffer = "8" THEN Value# = Value# + (1 * 8)
IF Buffer = "9" THEN Value# = Value# + (1 * 9)
IF Buffer = "A" THEN Value# = Value# + (1 * 10)
IF Buffer = "B" THEN Value# = Value# + (1 * 11)
IF Buffer = "C" THEN Value# = Value# + (1 * 12)
IF Buffer = "D" THEN Value# = Value# + (1 * 13)
IF Buffer = "E" THEN Value# = Value# + (1 * 14)
IF Buffer = "F" THEN Value# = Value# + (1 * 15)
Buffer = ""

Hex2Dec = Value#
EXIT FUNCTION


END FUNCTION

FUNCTION Oct2Dec (OctNumber$)

IF LEN(LTRIM$(RTRIM$(OctNumber$))) > 8 THEN Value = 0: EXIT FUNCTION
IF INSTR(OctNumber$, "8") > 0 THEN Value = 0: EXIT FUNCTION
IF INSTR(OctNumber$, "9") > 0 THEN Value = 0: EXIT FUNCTION

Number = VAL(OctNumber$)

DO UNTIL Number <= 7777777
        Number = Number - 10000000
        Value = Value + 2097152
LOOP

DO UNTIL Number <= 777777
        Number = Number - 1000000
        Value = Value + 262144
LOOP

DO UNTIL Number <= 77777
        Number = Number - 100000
        Value = Value + 32768
LOOP

DO UNTIL Number <= 7777
        Number = Number - 10000
        Value = Value + 4096
LOOP

DO UNTIL Number <= 777
        Number = Number - 1000
        Value = Value + 512
LOOP

DO UNTIL Number <= 77
        Number = Number - 100
        Value = Value + 64
LOOP

DO UNTIL Number <= 7
        Number = Number - 10
        Value = Value + 8
LOOP

DO UNTIL Number <= 0
        Number = Number - 1
        Value = Value + 1
LOOP

Oct2Dec = Value

END FUNCTION

FUNCTION Pyt (A, B)

IF C = 0 THEN Pyt = SQR((A ^ 2) + (B ^ 2))

END FUNCTION

SUB Quad (A, B, C)

D = (B ^ 2) - (4 * A * C)

IF D < 0 THEN
        PRINT "There are no real roots.  Using the following default: "; : EXIT SUB
ELSE
        Quad1 = (-B + SQR(D)) / (2 * A)
        Quad2 = (-B - SQR(D)) / (2 * A)
END IF

END SUB

FUNCTION Reverse (Number)

Reverse = Number * -1

END FUNCTION

FUNCTION Round (Number)

Value$ = LTRIM$(RTRIM$(STR$(Number)))

Length = INSTR(Value$, ".")

Integer$ = LEFT$(Value$, Length - 1)
Extra$ = RIGHT$(Value$, Length - 1)

B = LEN(Extra$)

DO
        IF VAL(LEFT$(Extra$, 1)) >= 5 THEN Round = VAL(Integer$) + 1: EXIT FUNCTION
        IF VAL(LEFT$(Extra$, 1)) <= 3 THEN Round = VAL(Integer$): EXIT FUNCTION
        IF A = B THEN Round = VAL(Integer$): EXIT FUNCTION
        Extra$ = RIGHT$(Extra$, LEN(Extra$) - 1)
        A = A + 1
LOOP

END FUNCTION

FUNCTION XLog (X, Number)

XLog = LOG(Number) / LOG(X)

END FUNCTION

FUNCTION XRoot (X, Number)

        XRoot = Number ^ (1 / X)

END FUNCTION