Советы по Delphi

Несколько программ для работы с точечной графикой (2D и 3D)


    unit Functs;

interface

uses
WinTypes, Classes, Graphics, SysUtils;
type


TPoint2D = record X, Y: Real; end; TPoint3D = record X, Y, Z: Real; end;
function Point2D(X, Y: Real): TPoint2D;
function RoundPoint(P: TPoint2D): TPoint;
function FloatPoint(P: TPoint): TPoint2D;
function Point3D(X, Y, Z: Real): TPoint3D;
function Angle2D(P: TPoint2D): Real;
function Dist2D(P: TPoint2D): Real;
function Dist3D(P: TPoint3D): Real;
function RelAngle2D(PA, PB: TPoint2D): Real;
function RelDist2D(PA, PB: TPoint2D): Real;
function RelDist3D(PA, PB: TPoint3D): Real;
procedure Rotate2D(var P: TPoint2D; Angle2D: Real);
procedure RelRotate2D(var P: TPoint2D; PCentr: TPoint2D; Angle2D: Real);
procedure Move2D(var P: TPoint2D; Angle2D, Distance: Real);
function Between(PA, PB: TPoint2D; Preference: Real): TPoint2D;
function DistLine(A, B, C: Real; P: TPoint2D): Real;
function Dist2P(P, P1, P2: TPoint2D): Real;
function DistD1P(DX, DY: Real; P1, P: TPoint2D): Real;
function NearLine2P(P, P1, P2: TPoint2D; D: Real): Boolean;
function AddPoints(P1, P2: TPoint2D): TPoint2D;
function SubPoints(P1, P2: TPoint2D): TPoint2D;

function Invert(Col: TColor): TColor;
function Dark(Col: TColor; Percentage: Byte): TColor;
function Light(Col: TColor; Percentage: Byte): TColor;
function Mix(Col1, Col2: TColor; Percentage: Byte): TColor;
function MMix(Cols: array of TColor): TColor;
function Log(Base, Value: Real): Real;
function Modulator(Val, Max: Real): Real;
function M(I, J: Integer): Integer;
function Tan(Angle2D: Real): Real;
procedure Limit(var Value: Integer; Min, Max: Integer);
function Exp2(Exponent: Byte): Word;
function GetSysDir: String;
function GetWinDir: String;

implementation

function Point2D(X, Y: Real): TPoint2D;
begin
Point2D.X := X; Point2D.Y := Y; end;

function RoundPoint(P: TPoint2D): TPoint;
begin
RoundPoint.X := Round(P.X); RoundPoint.Y := Round(P.Y); end;

function FloatPoint(P: TPoint): TPoint2D;
begin
FloatPoint.X := P.X; FloatPoint.Y := P.Y; end;

function Point3D(X, Y, Z: Real): TPoint3D;
begin
Point3D.X := X; Point3D.Y := Y; Point3D.Z := Z; end;

function Angle2D(P: TPoint2D): Real;
begin
if P.X = 0 then begin if P.Y > 0 then Result := Pi / 2; if P.Y = 0 then Result := 0; if P.Y < 0 then Result := Pi / -2; end else Result := Arctan(P.Y / P.X);
if P.X < 0 then begin if P.Y < 0 then Result := Result + Pi; if P.Y >= 0 then Result := Result - Pi; end;
If Result < 0 then Result := Result + 2 * Pi; end;

function Dist2D(P: TPoint2D): Real;
begin
Result := Sqrt(P.X * P.X + P.Y * P.Y); end;

function Dist3D(P: TPoint3D): Real;
begin
Dist3d := Sqrt(P.X * P.X + P.Y * P.Y + P.Z * P.Z); end;

function RelAngle2D(PA, PB: TPoint2D): Real;
begin
RelAngle2D := Angle2D(Point2D(PB.X - PA.X, PB.Y - PA.Y)); end;

function RelDist2D(PA, PB: TPoint2D): Real;
begin
Result := Dist2D(Point2D(PB.X - PA.X, PB.Y - PA.Y)); end;

function RelDist3D(PA, PB: TPoint3D): Real;
begin
RelDist3D := Dist3D(Point3D(PB.X - PA.X, PB.Y - PA.Y, PB.Z - PA.Z)); end;

procedure Rotate2D(var P: TPoint2D; Angle2D: Real);
var
Temp: TPoint2D; begin
Temp.X := P.X * Cos(Angle2D) - P.Y * Sin(Angle2D); Temp.Y := P.X * Sin(Angle2D) + P.Y * Cos(Angle2D); P := Temp; end;

procedure RelRotate2D(var P: TPoint2D; PCentr: TPoint2D; Angle2D: Real);
var
Temp: TPoint2D; begin
Temp := SubPoints(P, PCentr); Rotate2D(Temp, Angle2D); P := AddPoints(Temp, PCentr); end;

