malfunction
Grandmaster Cheater Supreme
 Reputation: 0
Joined: 30 Jan 2007
Posts: 1015
Location: http://www.behindthecorner.com/
|
 Posted: Mon Feb 25, 2008 1:09 pm Post subject: [DELPHI] Some codes to find mathematic related stuff |
 |
|
Here are some codes we have been working with in the University:
Feel free to use them in whatever you want...
Determine The circumcenter of 3 points
| Code: | procedure Circumcenter(const x1, y1, x2, y2, x3, y3: Double; out Px, Py: Double);
var
A: Double;
C: Double;
B: Double;
D: Double;
E: Double;
F: Double;
G: Double;
begin
A := x2 - x1;
B := y2 - y1;
C := x3 - x1;
D := y3 - y1;
E := A * (x1 + x2) + B * (y1 + y2);
F := C * (x1 + x3) + D * (y1 + y3);
G := 2.0 * (A * (y3 - y2) - B * (x3 - x2));
if IsEqual(G, 0.0) then Exit;
Px := (D * E - B * F) / G;
Py := (A * F - C * E) / G;
end; |
Determine if a 2D point exists within a 2D triangle
| Code: | function PntInTriangle(Px, Py, x1, y1, x2, y2, x3, y3: Double): Boolean;
var
Or1, Or2, Or3: Double;
begin
Or1 := Orientation(x1, y1, x2, y2, Px, Py);
Or2 := Orientation(x2, y2, x3, y3, Px, Py);
Or3 := Orientation(x3, y3, x1, y1, Px, Py);
Result := (Or1 = Or2) and (Or2 = Or3);
end;
function Orientation(x1, y1, x2, y2, Px, Py: Double): Integer;
var
Orin: Double;
begin
Orin := (x2 - x1) * (py - y1) - (px - x1) * (y2 - y1);
if Orin > 0.0 then Result := +1
else if Orin < 0.0 then Result := -1
else
Result := 0;
end; |
Determine the circum-center of a 2D triangle
| Code: | procedure Circumcenter(x1, y1, x2, y2, x3, y3: Double; var Px, Py: Double);
var
A, C, B, D, E, F, G: Double;
begin
A := x2 - x1;
B := y2 - y1;
C := x3 - x1;
D := y3 - y1;
E := A * (x1 + x2) + B * (y1 + y3);
F := C * (x1 + x2) + D * (y1 + y3);
G := 2.0 * (A * (y3 - y2) - B * (x3 - x2));
if G = 0 then
Exit;
Px := (D * E - B * F) / G;
Py := (A * F - C * E) / G;
end; |
Calculate the age of a person
| Code: | function CalculateAge(Birthday, CurrentDate: TDate): Integer;
var
Month, Day, Year, CurrentYear, CurrentMonth, CurrentDay: Word;
begin
DecodeDate(Birthday, Year, Month, Day);
DecodeDate(CurrentDate, CurrentYear, CurrentMonth, CurrentDay);
if (Year = CurrentYear) and (Month = CurrentMonth) and (Day = CurrentDay) then
begin
Result := 0;
end
else
begin
Result := CurrentYear - Year;
if (Month > CurrentMonth) then
Dec(Result)
else
begin
if Month = CurrentMonth then
if (Day > CurrentDay) then
Dec(Result);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption := Format('Your age is %d', [CalculateAge(StrToDate('01.03.1953'), Date)]);
end; |
Convert a decimal number to roman numerals
| Code: | function DecToRoman(Decimal: Longint): string;
const
Numbers: array[1..13] of Integer =
(1, 4, 5, 9, 10, 40, 50, 90, 100,
400, 500, 900, 1000);
Romans: array[1..13] of string =
('I', 'IV', 'V', 'IX', 'X', 'XL',
'L', 'XC', 'C', 'CD', 'D', 'CM', 'M');
var
i: Integer;
begin
Result := '';
for i := 13 downto 1 do
while (Decimal >= Numbers[i]) do
begin
Decimal := Decimal - Numbers[i];
Result := Result + Romans[i];
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
label1.Caption := DecToRoman(5);
Label2.Caption := DecToRoman(458);
end; |
Convert an octal number to integer
| Code: | function OctToInt(Value: string): Longint;
var
i: Integer;
int: Integer;
begin
int := 0;
for i := 1 to Length(Value) do
begin
int := int * 8 + StrToInt(Copy(Value, i, 1));
end;
Result := int;
end; |
Convert an Integer to an octal number
| Code: | function IntToOct(Value: Longint; digits: Integer): string;
var
rest: Longint;
oct: string;
i: Integer;
begin
oct := '';
while Value <> 0 do
begin
rest := Value mod 8;
Value := Value div 8;
oct := IntToStr(rest) + oct;
end;
for i := Length(oct) + 1 to digits do
oct := '0' + oct;
Result := oct;
end; |
_________________
|
|
FAQ
Search
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
Reputation: 205
