FAQ VCL
Математика

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как вычисить квадратный корень по алгоритму Ньютона?

// x - аргумент
// n - точность вычислений (лучше брать 7-8)
function TForm1.MySqrt(x: Double; n: Byte): Double;
var
  i: Integer;
begin
  if x <= 0 then
  begin
    Result := 0;
    Exit;
  end
  else 
    Result := 4;
  for i := 0 to n do
    Result := (Result + x / Result) / 2;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Form1.Caption := FloatToStr(MySqrt(81, 8));
end;


Как вычислить корень любой степени?

// x - аргумент
// n - степень корня
function TForm1.MySqrt(x, n: Double): Double;
begin
  if x <= 0 then
  begin
    Result := 0;
    Exit;
  end;
  Result := Exp(1 / n * Ln(x));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Form1.Caption := FloatToStr(MySqrt(64, 3));
end;


Как преобразовать Integer в BIN?

// Первый вариант функции IntToBin
function IntToBin(Value: Integer; Digits: Integer): string;
var 
  i: Integer; 
begin 
  Result := '';
  for i := 0 to Digits-1 do
  begin
    if Value and (1 shl i) > 0 then
      Result := '1' + Result
    else
      Result := '0' + Result;
  end;
end; 

// Второй вариант функции IntToBin
function IntToBin(Value: Integer; Digits: Integer): string;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to Digits-1 do
    Result := IntToStr((Value and (1 shl i) shr i)) + Result;
end;

// Третий вариант функции IntToBin
function IntToBin(Value: Integer; Digits: Integer): string;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to Digits-1 do
    Result := IntToStr((Value shr i) and 1) + Result;
end;

// Четвертый вариант функции IntToBin
function IntToBin(Value: Longint; Digits: Integer): string;
begin
  Result := '';
  while Digits > 0 do
  begin
    Dec(Digits);
    Result := Result + IntToStr((Value shr Digits) and 1);
  end;
end;

// Пятый вариант функции IntToBin
// NumBits может быть 64,32,16,8 для указания представления возвращаемого значения
// (Int64, DWord, Word или Byte), по умолчанию = 64
// Обычно NumBits требуется только для отрицательных входных значений
function IntToBin( IValue: Int64; NumBits: Word = 64): string;
var
  RetVar: string;
  i, ILen: Byte;
begin
  RetVar := '';

  case NumBits of
    32: IValue := DWORD(IValue);
    16: IValue := Word(IValue);
    8 : IValue := Byte(IValue);
  end;

  while IValue <> 0 do
  begin
    Retvar := Char(48 + (IValue and 1)) + RetVar;
    IValue := IValue shr 1;
  end;

  if RetVar = '' then
    Retvar := '0';
  Result := RetVar;
end;

// Вызов функции IntToBin
procedure TForm1.Button1Click(Sender: TObject);
const
  n = 140;
var
  i, k: Integer;
begin
  k := 1;
  for i := 1 to n do
  begin
    k := k * 2;
    if k > n then 
      Break;
  end;
  Caption := IntToBin(n, i);
end;


Как правильно округлять дробные числа?

// Способ первый
// Precision = 1 - округлить до целых
// Precision = 10 - округлить до десятых
// Precision = 100 - округлить до сотых, и т.д.
function RoundEx(X: Double; Precision: Integer): Double;
var
  ScaledFractPart, Temp: Double;
begin
  ScaledFractPart := Frac(X) * Precision;
  Temp := Frac(ScaledFractPart);
  ScaledFractPart := Int(ScaledFractPart);
  if Temp >= 0.5 then
    ScaledFractPart := ScaledFractPart + 1;
  if Temp <= -0.5 then
    ScaledFractPart := ScaledFractPart - 1;
  RoundEx := Int(X) + ScaledFractPart / Precision;
end;

// Способ второй
uses
  {...,} Math;

function SimpleRoundTo(const AValue: Extended; const ADigit: TRoundToRange = -2): Extended;
var
  LFactor: Extended;
begin
  LFactor := IntPower(10, ADigit);
  if AValue < 0 then
    Result := Trunc((AValue / LFactor) - 0.5) * LFactor
  else
    Result := Trunc((AValue / LFactor) + 0.5) * LFactor;
end;

// Способ третий
uses
  {...,} Math;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(RoundTo(4.70000001, -1).ToString);
end;


Как возвести число в степень?

uses
  {...,} Math;

procedure TForm1.Button1Click(Sender: TObject);
begin
  // В примере 5 возводится в степень 3
  ShowMessage(FloatToStr(Power(5, 3)));
end;


Как преобразовать HEX в Integer?

// Способ первый
function HexToInt(const Hex: string): Integer;

  function GetDigitValue(C: Char): Integer;
  begin
    case C of
      '0'..'9': Result := Ord(C) - 48;
      'A'..'F': Result := Ord(C) - 55;
      'a'..'f': Result := Ord(C) - 87;
    else
      Result := -1;
    end;
  end;

var
  i, Base, Digit: Integer;
begin
  Result := 0;
  Base := 1;
  for i := Length(Hex) downto 1 do
  begin
    Digit := GetDigitValue(Hex[i]);
    if Digit < 0 then
    begin
      ShowMessage('Есть символ, не являющийся шестнадцатеричной цифрой');
      Result := -1;
      Exit;
    end;
    Result := Result + Digit * Base;
    Base := Base * 16;
  end;
end;

