Программа для работы с точечной графикой

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

.

Другое по теме:

• Delphi и графика
• Вывод надписи поверх всех окон
• Изменить режим копирования изображения