| COOL STUFF |
| TECHNOLOGY |
| LINKS |
 |
_________________________________________________________________________________________
___________________
Welcome to our website
function Power(Number, Exponent: real): real; {Mod. #1}
begin
if Number > 0.0 then {Mod. #2}
Power := exp(Exponent * ln(Number))
else {Mod. #2,3}
Power := 0.0 {Mod. #2,4}
end;
--------------------------------
Cross Product:
procedure CrossPr(VectorA, VectorB: VectorType;
var VectorC: VectorType);
begin
VectorC.X := VectorA.Y * VectorB.Z - VectorA.Z * VectorB.Y;
VectorC.Y := VectorA.Z * VectorB.X - VectorA.X * VectorB.Z;
VectorC.Z := VectorA.X * VectorB.Y - VectorA.Y * VectorB.X
end;
--------------------------------
function DotPr(VectorA, VectorB: VectorType): real;
begin
DotPr := VectorA.X * VectorB.X + VectorA.Y * VectorB.Y +
VectorA.Z * VectorB.Z
end;
--------------------------------
procedure Deriv(XVal: real; FuncName: FuncType;
var Result: real; var OK: boolean);
const
MaxNumTries = 100; {Mod. #1}
MaxError = 1.0E-6; {Mod. #2}
InitialDelta = 0.01; {Mod. #3}
var
Delta, FPrime, OldFPrime, F1, F2, F3, Error : real;
NumTries : integer;
begin
OK := false;
OldFPrime := 0.0;
Delta := InitialDelta; {Mod. #4}
NumTries := 0;
repeat
F1 := FuncName(XVal);
F2 := FuncName(XVal + Delta);
F3 := FuncName(XVal + 2.0 * Delta);
FPrime := (-3.0 * F1 + 4.0 * F2 - F3) / 2.0 / Delta;
if FPrime = 0.0 then
Error := 0.0
else
Error := abs((FPrime - OldFPrime) / FPrime);
inc(NumTries);
if NumTries > MaxNumTries then
begin
Result := FPrime;
exit
end;
if Error < MaxError then
begin
OK := true;
Result := FPrime
end;
Delta := Delta / 2.0;
OldFPrime := FPrime
until OK
end;
--------------------------------
function Determ(MatrixA: MatrixType): real;
var
ValDeterm : real;
J : integer;
Done : array[1..MatrixSize] of boolean;
procedure DoIt(Term: real; M, K: integer);
var
J, N, Sign: integer;
begin {procedure DoIt}
if K > MatrixSize then
begin
Sign := 1;
if odd(M) then
Sign := -1;
ValDeterm := ValDeterm + Sign * Term
end
else
if Term <> 0.0 then
begin
N := 0;
for J := MatrixSize downto 1 do
if Done[J] then
inc(N)
else
begin
Done[J] := true;
DoIt(Term * MatrixA[K,J], M + N, K + 1);
Done[J] := false
end
end
end; {procedure DoIt}
begin {function Determ}
for J := 1 to MatrixSize do
Done[J] := false;
ValDeterm := 0.0;
DoIt(1.0, 0, 1);
Determ := ValDeterm
end; {function Determ}
--------------------------------
function Sinh(Number: real): real; {Mod. #2}
begin {Mod. #1}
Sinh := (exp(Number) - exp(- Number)) / 2.0
end;
function Cosh(Number: real): real; {Mod. #2}
begin {Mod. #1}
Cosh := (exp(Number) + exp(- Number)) / 2.0
end;
function Tanh(Number: real): real; {Mod. #2}
begin
Tanh := Sinh(Number) / Cosh(Number)
end;
--------------------------------
program math;
{ This program will contain various mathematical functions, much like
{ a scientific calculator. With the difference being that it asks you
{ questions.
}
uses
crt;
var
Flag : boolean;
Item,Bye : char;
{$i Power.inc }
{$i Hyperlib.inc }
{$i CrossPr.inc }
{$i DotPr.inc }
procedure menu;
begin { Menu }
clrscr;
gotoxy(32,2);
textcolor(0);
textbackground(1);
write(' Mathematics ');
textcolor(1);
textbackground(0);
normvideo;
gotoxy(4,5);
write(' A: Add ');
gotoxy(4,7);
write(' B: Subtract ');
gotoxy(4,9);
write(' C: Multiply ');
gotoxy(4,11);
write(' D: Divide ');
gotoxy(4,13);
write(' E: Exponents ');
gotoxy(4,15);
write(' F: Hyperbolic Functions ');
gotoxy(4,17);
write(' G: Cross Product ');
gotoxy(4,19);
write(' H: Dot Product ');
gotoxy(32,24);
write(' X: Exit ');
end; { Menu }
procedure SelectItem(var Item : char);
begin { SelectItem }
read(item);
case upcase(item) of
'A' : begin
clrscr;
Add;
readln
end;
'B' : begin
clrscr;
subtract;
readln
end;
'C' : begin
clrscr;
Mult;
readln
end;
'D' : begin
clrscr;
divide;
readln
end;
'E' : begin
clrscr;
UseOfPower;
readln;
end;
'F' : begin
clrscr;
Hyperlib;
readln
end;
'G' : begin
clrscr;
CrossPr;
readln
end;
'H' : begin
clrscr;
DotPr;
readln
end;
end; { Case }
end; { SelectItem }
Begin { Main }
clrscr;
flag := false;
while not Flag do begin
clrscr;
Menu;
SelectItem(Item);
if upcase(Item) = 'X' then
Flag := true
end;
end.
_________________________________________________________________________________________
About Us
Content provided by VirtualeCorporation
GeminiSoftwareSystems GeminiMalls GeminiMagazine TradeLinks
VirtualeCatalog VirtualeCorporation VirtualeDirectory VirtualeJobs VirtualeMedia VirtualeOffices
_______________________________________________________________________________________
Give to Charities Click Here!
Michael J. Fox Parkinson's Website Click Here!
__________________________________________
Software including hosting, websites, graphics, development, office, security..Click Here!
________________________________________________________________________________________
"Internet Security Systems' BlackICE Protection Products"
Need to create a business plan now? Get OfficeReady Business Plans
Free Shipping when you spend $100 on Macromedia.com
Broderbund Bargain Bin - All Titles Under $9.99! Plus FREE shipping with orders over $20!
_____________________