// Способ второй
// Замечание: Последний символ может быть 'H' для Hex, т.е. '00123h' или '00123H'
// В случае неправильной HexString будет возвращён 0
function HexToInt(HexStr: string): Int64;
var
  RetVar: Int64;
  i: Byte;
begin
  HexStr := UpperCase(HexStr);
  if HexStr[Length(HexStr)] = 'H' then
    Delete(HexStr, Length(HexStr), 1);
  RetVar := 0;

  for i := 1 to Length(HexStr) do
  begin
    RetVar := RetVar shl 4;
    if HexStr[i] in ['0'..'9'] then
      RetVar := RetVar + (Byte(HexStr[i]) - 48)
    else
      if HexStr[i] in ['A'..'F'] then
         RetVar := RetVar + (Byte(HexStr[i]) - 55)
      else
      begin
         Retvar := 0;
         Break;
      end;
  end;

  Result := RetVar;
end;

// Способ третий
function HexToInt(HexStr: string): Integer;
var
  c: Integer;
begin
  Val('$'+HexStr, Result, c);
  if c > 0 then
    Result := -1;
end;

// Способ четвертый
function HexToInt(Value: string): Integer;
const
  HEX: array['A'..'F'] of Integer = (10, 11, 12, 13, 14, 15);
var
  vInt, i: Integer;
begin
  vInt := 0;
  for i := 1 To Length(Value) do
    if AnsiUpper(@Value[i]) < 'A' then
      vInt := vInt * 16 + Ord(Value[i]) - 48
    else
      vInt := vInt * 16 + HEX[Value[i]];
  Result := vInt;
end;


Как преобразовать BIN в Integer?

// Замечание: Последний символ может быть 'B' для Binary, т.е. '001011b' или '001011B'
// В случае неправильной бинарной строки будет возвращён 0
function BinToInt(BinStr: string): Int64;
var
  i: Byte;
  RetVar: Int64;
begin
  BinStr := UpperCase(BinStr);
  if BinStr[Length(BinStr)] = 'B' then
    Delete(BinStr, Length(BinStr), 1);
  RetVar := 0;
  for i := 1 to Length(BinStr) do
  begin
    if not (BinStr[i] in ['0', '1']) then
    begin
       RetVar := 0;
       Break;
    end;
    RetVar := (RetVar shl 1) + (Byte(BinStr[i]) and 1) ;
  end;

  Result := RetVar;
end;


Как умножать большие целые числа?

type
  IntNo = record
    Low32, Hi32: DWORD;
  end;

function Multiply(p, q: DWORD): IntNo;
var
  x: IntNo;
begin
  asm
    mov eax, [p]
    mul [q]
    mov [x.Low32], eax
    mov [x.Hi32], edx
  end;
  Result := x
end;


// Тестирование:
procedure TForm1.Button1Click(Sender: TObject);
var
  r: IntNo;
begin
  r := Multiply(40000000, 80000000);
  ShowMessage(IntToStr(r.Hi32) + ', ' + IntToStr(r.low32));
end;

// P.S.
// Однажды мне потребовалось сложить два числа типа IntNo, вот как это делается

function Add(p, q: IntNo): IntNo;
var
  x: IntNo;
begin
  asm
    mov eax, [p.Low32]
    mov edx, [p.Hi32]
    add eax, [q.Low32]
    adc edx, [q.Hi32]
    mov [x.Low32], eax
    mov [x.Hi32], edx
  end;
  Result := x
end;


Как округлить число до ближайшего меньшего целого?

uses
  {...,} Math;

procedure TForm1.Button1Click(Sender: TObject);
var
  x: Integer;
begin
  x := Floor(2.5); // x = 2
  x := Floor(-2.5); // x = -3
end;


Как вычислить центр вписанной в треугольник окружности?

// P1, P2, P3 - вершины треугольника
function CenterCircleInTriang(const P1, P2, P3: TPoint): TPoint;

  function LineLength(P1, P2: TPoint): Double;
  begin
    Result := Sqrt(Sqr(P1.X - P2.X) + Sqr(P1.Y - P2.Y));
  end;

var
  a, b, c, Perim: Double;
begin
  a := LineLength(P1, P2);
  b := LineLength(P2, P3);
  c := LineLength(P3, P1);
  Perim := 1 / (a + b + c);
  Result := Point(Round((b * P1.X + c * P2.X + a * P3.X) * Perim),
                  Round((b * P1.Y + c * P2.Y + a * P3.Y) * Perim));
end;

// Пример использования:

{ Расстояние от точки P до прямой P1-P2 }
function Distance( const P, P1, P2: TPoint ): Integer;
begin
  Result := Abs(Round(((P1.Y - P2.Y) * P.X + (P2.X - P1.X) * P.Y +
            (P1.X * P2.Y - P2.X * P1.Y)) / Sqrt(Sqr(P1.X - P2.X) + Sqr(P2.Y - P1.Y))));
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  P1, P2, P3, C: TPoint;
  L: Integer;
begin
  P1 := Point(60, 160);
  P2 := Point(250, 110);
  P3 := Point(365, 350);
  C := CenterCircleInTriang(P1, P2, P3);
  L := Distance(C, P1, P2);
  with Canvas do
  begin
    Brush.Color := clWhite;
    Polygon([P1, P2, P3]);
    Brush.Color := clRed;
    Ellipse(C.X - L, C.Y - L, C.X + L, C.Y + L);
  end;
end;

При использовании материала - ссылка на сайт обязательна