Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Программа для работы с точечной графикой

Я yгадаю этy пpогpаммy с 7 байт!


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 World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.