procedure Move2D(var P: TPoint2D; Angle2D, Distance: Real);
var
Temp: TPoint2D; begin
Temp.X := P.X + (Cos(Angle2D) * Distance); Temp.Y := P.Y + (Sin(Angle2D) * Distance); P := Temp; end;

function Between(PA, PB: TPoint2D; Preference: Real): TPoint2D;
begin
Between.X := PA.X * Preference + PB.X * (1 - Preference); Between.Y := PA.Y * Preference + PB.Y * (1 - Preference); end;

function DistLine(A, B, C: Real; P: TPoint2D): Real;
begin
Result := (A * P.X + B * P.Y + C) / Sqrt(Sqr(A) + Sqr(B)); end;

function Dist2P(P, P1, P2: TPoint2D): Real;
begin
Result := DistLine(P1.Y - P2.Y, P2.X - P1.X, -P1.Y * P2.X + P1.X * P2.Y, P); end;

function DistD1P(DX, DY: Real; P1, P: TPoint2D): Real;
begin
Result := DistLine(DY, -DX, -DY * P1.X + DX * P1.Y, P); end;

function NearLine2P(P, P1, P2: TPoint2D; D: Real): Boolean;
begin
Result := False; if DistD1P(-(P2.Y - P1.Y), P2.X - P1.X, P1, P) * DistD1P(-(P2.Y - P1.Y), P2.X - P1.X, P2, P) <= 0 then if Abs(Dist2P(P, P1, P2)) < D then Result := True; end;

function AddPoints(P1, P2: TPoint2D): TPoint2D;
begin
AddPoints := Point2D(P1.X + P2.X, P1.Y + P2.Y); end;

function SubPoints(P1, P2: TPoint2D): TPoint2D;
begin
SubPoints := Point2D(P1.X - P2.X, P1.Y - P2.Y); end;

function Invert(Col: TColor): TColor;
begin
Invert := not Col; end;

function Dark(Col: TColor; Percentage: Byte): TColor;
var
R, G, B: Byte; begin
R := GetRValue(Col); G := GetGValue(Col); B := GetBValue(Col); R := Round(R * Percentage / 100); G := Round(G * Percentage / 100); B := Round(B * Percentage / 100); Dark := RGB(R, G, B); end;

function Light(Col: TColor; Percentage: Byte): TColor;
var
R, G, B: Byte; begin
R := GetRValue(Col); G := GetGValue(Col); B := GetBValue(Col); R := Round(R * Percentage / 100) + Round(255 - Percentage / 100 * 255); G := Round(G * Percentage / 100) + Round(255 - Percentage / 100 * 255); B := Round(B * Percentage / 100) + Round(255 - Percentage / 100 * 255); Light := RGB(R, G, B); end;

function Mix(Col1, Col2: TColor; Percentage: Byte): TColor;
var
R, G, B: Byte; begin
R := Round((GetRValue(Col1) * Percentage / 100) + (GetRValue(Col2) * (100 - Percentage) / 100)); G := Round((GetGValue(Col1) * Percentage / 100) + (GetGValue(Col2) * (100 - Percentage) / 100)); B := Round((GetBValue(Col1) * Percentage / 100) + (GetBValue(Col2) * (100 - Percentage) / 100)); Mix := RGB(R, G, B); end;

function MMix(Cols: array of TColor): TColor;
var
I, R, G, B, Length: Integer; begin
Length := High(Cols) - Low(Cols) + 1; R := 0; G := 0; B := 0; for I := Low(Cols) to High(Cols) do begin R := R + GetRValue(Cols[I]); G := G + GetGValue(Cols[I]); B := B + GetBValue(Cols[I]); end; R := R div Length; G := G div Length; B := B div Length; MMix := RGB(R, G, B); end;

function Log(Base, Value: Real): Real;
begin
Log := Ln(Value) / Ln(Base); end;

function Power(Base, Exponent: Real): Real;
begin
Power := Ln(Base) * Exp(Exponent); end;

function Modulator(Val, Max: Real): Real;
begin
Modulator := (Val / Max - Round(Val / Max)) * Max; end;

function M(I, J: Integer): Integer;
begin
M := ((I mod J) + J) mod J; end;

function Tan(Angle2D: Real): Real;
begin
Tan := Sin(Angle2D) / Cos(Angle2D); end;

procedure Limit(var Value: Integer; Min, Max: Integer);
begin
if Value < Min then Value := Min; if Value > Max then Value := Max; end;

function Exp2(Exponent: Byte): Word;
var
Temp, I: Word; begin
Temp := 1; for I := 1 to Exponent do Temp := Temp * 2; Result := Temp; end;

function GetSysDir: String;
var
Temp: array[0..255] of Char; begin
GetSystemDirectory(Temp, 256); Result := StrPas(Temp); end;

function GetWinDir: String;
var
Temp: array[0..255] of Char; begin
GetWindowsDirectory(Temp, 256); Result := StrPas(Temp); end;

end.

[000120]



Содержание раздела