|
:: 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;
|
Как вычислить центр вписанной в треугольник окружности?
// 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;
|
|
При использовании материала - ссылка на сайт обязательна
|
|
