Здесь представлены новые функции, созданные на языке Паскаль, которые могут пригодиться при написании своих программ.

Числовое значение математических выражений

Здесь для работы необходим модуль (файл) http://newerow1989.narod.ru/FunctionString.pas. В этом модуле рассмотрены следующие функции:

function FunctionToReal(s: string): real;
function FunctionToString(s: string): string;
function MsgError: string;

где
s - исходное строковое выражение, записанное с помощью математических операций, формул и т.д.

Функция FunctionToReal вычисляет готовое численное выражение, записанное в виде десятичной дроби (вещественного числа).
Функция FunctionToString вычисляет готовое численное выражение, записанное в виде строки.
Функция MsgError выдает ошибку в выражении.

Например, FunctionToReal('(6+4)*(.85-7.1)-2/5.') выведет '-62,9'; FunctionToString('-LogN(11,-Round(-121.47))') выведет '-2'; FunctionToString('Sqrt(-3)') выведет 'Корень отрицательного числа -3 не существует'.

Примечание 1. Для ввода десятичных чисел используется точка, так как выражения строятся по правилам языка Паскаль.
Примечание 2. Рекомендуется использовать функцию FunctionToString, так как она обладает еще дополнительной опцией: вывод ошибки.



Запись числа прописью

function ChisloPropis(n: int64): string;
const Chislo1000: array[1..6, 0..2] of string = (('тысяча', 'тысячи', 'тысяч'),
         ('миллион', 'миллиона', 'миллионов'),
         ('миллиард', 'миллиарда', 'миллиардов'),
         ('триллион', 'триллиона', 'триллионов'),
         ('квадриллион', 'квадриллиона', 'квадриллионов'),
         ('квинтиллион', 'квинтиллиона', 'квинтиллионов'));
      Chislo100: array[1..9] of string = ('сто', 'двести', 'триста',
         'четыреста', 'пятьсот', 'шестьсот', 'семьсот', 'восемьсот',
         'девятьсот');
      Chislo10: array[2..9] of string = ('двадцать', 'тридцать', 'сорок',
         'пятьдесят', 'шестьдесят', 'семьдесят', 'восемьдесят', 'девяносто');
      Chislo1: array[0..19] of string = ('ноль', 'один', 'два', 'три', 'четыре',
         'пять', 'шесть', 'семь', 'восемь', 'девять', 'десять', 'одиннадцать',
         'двенадцать', 'тринадцать', 'четырнадцать', 'пятнадцать',
         'шестнадцать', 'семнадцать', 'восемнадцать', 'девятнадцать');
      Chislo1_2: array[1..2] of string = ('одна', 'две');
var n1000: byte;
    s, znak: string;

   function Length3(a, n1000: integer): string;
   var b: byte;
       s: string;
   begin
      a:=a mod 1000; //для защиты
      b:=a div 100;
      a:=a mod 100;
      If b>0 then
         Result:=Chislo100[b] else
         Result:='';
      If (a>0) and (Result<>'') then
         Result:=Result+' ';
      If a>=20 then
      begin
         b:=a div 10;
         a:=a mod 10;
         If b>0 then
            Result:=Result+Chislo10[b];
         If a>0 then
         begin
            If Result<>'' then
               Result:=Result+' ';
            s:=Chislo1[a]; //два миллиона
            If (n1000=1) and (a>=1) and (a<=2) then //один или одна (два или две)
               s:=Chislo1_2[a]; //две тысячи
            Result:=Result+s;
         end;
      end else
         If a>0 then
         begin
            s:=Chislo1[a]; //два миллиона
            If (n1000=1) and (a>=1) and (a<=2) then //один или одна (два или две)
               s:=Chislo1_2[a]; //две тысячи
            Result:=Result+s;
         end;
      If (n1000>0) and (Result<>'') then
      begin
         Result:=Result+' ';
         If n1000>High(Chislo1000) then
         begin
            Result:=Format('%s(x 10^%d)', [Result, 3*n1000]);
            Exit;
         end;
         s:=Chislo1000[n1000, 2];
         If a=1 then
            s:=Chislo1000[n1000, 0];
         If (a>=2) and (a<=4) then
            s:=Chislo1000[n1000, 1];
         Result:=Result+s;
      end;
   end;

begin
   Result:='';
   If n<0 then
      znak:='минус ' else
      znak:='';
   n:=Abs(n);
   n1000:=0;
   While n>0 do
   begin
      s:=Length3(n mod 1000, n1000);
      Inc(n1000);
      If s<>'' then
      begin
         If Result<>'' then
            Result:=' '+Result;
         Result:=s+Result;
      end;
      n:=n div 1000;
   end;
   Result:=znak+Result;
   If Result='' then
      Result:=Chislo1[0];
end;

где
n - исходное число.

Например, ChisloPropis(0) выведет 'ноль'; ChisloPropis(-2000) выведет 'минус две тысячи'; ChisloPropis(2000000) выведет 'два миллиона'; ChisloPropis(974012500000641000) выведет 'девятьсот семьдесят четыре квадриллиона двенадцать триллионов пятьсот миллиардов шестьсот сорок одна тысяча'; ChisloPropis(High(Int64)) выведет 'девять квинтиллионов двести двадцать три квадриллиона триста семьдесят два триллиона тридцать шесть миллиардов восемьсот пятьдесят четыре миллиона семьсот семьдесят пять тысяч восемьсот семь'.



Сложение обыкновенных дробей

1. Общий знаменатель дроби

function DrobObschijZnamenatel(a, b: integer): integer;
var z: integer;
begin
   If a>b then
   begin
      z:=a;
      a:=b;
      b:=z;
   end;
   Result:=b;
   While Result mod a<>0 do
      Result:=Result+b;
end;

где
a - знаменатель первой дроби;
b - знаменатель второй дроби.

Например, DrobObschijZnamenatel(6, 8) выведет '24'.

2. Сложение обыкновенных дробей

function DrobSlozhenie(a1, b1, a2, b2: integer; var a, b: integer): real;
var i, m: integer;
begin
   b:=DrobObschijZnamenatel(b1, b2);
   a1:=b div b1 * a1;
   a2:=b div b2 * a2;
   a:=a1+a2;
   If a<b then
      m:=Abs(a) else
      m:=Abs(b);
   For i:=m downto 2 do
      If (a mod i = 0) and (b mod i = 0) then
      begin
         a:=a div i;
         b:=b div i;
         Break;
      end;
   Result:=a/b;
end;

где
a1, b1 - числитель и знаменатель первой дроби;
a2, b2 - числитель и знаменатель второй дроби;
a, b - числитель и знаменатель полученной дроби.

Например, DrobSlozhenie(1, 6, 3, 10, a, b) выведет '0,466666666666667', а = '7', b = '15'; DrobSlozhenie(1, 6, -3, 10, a, b) выведет '-0,133333333333333', а = '-2', b = '15'.



Автоматический перевод единиц измерения числа, выраженные в байтах, в кило-, мега-, гигабайты

function BaitAutoToKMGb(bait: int64; kol_wo_znak, edinitsa_izmereniya: byte): string;
var do_zpt: byte;
    r: extended;
    s: string;
begin
   r:=bait;
   s:='';
   Case edinitsa_izmereniya of
   1: s:='б';
   2: s:='бит';
   3: s:='Б';
   4: s:='байт';
   end;
   If bait>=1E3 then
   begin
      r:=bait/1024;
      Case edinitsa_izmereniya of
      1: s:='Кб';
      2: s:='Кбит';
      3: s:='КБ';
      4: s:='Кбайт';
      end;
   end;
   If bait>=1E6 then
   begin
      r:=bait/1024/1024;
      Case edinitsa_izmereniya of
      1: s:='Мб';
      2: s:='Мбит';
      3: s:='МБ';
      4: s:='Мбайт';
      end;
   end;
   If bait>=1E9 then
   begin
      r:=bait/1024/1024/1024;
      Case edinitsa_izmereniya of
      1: s:='Гб';
      2: s:='Гбит';
      3: s:='ГБ';
      4: s:='Гбайт';
      end;
   end;
   do_zpt:=Length(IntToStr(Trunc(r)));
   If do_zpt>=kol_wo_znak then
      kol_wo_znak:=do_zpt+1;
   Result:=Format('%*.*f', [do_zpt, kol_wo_znak-do_zpt-1, r]);
   If s<>'' then
      Result:=Result+' '+s;
end;

где
bait - исходное число;
kol_wo_znak - минимальное количество символов, выводимых в строке (запятая включается в количество знаков десятичного числа!);
edinitsa_izmereniya - формат единицы измерения, значения которых даны ниже:
0 - без единиц измерения,
1 - биты сокращенно (б, Кб, Мб, Гб),
2 - биты полностью (бит, Кбит, Мбит, Гбит),
3 - байты сокращенно (Б, КБ, МБ, ГБ),
4 - байты полностью (байт, Кбайт, Мбайт, Гбайт).

Например, BaitAutoToKMGb(58423695412, 5, 4) выведет '54,41 Гбайт'.



Запись числа по разрядам

function IntToStrRazryad(n: string): string;
var i: integer;
begin
   i:=Length(n)-2;
   While i>1 do
   begin
      Insert(' ', n, i);
      i:=i-3;
   end;
   Result:=n;
end;

где
n - исходное число.

Например, IntToStrRazryad('21489248288223') выведет '21 489 248 288 223'.



Формат процента

function ProcentFormat(r: real; kol_wo_znak: integer): string;
var do_zpt: integer;
begin
   do_zpt:=Length(IntToStr(Trunc(r)));
   If do_zpt>=kol_wo_znak then
      kol_wo_znak:=do_zpt+1;
   Result:=Format('%*.*f%%', [do_zpt, kol_wo_znak-do_zpt-1, r]);
end;

где
r - исходное число;
kol_wo_znak - минимальное количество символов, выводимых в строке (запятая включается в количество знаков десятичного числа!).

Например, ProcentFormat(38.5255, 5) выведет '38,53%'.



Склонение существительных по числу

function SklonenieSuschestwitelnyh(n: int64; kol_wo_1, kol_wo_234, kol_wo_5: string): string;
begin
   Result:=IntToStr(n)+' '+kol_wo_5;
   If n mod 10=1 then
      Result:=IntToStr(n)+' '+kol_wo_1;
   If (n mod 10>=2) and (n mod 10<=4) then
      Result:=IntToStr(n)+' '+kol_wo_234;
   If (n mod 100>=11) and (n mod 100<=14) then
      Result:=IntToStr(n)+' '+kol_wo_5;
end;

где
n - число (количество чего-либо);
kol_wo_1 - существительное в единственном числе;
kol_wo_234, kol_wo_5 - существительные во множественном числе.

Например, SklonenieSuschestwitelnyh(3, 'копейка', 'копейки', 'копеек') выведет '3 копейки'.



Максимальное и минимальное число в массиве

1. Максимальное число в массиве

function Max(p: array of integer): integer;
var i: integer;
begin
   Result:=p[Low(p)];
   For i:=Low(p)+1 to High(p) do
      If Result<p[i] then
         Result:=p[i];
end;

где
p - массив из целых чисел.

Например, Max([6, 3, 8, 7, 4, 5]) выведет '8'.

2. Минимальное число в массиве

function Min(p: array of integer): integer;
var i: integer;
begin
   Result:=p[Low(p)];
   For i:=Low(p)+1 to High(p) do
      If Result>p[i] then
         Result:=p[i];
end;

где
p - массив из целых чисел.

Например, Min([6, 3, 8, 7, 4, 5]) выведет '3'.

Примечание. Допускается использовать не только целочисленные числа, но и вещественные (десятичные, дробные). В этом случае integer заменяют на real:
function Max(p: array of real): real;
function Min(p: array of real): real;
Текст программного кода остается неизменным.



Среднее значение массива

function SredneeZnachenie(p: array of integer): real;
var i: integer;
begin
   Result:=0;
   For i:=Low(p) to High(p) do
      Result:=Result+p[i];
   Result:=Result/(1+High(p)-Low(p));
end;

где
p - массив из целых чисел.

Например, SredneeZnachenie([5, 2, 6, 7, 1]) выведет '4,2'.



Принадлежность числа массиву и диапазону

1. Принадлежность числа массиву

function Prinadlezhit(n: integer; p: array of integer): boolean;
var i: integer;
begin
   Result:=false;
   For i:=Low(p) to High(p) do
      If n=p[i] then
         Result:=true;
end;

где
n - искомое число;
p - массив из целых чисел.

Например, Prinadlezhit(3, [1, 5, 8, 6]) выведет отрицательное значение.

Примечание. Допускается использовать не только целочисленные числа, но и вещественные (десятичные, дробные), а также строковые значения. В этом случае integer заменяют на real, string:
function Prinadlezhit(n: real; p: array of real): boolean;
function Prinadlezhit(n: string; p: array of string): boolean;
Текст программного кода остается неизменным.

2. Принадлежность числа диапазону

function PrinadlezhitDiapazon(n: integer; diapazons: string): boolean;
var i, n1, n2: integer;
    c: char;
    s: string;
begin
   Result:=false;
   If diapazons='' then
      Exit;
   For i:=Length(diapazons) downto 1 do
      If diapazons[i]=' ' then
         Delete(diapazons, i, 1);
   s:='';
   c:=',';
   n1:=1;
   For i:=1 to Length(diapazons)+1 do
   begin
      If (i=Length(diapazons)+1) or (diapazons[i]=',') then
      begin
         n2:=StrToInt(s);
         If c=',' then
            n1:=n2;
         If (n1<=n) and (n<=n2) then
         begin
            Result:=true;
            Exit;
         end;
         s:='';
         c:=',';
      end else
      If diapazons[i]='-' then
      begin
         n1:=StrToInt(s);
         c:='-';
         s:='';
      end else
         s:=s+diapazons[i];
   end;
end;

где
n - искомое число;
diapazons - диапазон чисел.
Например, PrinadlezhitDiapazon(6, '1,3,5-7,10') выведет положительное значение; PrinadlezhitDiapazonB(6, '3-5,7') выведет отрицательное значение.

Примечание. В параметре diapazons допускается писать пробелы (например, '8, 12-15, 20').



Перевод чисел из одних систем счисления в другие

1. Определение кода числа системы счисления

function Kod_chisla_system(cifra: integer): char;
begin
   Result:='0';
   If (cifra>=0) and (cifra<=9) then
      Result:=Char(48+cifra);
   If (cifra>=10) and (cifra<=35) then
      Result:=Char(55+cifra);
end;

где
cifra - цифра от 0 до 35.

Например, Kod_chisla_system(2) выведет '2'; Kod_chisla_system(14) выведет 'E' (в шестнадцатеричной системе счисления).

Примечание 1. Вспомогательная функция Kod_chisla_system предназначена для нижеуказанных функций.
Примечание 2. В настоящее время существуют 16-ричные системы счисления, однако автор решил пофантазировать и расширил весь латинский алфавит. Поэтому не стоит удивляться, если при вызове функции Kod_chisla_system(35) выведет 'Z'. Но может в дальнейшем "изобретут" 32-ричные системы счисления, 36-ричные и т.д.

2. Перевод целого числа из одной системы счисления в любую другую (общий случай)

function Perewod_iz_n_w_m(chislo: string; iz_n, w_m: integer): string;
var i, k, step: integer;
    chislo_10: int64;
    s: char;
    z: -1..1;
begin
   Result:='';
   { проверка основания системы счисления }
   If (iz_n<2) or (iz_n>36) or (w_m<2) or (w_m>36) then
      Exit;
   { проверка на отрицательные числа }
   If (chislo<>'') and (chislo[1]='-') then
   begin
      z:=-1;
      Delete(chislo, 1, 1);
   end else
      z:=1;
   { перевод в десятичное число }
   step:=1;
   chislo_10:=0;
   For i:=Length(chislo) downto 1 do
   begin                                    
      s:=chislo[i];
      k:=0;
      If (s>='0') and (s<='9') then
         k:=StrToInt(s);
      If (s>='a') and (s<='z') then
         s:=UpCase(s);
      If (s>='A') and (s<='Z') then
         k:=Ord(s)-55;
      If k>=iz_n then
         Exit;
      chislo_10:=chislo_10+k*step;
      step:=step*iz_n;
   end;
   { далее перевод в нужную систему счисления }
   Repeat
      i:=chislo_10 mod w_m;
      Result:=kod_chisla_system(i)+Result;
      chislo_10:=chislo_10 div w_m;
   Until chislo_10=0;
   { корректировка ответа и знака }
   If Result='' then
      Result:='0';
   If (z<0) and (Result<>'0') then
      Result:='-'+Result;
end;

где
chislo - исходное целое число, записанное в строковом виде;
iz_n - система счисления числа chislo;
w_m - система счисления получаемого числа.

Например, Perewod_iz_n_w_m('11110', 2, 10) выведет '30'; Perewod_iz_n_w_m('1F', 16, 10) выведет '31'; Perewod_iz_n_w_m('71', 8, 16) выведет '39'; Perewod_iz_n_w_m('-z', 36, 2) выведет '-100011'.

Примечание. Функция Perewod_iz_n_w_m и другие нижеперечисленные функции позволяют переводить отрицательные числа. Если необходимо перевести только положительные числа, достаточно убрать в коде следующие строки:
z: -1..1;
...
{ проверка на отрицательные числа }
If (chislo<>'') and (chislo[1]='-') then
begin
   z:=-1;
   Delete(chislo, 1, 1);
end else
   z:=1;
...
If (z<0) and (Result<>'0') then
   Result:='-'+Result;

3. Перевод целого десятеричного числа в любую систему счисления

function Perewod_iz_10_w_n(chislo, w_n: int64): string;
var i: integer;
    z: -1..1;
begin
   Result:='';
   If (w_n>36) or (w_n<2) then
      Exit;
   If chislo<0 then
   begin
      z:=-1;
      chislo:=-chislo;
   end else
      z:=1;
   Repeat
      i:=chislo mod w_n;
      Result:=Kod_chisla_system(i)+Result;
      chislo:=chislo div w_n;
   Until chislo=0;
   If Result='' then
      Result:='0';
   If (z<0) and (Result<>'0') then
      Result:='-'+Result;
end;

где
chislo - исходное целое десятеричное число;
w_n - система счисления.

Например, Perewod_iz_10_w_n(225, 2) выведет '11100001'; Perewod_iz_10_w_n(-541, 16) выведет '-21D'; самое интересное, что Perewod_iz_10_w_n(1583, 36) выведет '17Z'.

4. Перевод целого десятеричного числа в двоичную систему счисления (частный случай)

function Perewod_iz_10_w_2(chislo: int64): string;
var i: integer;
    z: -1..1;
begin
   Result:='';
   If chislo<0 then
   begin
      z:=-1;
      chislo:=-chislo;
   end else
      z:=1;
   Repeat
      i:=chislo mod 2;
      Result:=IntToStr(i)+Result;
      chislo:=chislo div 2;
   Until chislo=0;
   If Result='' then
      Result:='0';
   If (z<0) and (Result<>'0') then
      Result:='-'+Result;
end;

где
chislo - исходное целое десятеричное число.

Например, Perewod_iz_10_w_2(12) выведет '1100'; Perewod_iz_10_w_2(-8) выведет '-1000'.

5. Перевод вещественного (десятичного) десятеричного числа в любую систему счисления

function Perewod_iz_10_w_nR(chislo: real; w_n, kol_wo_posle_zapyat: integer): string;
var i: integer;
    z: -1..1;
begin
   If chislo<0 then
   begin
      z:=-1;
      chislo:=-chislo;
   end else
      z:=1;
   Result:=Perewod_iz_10_w_n(Trunc(chislo), w_n)+',';
   chislo:=Frac(chislo);
   For i:=1 to kol_wo_posle_zapyat do
   begin
      chislo:=chislo*w_n;
      Result:=Result+Kod_chisla_system(Trunc(chislo));
      chislo:=Frac(chislo);
   end;
   If z<0 then
      Result:='-'+Result;
end;

где
chislo - исходное вещественное (десятичное) десятеричное число;
w_n - система счисления;
kol_wo_posle_zapyat - количество цифр после запятой.

Например, Perewod_iz_10_w_nR(25.93, 8, 10) выведет '31,7341217270'; Perewod_iz_10_w_nR(-0.01, 16, 7) выведет '-0,028F5C2'.

6. Перевод целого числа любой системы счисления в десятеричное число

function Perewod_iz_n_w_10(chislo: string; iz_n: integer): int64;
var i, k: integer;
    step: int64;
    s: char;
    z: -1..1;
begin
   Result:=0;
   If (iz_n<2) or (iz_n>36) then
      Exit;
   If (chislo<>'') and (chislo[1]='-') then
   begin
      z:=-1;
      Delete(chislo, 1, 1);
   end else
      z:=1;
   step:=1;
   For i:=Length(chislo) downto 1 do
   begin
      s:=chislo[i];
      k:=0;
      If (s>='0') and (s<='9') then
         k:=StrToInt(s);
      If (s>='a') and (s<='z') then
         s:=UpCase(s);
      If (s>='A') and (s<='Z') then
         k:=Ord(s)-55;
      If k>=iz_n then
      begin
         Result:=0;
         Exit;
      end;
      Result:=Result+k*step;
      step:=step*iz_n;
   end;
   If z<0 then
      Result:=-Result;
end;

где
chislo - исходное число любой системы счисления;
iz_n - система счисления.

Например, Perewod_iz_n_w_10('-6a7D', 16) выведет '-27261'; Perewod_iz_n_w_10('17z', 36) выведет '1583'.

7. Перевод целого двоичного числа в десятеричную систему счисления (частный случай)

function Perewod_iz_2_w_10(chislo: string): int64;
var i, k: integer;
    step: int64;
    s: char;
    z: -1..1;
begin
   Result:=0;
   If (chislo<>'') and (chislo[1]='-') then
   begin
      z:=-1;
      Delete(chislo, 1, 1);
   end else
      z:=1;
   step:=1;
   For i:=Length(chislo) downto 1 do
   begin
      s:=chislo[i];
      k:=StrToInt(s);
      Result:=Result+k*step;
      step:=step*2;
   end;
   If z<0 then
      Result:=-Result;
end;

где
chislo - исходное целое двоичное число.

Например, Perewod_iz_2_w_10('-1110') выведет '-14'.

8. Перевод целого двоичного числа в шестнадцатеричную систему счисления (частный случай)

function Perewod_iz_2_w_16(chislo: string): string;
const Base: array [0..15, 0..1] of string = (('0000', '0'), ('0001', '1'),
         ('0010', '2'), ('0011', '3'), ('0100', '4'), ('0101', '5'),
         ('0110', '6'), ('0111', '7'), ('1000', '8'), ('1001', '9'),
         ('1010', 'A'), ('1011', 'B'), ('1100', 'C'), ('1101', 'D'),
         ('1110', 'E'), ('1111', 'F'));
var i, j: integer;
    z: -1..1;
begin
   Result:='';
   If (chislo<>'') and (chislo[1]='-') then
   begin
      z:=-1;
      Delete(chislo, 1, 1);
   end else
      z:=1;
   While Length(chislo) mod 4<>0 do
      chislo:='0'+chislo;
   For i:=1 to Length(chislo) div 4 do
      For j:=Low(Base) to High(Base) do
         If Base[j, 0]=Copy(chislo, (i-1)*4+1, 4) then
         begin
            Result:=Result+Base[j, 1];
            Break;
         end;
   If Result='' then
      Result:='0';
   If (z<0) and (Result<>'0') then
      Result:='-'+Result;
end;

где
chislo - исходное целое двоичное число.

Например, Perewod_iz_2_w_16('-1101') выведет '-D'.

9. Перевод целого шестнадцатеричного числа в двоичную систему счисления (частный случай)

function Perewod_iz_16_w_2(chislo: string): string;
const Base: array [0..15, 0..1] of string = (('0000', '0'), ('0001', '1'),
         ('0010', '2'), ('0011', '3'), ('0100', '4'), ('0101', '5'),
         ('0110', '6'), ('0111', '7'), ('1000', '8'), ('1001', '9'),
         ('1010', 'A'), ('1011', 'B'), ('1100', 'C'), ('1101', 'D'),
         ('1110', 'E'), ('1111', 'F'));
var i, j: integer;
    z: -1..1;
    c: char;
begin
   Result:='';
   If (chislo<>'') and (chislo[1]='-') then
   begin
      z:=-1;
      Delete(chislo, 1, 1);
   end else
      z:=1;
   For i:=1 to Length(chislo) do
   begin
      c:=chislo[i];
      If (c>='a') and (c<='z') then
         c:=UpCase(c);
      For j:=Low(Base) to High(Base) do
         If Base[j, 1]=c then
         begin
            Result:=Result+Base[j, 0];
            Break;
         end;
   end;
   While (Result<>'') and (Result[1]='0') do
      Delete(Result, 1, 1);
   If Result='' then
      Result:='0';
   If (z<0) and (Result<>'0') then
      Result:='-'+Result;
end;

где
chislo - исходное целое шестнадцатеричное число.

Например, Perewod_iz_16_w_2('-6A') выведет '-1101010'.



Безопасный перевод строки в число

1. Перевод строки в число, удаляя посторонние символы, находящиеся в этой строке

function Perewod_w_chislo(s, simwol: string): string;
var i, zap: integer;
begin
   { удаляем посторонние символы }
   For i:=Length(s) downto 1 do
      If Pos(s[i], simwol)=0 then
         Delete(s, i, 1);
   { удаляем - }
   For i:=Length(s) downto 2 do
      If s[i]='-' then
         Delete(s, i, 1);
   { удаляем , }
   zap:=Pos(',', s);
   If zap>0 then
   begin
      For i:=Length(s) downto zap+1 do
         If s[i]=',' then
            Delete(s, i, 1);
      If s[1]='-' then
         If (Length(s)>=2) and (s[2]=',') then
            Delete(s, 2, 1) else
         else
      If s[1]=',' then
         Delete(s, 1, 1);
      If (Length(s)>=1) and (s[Length(s)]=',') then
         Delete(s, Length(s), 1);
   end;
   If (s='') or (s='-') then
      Result:='0' else
      Result:=s;
end;

где
s - исходная строка, содержащий цифры;
simwol - допустимые символы.

Например, Perewod_w_chislo('-8-5d2a12,s4,5', '0123456789-,') выведет '-85212,45'. В данном случае удалились посторонние символы (буквы), и получилось '-8-5212,4,5'. Далее были удалены лишние знаки "-" и ",".

2. Безопасный перевод строки в целое число

function StrToIntA(text: string): int64;
begin
   text:=Perewod_w_chislo(text, '0123456789-');
   Result:=StrToInt64(text);
end;

где
text - целое число, записанное в строковом виде.

Например, StrToIntA('--426w785h,s1') выведет '-4267851'.

3. Безопасный перевод строки в вещественное (десятичное) число

function StrToFloatA(text: string): real;
var e: integer;
    s1, s2: string;
begin
   e:=Pos('e', text);
   If e=0 then
      e:=Pos('E', text);
   If e>1 then
   begin
      s1:=Copy(text, 1, e-1);
      s2:=Copy(text, e+1, Length(text));
      s1:=Perewod_w_chislo(s1, '0123456789-,');
      s2:=Perewod_w_chislo(s2, '0123456789-');
      text:=s1+'E'+s2;
   end else
      text:=Perewod_w_chislo(text, '0123456789-,');
   Result:=StrToFloat(text);
end;

где
text - вещественное (десятичное) число, записанное в строковом виде.

Например, StrToFloatA('32fd12,,d52,ds36') выведет '3212,5236'; StrToFloatA('-8-5d2a12,s4,5E2,2') выведет '-8,521245E26'.

Примечание. В данном примере число '-85212,45E22' преобразовалось в нормальную экспоненциальную форму '-8,521245E26' (путем переноса запятой и увеличением степени).



Сложение и умножение "длинных" чисел

1. Сложение "длинных" чисел

function SlozhenieChisel(chislo1, chislo2: string): string;
var i, dlina: integer;
    p: array of byte;
begin
   dlina:=Length(chislo1);
   If Length(chislo2)>dlina then
      dlina:=Length(chislo2)+1 else
      dlina:=dlina+1;
   While Length(chislo1)<dlina do
      Insert('0', chislo1, 1);
   While Length(chislo2)<dlina do
      Insert('0', chislo2, 1);
   SetLength(p, dlina);
   Result:='';
   For i:=0 to dlina-1 do
      p[i]:=0;
   For i:=dlina downto 2 do
   begin
      p[i-1]:=p[i-1]+StrToInt(chislo1[i])+StrToInt(chislo2[i]);
      If p[i-1]>=10 then
      begin
         p[i-2]:=p[i-1] div 10;
         p[i-1]:=p[i-1] mod 10;
      end;
   end;
   For i:=0 to dlina-1 do
      Result:=Result+IntToStr(p[i]);
   While (Result<>'') and (Result[1]='0') do
      Delete(Result, 1, 1);
end;

где
chislo1, chislo2 - исходные числа, записанные в строковом виде.

Например, SlozhenieChisel('6523652323523541369829625622653684654235426354687232536263', '9413983543685263162354967467534953745376453764257642734523') выведет '15937635867208804532184593090188638399611880118944875270786'.

2. Умножение "длинных" чисел

function UmnozhenieChisel(chislo1, chislo2: string): string;
var i1, i2: integer;
    s: string;
    p: array of byte;
begin
   SetLength(p, Length(chislo1)+Length(chislo2));
   Result:='';
   For i1:=Length(chislo1) downto 1 do
   begin
      s:='';
      For i2:=0 to Length(chislo1)+Length(chislo2)-1 do
         p[i2]:=0;
      For i2:=Length(chislo2) downto 1 do
      begin
         p[i1+i2-1]:=p[i1+i2-1]+StrToInt(chislo1[i1])*StrToInt(chislo2[i2]);
         If p[i1+i2-1]>=10 then
         begin
            p[i1+i2-2]:=p[i1+i2-1] div 10;
            p[i1+i2-1]:=p[i1+i2-1] mod 10;
         end;
      end;
      For i2:=0 to Length(chislo1)+Length(chislo2)-1 do
         s:=s+IntToStr(p[i2]);
      While (s<>'') and (s[1]='0') do
         Delete(s, 1, 1);
      Result:=SlozhenieChisel(Result, s);
   end;
end;

где
chislo1, chislo2 - исходные числа, записанные в строковом виде.

Например, UmnozhenieChisel('6523652323523541369829625622653684654235426354687232536263', '9413983543685263162354967467534953745376453764257642734523') выведет '61413555618374748849977845610399844217660687681909351978534411248705150246948702748286484885796873132969976079507549'.

Примечание. Функция UmnozhenieChisel зависит от функции SlozhenieChisel.



Факториал числа

function Faktorial(chislo: integer): string;
const max_dlina=3000;
var i: integer;
    p: array[0..3000] of byte;

   procedure Umnozhit(chislo: integer);
   var i, k, um: integer;
       p1: array[0..max_dlina-1] of integer;
   begin
      k:=0;
      For i:=0 to max_dlina-1 do
         p1[i]:=0;
      Repeat
         k:=k+1;
         um:=0;
         For i:=max_dlina-1 downto 1 do
            If (i>k) then
            begin
               p1[i-k+1]:=p1[i-k+1]+um+p[i]*(chislo mod 10);
               um:=p1[i-k+1] div 10;
               p1[i-k+1]:=p1[i-k+1] mod 10;
            end;
         chislo:=chislo div 10;
      Until chislo=0;
      For i:=0 to max_dlina-1 do
         p[i]:=p1[i];
   end;

begin
   For i:=0 to max_dlina-2 do
      p[i]:=0;
   p[max_dlina-1]:=1;
   For i:=1 to chislo do
      Umnozhit(i);
   Result:='';
   For i:=0 to max_dlina-1 do
      Result:=Result+IntToStr(p[i]);
   While (Result<>'') and (Result[1]='0') do
      Delete(Result, 1, 1);
end;

где
chislo - исходное число.

Например, Faktorial(10) выведет '3628800'.



Операции с регистрами

1. Проверка прописной буквы в строке

function Registr(s: string): boolean;
var i: integer;
begin
   Result:=false;
   For i:=1 to Length(s) do
      If (s[i]>='A') and (s[i]<='Z') or (s[i]>='А') and (s[i]<='Я') or (s[i]='Ё') then
      begin
         Result:=true;
         Exit;
      end;
end;

где
s - исходная строка.

Например, Registr('Программа') выведет положительное значение; Registr('паскаль') выведет отрицательное значение.

2. Перевод всех букв строки в нижний регистр

function RegistrNizhniy(s: string): string;
var i: integer;
begin
   For i:=1 to Length(s) do
   begin
      If (s[i]>='A') and (s[i]<='Z') or (s[i]>='А') and (s[i]<='Я') then
         Inc(s[i], 32);
      If s[i]='Ё' then
         Inc(s[i], 16);
   end;
   Result:=s;
end;

где
s - исходная строка.

Например, RegistrNizhniy('Windows МоЖет всЁ!') выведет 'windows может всё!'.

3. Перевод всех букв строки в верхний регистр

function RegistrWerhniy(s: string): string;
var i: integer;
begin
   For i:=1 to Length(s) do
   begin
      If (s[i]>='a') and (s[i]<='z') or (s[i]>='а') and (s[i]<='я') then
         Dec(s[i], 32);
      If s[i]='ё' then
         Dec(s[i], 16);
   end;
   Result:=s;
end;

где
s - исходная строка.

Например, RegistrWerhniy('Windows МоЖет всё!') выведет 'WINDOWS МОЖЕТ ВСЁ!'.



Замена символа или фразы в строке на новое значение

function SimwolZamenit(s, simwol_star, simwol_now: string; Registr_star, Registr_now: boolean): string;
var i, LSS: integer;
    sC, SS, SN: string;
begin
   LSS:=Length(simwol_star);
   i:=1;
   While (i<=Length(s)) and (s<>'') do
   begin
      sC:=Copy(s, i, LSS);
      If not Registr_star and not Registr_now then
      begin
         If Registr(sC) then
         begin
            sC:=RegistrWerhniy(sC);
            SS:=RegistrWerhniy(simwol_star);
            SN:=RegistrWerhniy(simwol_now);
         end else
         begin
            sC:=RegistrNizhniy(sC);
            SS:=RegistrNizhniy(simwol_star);
            SN:=RegistrNizhniy(simwol_now);
         end;
      end;
      If Registr_star and not Registr_now then
      begin
         SS:=simwol_star;
         If Registr(simwol_now) then
            SN:=RegistrWerhniy(simwol_now) else
            SN:=RegistrNizhniy(simwol_now);
         If Registr(sC) and Registr(simwol_star) then
            SN:=RegistrWerhniy(simwol_now);
         If not Registr(sC) and not Registr(simwol_star) then
            SN:=RegistrNizhniy(simwol_now);
      end;
      If not Registr_star and Registr_now then
      begin
         SN:=simwol_now;
         If Registr(sC) then
            SS:=RegistrWerhniy(simwol_star) else
            SS:=RegistrNizhniy(simwol_star);
      end;
      If Registr_star and Registr_now then
      begin
         SS:=simwol_star;
         SN:=simwol_now;
      end;
      If (sC=SS) and (sC<>'') then
      begin
         Delete(s, i, LSS);
         Insert(SN, s, i);
         i:=i+Length(SN)-1;
      end;
      i:=i+1;
   end;
   Result:=s;
end;

где
s - исходная строка;
simwol_star - старый символ (фраза);
simwol_now - новый символ (фраза);
Registr_star - соблюдение регистра старого символа;
Registr_now - соблюдение регистра нового символа.

Например, SimwolZamenit('Программист', 'М', 'Н', false, true) выведет 'ПрограННист'; SimwolZamenit('барабАн', 'ба', 'ле', true, false) выведет 'лерабАн'.

Примечание. Для полноценной работы данной функции необходимо скопировать функции из раздела "Операции с регистрами":
function Registr(s: string): boolean;
function RegistrNizhniy(s: string): string;
function RegistrWerhniy(s: string): string;



Перевод текста из одной кодировки в другую

Для начала объявим константу, состоящую из массива, которая необходима для нашей работы:

const UTF8: array[0..65, 0..1] of string=
  ((Char($EF)+Char($BB)+Char($BF), ''),
   (Char($D0)+Char($82), Char($80)),
   (Char($D0)+Char($83), Char($81)),
   (Char($E2)+Char($80)+Char($9A), Char($82)),
   (Char($D1)+Char($93), Char($83)),
   (Char($E2)+Char($80)+Char($9E), Char($84)),
   (Char($E2)+Char($80)+Char($A6), Char($85)),
   (Char($E2)+Char($80)+Char($A0), Char($86)),
   (Char($E2)+Char($80)+Char($A1), Char($87)),
   (Char($E2)+Char($82)+Char($AC), Char($88)),
   (Char($E2)+Char($80)+Char($B0), Char($89)),
   (Char($D0)+Char($89), Char($8A)),
   (Char($E2)+Char($80)+Char($B9), Char($8B)),
   (Char($D0)+Char($8A), Char($8C)),
   (Char($D0)+Char($8C), Char($8D)),
   (Char($D0)+Char($8B), Char($8E)),
   (Char($D0)+Char($8F), Char($8F)),
   (Char($D1)+Char($92), Char($90)),
   (Char($E2)+Char($80)+Char($98), Char($91)),
   (Char($E2)+Char($80)+Char($99), Char($92)),
   (Char($E2)+Char($80)+Char($9C), Char($93)),
   (Char($E2)+Char($80)+Char($9D), Char($94)),
   (Char($E2)+Char($80)+Char($A2), Char($95)),
   (Char($E2)+Char($80)+Char($93), Char($96)),
   (Char($E2)+Char($88)+Char($92), Char($96)),
   (Char($E2)+Char($80)+Char($94), Char($97)),
   (Char($C2)+Char($98), Char($98)),
   (Char($E2)+Char($84)+Char($A2), Char($99)),
   (Char($D1)+Char($99), Char($9A)),
   (Char($E2)+Char($80)+Char($BA), Char($9B)),
   (Char($D1)+Char($9A), Char($9C)),
   (Char($D1)+Char($9C), Char($9D)),
   (Char($D1)+Char($9B), Char($9E)),
   (Char($D1)+Char($9F), Char($9F)),
   (Char($C2)+Char($A0), Char($A0)),
   (Char($D0)+Char($8E), Char($A1)),
   (Char($D1)+Char($9E), Char($A2)),
   (Char($D0)+Char($88), Char($A3)),
   (Char($C2)+Char($A4), Char($A4)),
   (Char($D2)+Char($90), Char($A5)),
   (Char($C2)+Char($A6), Char($A6)),
   (Char($C2)+Char($A7), Char($A7)),
   (Char($D0)+Char($81), Char($A8)),
   (Char($C2)+Char($A9), Char($A9)),
   (Char($D0)+Char($84), Char($AA)),
   (Char($C2)+Char($AB), Char($AB)),
   (Char($C2)+Char($AC), Char($AC)),
   (Char($C2)+Char($AD), Char($AD)),
   (Char($C2)+Char($AE), Char($AE)),
   (Char($D0)+Char($87), Char($AF)),
   (Char($C2)+Char($B0), Char($B0)),
   (Char($C2)+Char($B1), Char($B1)),
   (Char($D0)+Char($86), Char($B2)),
   (Char($D1)+Char($96), Char($B3)),
   (Char($D2)+Char($91), Char($B4)),
   (Char($C2)+Char($B5), Char($B5)),
   (Char($C2)+Char($B6), Char($B6)),
   (Char($C2)+Char($B7), Char($B7)),
   (Char($D1)+Char($91), Char($B8)),
   (Char($E2)+Char($84)+Char($96), Char($B9)),
   (Char($D1)+Char($94), Char($BA)),
   (Char($C2)+Char($BB), Char($BB)),
   (Char($D1)+Char($98), Char($BC)),
   (Char($D0)+Char($85), Char($BD)),
   (Char($D1)+Char($95), Char($BE)),
   (Char($D1)+Char($97), Char($BF)));

1. Перевод текста из кодировки ANSI в UTF8

function ANSIToUTF8(s: string): string;
label le;
var i, l: integer;
begin
   For l:=Length(s) downto 1 do
   begin
      For i:=Low(UTF8) to High(UTF8) do
         If s[l]=UTF8[i, 1] then
         begin
            Delete(s, l, 1);
            Insert(UTF8[i, 0], s, l);
            goto le;
         end;
      For i:=$90 to $BF do
         If s[l]=Char(i+$30) then
         begin
            Delete(s, l, 1);
            Insert(Char($D0)+Char(i), s, l);
            goto le;
         end;
      For i:=$80 to $8F do
         If s[l]=Char(i+$70) then
         begin
            Delete(s, l, 1);
            Insert(Char($D1)+Char(i), s, l);
            goto le;
         end;
      le:
   end;
   Result:=s;
end;

где
s - исходная строка.

2. Перевод текста из кодировки UTF8 в ANSI

function UTF8ToANSI(s: string): string;
var i: integer;
begin
   For i:=Low(UTF8) to High(UTF8) do
      s:=SimwolZamenit(s, UTF8[i, 0], UTF8[i, 1], true, true);
   For i:=$90 to $BF do
      s:=SimwolZamenit(s, Char($D0)+Char(i), Char(i+$30), true, true);
   For i:=$80 to $8F do
      s:=SimwolZamenit(s, Char($D1)+Char(i), Char(i+$70), true, true);
   s:=SimwolZamenit(s, '&minus;', '-', true, true);
   s:=SimwolZamenit(s, '&deg;', '°', true, true);
   s:=SimwolZamenit(s, '&hellip;', '...', true, true);
   s:=SimwolZamenit(s, '&nbsp;', #160, true, true);
   s:=SimwolZamenit(s, '&thinsp;', #160, true, true);
   s:=SimwolZamenit(s, #226#128#137, ' ', true, true);
   Result:=s;
end;

где
s - исходная строка.

Примечание. Для полноценной работы данной функции необходимо скопировать функцию "Замена символа или фразы на новое значение":
function SimwolZamenit(s, simwol_star, simwol_now: string; Registr_star, Registr_now: boolean): string;



Кодировка и раскодировка текста в ASCII

1. Кодировка текста в ASCII

function StrToKod(s: string): string;
var i: integer;

   function IntToStrL(n: integer): string;
   begin
      Result:=IntToStr(n);
      While Length(Result)<3 do
         Result:='0'+Result;
   end;

begin
   Result:='';
   For i:=1 to Length(s) do
      Result:=Result+'#'+IntToStrL(Ord(s[i]));
end;

где
s - исходная строка.

Например, StrToKod('Я и ты!') выведет '#223#032#232#032#242#251#033'.

2. Раскодировка текста из ASCII

function KodToStr(s: string): string;
var i: integer;
begin
   Result:='';
   While s<>'' do
   begin
      i:=Pos('#', s);
      If i>0 then
      begin
         Delete(s, 1, i);
         i:=Pos('#', s);
         If i=0 then
            i:=Length(s)+1;
         Result:=Result+Char(StrToInt(Copy(s, 1, i-1)));
         Delete(s, 1, i-1);
      end else
         Exit;
   end;
end;

где
s - исходная строка.

Например, KodToStr('#223#032#232#032#242#251#033') выведет 'Я и ты!'.



Конвертация раскладки клавиатуры

1. Конвертация раскладки русской клавиатуры на США

function KonwertatsiyaRaskladkiEn(rus: string): string;
begin
   rus:=SimwolZamenit(rus, ';', '$', false, false);
   rus:=SimwolZamenit(rus, '/', '|', false, false);
   rus:=SimwolZamenit(rus, '.', '/', false, false);
   rus:=SimwolZamenit(rus, '?', '&', false, false);
   rus:=SimwolZamenit(rus, ',', '?', false, false);
   rus:=SimwolZamenit(rus, '"', '@', false, false);
   rus:=SimwolZamenit(rus, ':', '^', false, false);
   rus:=SimwolZamenit(rus, 'й', 'q', false, false);
   rus:=SimwolZamenit(rus, 'ц', 'w', false, false);
   rus:=SimwolZamenit(rus, 'у', 'e', false, false);
   rus:=SimwolZamenit(rus, 'к', 'r', false, false);
   rus:=SimwolZamenit(rus, 'е', 't', false, false);
   rus:=SimwolZamenit(rus, 'н', 'y', false, false);
   rus:=SimwolZamenit(rus, 'г', 'u', false, false);
   rus:=SimwolZamenit(rus, 'ш', 'i', false, false);
   rus:=SimwolZamenit(rus, 'щ', 'o', false, false);
   rus:=SimwolZamenit(rus, 'з', 'p', false, false);
   rus:=SimwolZamenit(rus, 'х', '[', true, false);
   rus:=SimwolZamenit(rus, 'Х', '{', true, false);
   rus:=SimwolZamenit(rus, 'ъ', ']', true, false);
   rus:=SimwolZamenit(rus, 'Ъ', '}', true, false);
   rus:=SimwolZamenit(rus, 'ф', 'a', false, false);
   rus:=SimwolZamenit(rus, 'ы', 's', false, false);
   rus:=SimwolZamenit(rus, 'в', 'd', false, false);
   rus:=SimwolZamenit(rus, 'а', 'f', false, false);
   rus:=SimwolZamenit(rus, 'п', 'g', false, false);
   rus:=SimwolZamenit(rus, 'р', 'h', false, false);
   rus:=SimwolZamenit(rus, 'о', 'j', false, false);
   rus:=SimwolZamenit(rus, 'л', 'k', false, false);
   rus:=SimwolZamenit(rus, 'д', 'l', false, false);
   rus:=SimwolZamenit(rus, 'ж', ';', true, false);
   rus:=SimwolZamenit(rus, 'Ж', ':', true, false);
   rus:=SimwolZamenit(rus, 'э', '''', true, false);
   rus:=SimwolZamenit(rus, 'Э', '"', true, false);
   rus:=SimwolZamenit(rus, 'я', 'z', false, false);
   rus:=SimwolZamenit(rus, 'ч', 'x', false, false);
   rus:=SimwolZamenit(rus, 'с', 'c', false, false);
   rus:=SimwolZamenit(rus, 'м', 'v', false, false);
   rus:=SimwolZamenit(rus, 'и', 'b', false, false);
   rus:=SimwolZamenit(rus, 'т', 'n', false, false);
   rus:=SimwolZamenit(rus, 'ь', 'm', false, false);
   rus:=SimwolZamenit(rus, 'б', ',', true, false);
   rus:=SimwolZamenit(rus, 'Б', '<', true, false);
   rus:=SimwolZamenit(rus, 'ю', '.', true, false);
   rus:=SimwolZamenit(rus, 'Ю', '>', true, false);
   rus:=SimwolZamenit(rus, 'ё', '`', true, false);
   rus:=SimwolZamenit(rus, 'Ё', '~', true, false);
   rus:=SimwolZamenit(rus, '№', '#', false, false);
   Result:=rus;
end;

где
rus - исходная строка.

Например, KonwertatsiyaRaskladkiEn('Цштвщцы') выведет 'Windows'.

2. Конвертация раскладки США-клавиатуры на русскую

function KonwertatsiyaRaskladkiRu(eng: string): string;
begin
   eng:=SimwolZamenit(eng, 'q', 'й', false, false);
   eng:=SimwolZamenit(eng, 'w', 'ц', false, false);
   eng:=SimwolZamenit(eng, 'e', 'у', false, false);
   eng:=SimwolZamenit(eng, 'r', 'к', false, false);
   eng:=SimwolZamenit(eng, 't', 'е', false, false);
   eng:=SimwolZamenit(eng, 'y', 'н', false, false);
   eng:=SimwolZamenit(eng, 'u', 'г', false, false);
   eng:=SimwolZamenit(eng, 'i', 'ш', false, false);
   eng:=SimwolZamenit(eng, 'o', 'щ', false, false);
   eng:=SimwolZamenit(eng, 'p', 'з', false, false);
   eng:=SimwolZamenit(eng, '[', 'х', false, true);
   eng:=SimwolZamenit(eng, '{', 'Х', false, true);
   eng:=SimwolZamenit(eng, ']', 'ъ', false, true);
   eng:=SimwolZamenit(eng, '}', 'Ъ', false, true);
   eng:=SimwolZamenit(eng, 'a', 'ф', false, false);
   eng:=SimwolZamenit(eng, 's', 'ы', false, false);
   eng:=SimwolZamenit(eng, 'd', 'в', false, false);
   eng:=SimwolZamenit(eng, 'f', 'а', false, false);
   eng:=SimwolZamenit(eng, 'g', 'п', false, false);
   eng:=SimwolZamenit(eng, 'h', 'р', false, false);
   eng:=SimwolZamenit(eng, 'j', 'о', false, false);
   eng:=SimwolZamenit(eng, 'k', 'л', false, false);
   eng:=SimwolZamenit(eng, 'l', 'д', false, false);
   eng:=SimwolZamenit(eng, ';', 'ж', false, true);
   eng:=SimwolZamenit(eng, ':', 'Ж', false, true);
   eng:=SimwolZamenit(eng, '''', 'э', false, true);
   eng:=SimwolZamenit(eng, '"', 'Э', false, true);
   eng:=SimwolZamenit(eng, 'z', 'я', false, false);
   eng:=SimwolZamenit(eng, 'x', 'ч', false, false);
   eng:=SimwolZamenit(eng, 'c', 'с', false, false);
   eng:=SimwolZamenit(eng, 'v', 'м', false, false);
   eng:=SimwolZamenit(eng, 'b', 'и', false, false);
   eng:=SimwolZamenit(eng, 'n', 'т', false, false);
   eng:=SimwolZamenit(eng, 'm', 'ь', false, false);
   eng:=SimwolZamenit(eng, ',', 'б', false, true);
   eng:=SimwolZamenit(eng, '<', 'Б', false, true);
   eng:=SimwolZamenit(eng, '.', 'ю', false, true);
   eng:=SimwolZamenit(eng, '>', 'Ю', false, true);
   eng:=SimwolZamenit(eng, '/', '.', false, false);
   eng:=SimwolZamenit(eng, '?', ',', false, false);
   eng:=SimwolZamenit(eng, '`', 'ё', false, true);
   eng:=SimwolZamenit(eng, '~', 'Ё', false, true);
   eng:=SimwolZamenit(eng, '@', '"', false, false);
   eng:=SimwolZamenit(eng, '#', '№', false, false);
   eng:=SimwolZamenit(eng, '$', ';', false, false);
   eng:=SimwolZamenit(eng, '^', ':', false, false);
   eng:=SimwolZamenit(eng, '&', '?', false, false);
   eng:=SimwolZamenit(eng, '|', '/', false, false);
   Result:=eng;
end;

где
eng - исходная строка.

Например, KonwertatsiyaRaskladkiRu('Z ''nj [jxe!') выведет 'Я это хочу!'.

Примечание. Для полноценной работы данных функций необходимо скопировать функцию "Замена символа или фразы на новое значение":
function SimwolZamenit(s, simwol_star, simwol_now: string; Registr_star, Registr_now: boolean): string;



Транслитерация

1. Определение символа как русской или английской буквы, цифры

type TTranslit = (Ru, En, Num, Sym);

function Translit(s: char): TTranslit;
begin
   Result:=Sym;
   If (s>='А') and (s<='я') or (s='ё') or (s='Ё') then
      Result:=Ru;
   If (s>='A') and (s<='z') then
      Result:=En;
   If (s>='0') and (s<='9') then
      Result:=Num;
end;

где
s - исходный символ.

Например, Translit('5') выведет значение типа Num.

2. Проверка английских букв в строке

function TranslitEn(s: string): boolean;
var i: integer;
begin
   Result:=false;
   For i:=1 to Length(s) do
      If Translit(s[i])=En then
         Result:=true;
end;

где
s - исходная строка.

Например, TranslitEn('куb') выведет положительное значение.

3. Проверка русских букв в строке

function TranslitRu(s: string): boolean;
var i: integer;
begin
   Result:=false;
   For i:=1 to Length(s) do
      If strTranslit(s[i])=Ru then
         Result:=true;
end;

где
s - исходная строка.

Например, TranslitRu('domiно') выведет положительное значение.

4. Замена транслируемых символов с английского языка на русский

function TranslitEnRu(s: string): string;
begin
   s:=SimwolZamenit(s, 'sch', 'щ', false, false);
   s:=SimwolZamenit(s, 'ch', 'ч', false, false);
   s:=SimwolZamenit(s, 'sh', 'ш', false, false);
   s:=SimwolZamenit(s, 'ts', 'ц', false, false);
   s:=SimwolZamenit(s, 'ya', 'я', false, false);
   s:=SimwolZamenit(s, 'ye', 'э', false, false);
   s:=SimwolZamenit(s, 'yi', 'ы', false, false);
   s:=SimwolZamenit(s, 'yo', 'ё', false, false);
   s:=SimwolZamenit(s, 'yu', 'ю', false, false);
   s:=SimwolZamenit(s, 'zh', 'ж', false, false);
   s:=SimwolZamenit(s, 'a', 'а', false, false);
   s:=SimwolZamenit(s, 'b', 'б', false, false);
   s:=SimwolZamenit(s, 'v', 'в', false, false);
   s:=SimwolZamenit(s, 'w', 'в', false, false);
   s:=SimwolZamenit(s, 'g', 'г', false, false);
   s:=SimwolZamenit(s, 'd', 'д', false, false);
   s:=SimwolZamenit(s, 'e', 'е', false, false);
   s:=SimwolZamenit(s, 'z', 'з', false, false);
   s:=SimwolZamenit(s, 'i', 'и', false, false);
   s:=SimwolZamenit(s, 'j', 'й', false, false);
   s:=SimwolZamenit(s, 'k', 'к', false, false);
   s:=SimwolZamenit(s, 'l', 'л', false, false);
   s:=SimwolZamenit(s, 'm', 'м', false, false);
   s:=SimwolZamenit(s, 'n', 'н', false, false);
   s:=SimwolZamenit(s, 'o', 'о', false, false);
   s:=SimwolZamenit(s, 'p', 'п', false, false);
   s:=SimwolZamenit(s, 'r', 'р', false, false);
   s:=SimwolZamenit(s, 's', 'с', false, false);
   s:=SimwolZamenit(s, 't', 'т', false, false);
   s:=SimwolZamenit(s, 'u', 'у', false, false);
   s:=SimwolZamenit(s, 'f', 'ф', false, false);
   s:=SimwolZamenit(s, 'h', 'х', false, false);
   s:=SimwolZamenit(s, 'c', 'ц', false, false);
   s:=SimwolZamenit(s, '''''', 'ъ', false, false);
   s:=SimwolZamenit(s, 'y', 'ы', false, false);
   s:=SimwolZamenit(s, '''', 'ь', false, false);
   s:=SimwolZamenit(s, '`', 'ь', false, false);
   Result:=s;
end;

где
s - исходная строка.

Например, TranslitEnRu('Chislo') выведет 'Число'.

5. Замена транслируемых символов с русского языка на английский

function TranslitRuEn(s: string): string;
begin
   s:=SimwolZamenit(s, 'а', 'a', false, false);
   s:=SimwolZamenit(s, 'б', 'b', false, false);
   s:=SimwolZamenit(s, 'в', 'v', false, false);
   s:=SimwolZamenit(s, 'г', 'g', false, false);
   s:=SimwolZamenit(s, 'д', 'd', false, false);
   s:=SimwolZamenit(s, 'е', 'e', false, false);
   s:=SimwolZamenit(s, 'ё', 'yo', false, false);
   s:=SimwolZamenit(s, 'ж', 'zh', false, false);
   s:=SimwolZamenit(s, 'з', 'z', false, false);
   s:=SimwolZamenit(s, 'и', 'i', false, false);
   s:=SimwolZamenit(s, 'й', 'j', false, false);
   s:=SimwolZamenit(s, 'к', 'k', false, false);
   s:=SimwolZamenit(s, 'л', 'l', false, false);
   s:=SimwolZamenit(s, 'м', 'm', false, false);
   s:=SimwolZamenit(s, 'н', 'n', false, false);
   s:=SimwolZamenit(s, 'о', 'o', false, false);
   s:=SimwolZamenit(s, 'п', 'p', false, false);
   s:=SimwolZamenit(s, 'р', 'r', false, false);
   s:=SimwolZamenit(s, 'с', 's', false, false);
   s:=SimwolZamenit(s, 'т', 't', false, false);
   s:=SimwolZamenit(s, 'у', 'u', false, false);
   s:=SimwolZamenit(s, 'ф', 'f', false, false);
   s:=SimwolZamenit(s, 'х', 'h', false, false);
   s:=SimwolZamenit(s, 'ц', 'ts', false, false);
   s:=SimwolZamenit(s, 'ч', 'ch', false, false);
   s:=SimwolZamenit(s, 'ш', 'sh', false, false);
   s:=SimwolZamenit(s, 'щ', 'sch', false, false);
   s:=SimwolZamenit(s, 'ъ', '''''', false, false);
   s:=SimwolZamenit(s, 'ы', 'y', false, false);
   s:=SimwolZamenit(s, 'ь', '''', false, false);
   s:=SimwolZamenit(s, 'э', 'ye', false, false);
   s:=SimwolZamenit(s, 'ю', 'yu', false, false);
   s:=SimwolZamenit(s, 'я', 'ya', false, false);
   Result:=s;
end;

где
s - исходная строка.

Например, TranslitRuEn('Дрожжи') выведет 'Drozhzhi'.

Примечание. Для полноценной работы данных функций необходимо скопировать функцию "Замена символа или фразы на новое значение":
function SimwolZamenit(s, simwol_star, simwol_now: string; Registr_star, Registr_now: boolean): string;



Выделение текстовой части под номером, разделенным символом в строке

function Copy1(s: string; index: byte; c: char): string;
var i, x, l: integer;
begin
   x:=1;
   l:=0;
   If index<1 then
      index:=1;
   For i:=1 to Length(s) do
   begin
      If s[i]=c then
      begin
         index:=index-1;
         If index=1 then
            x:=i+1;
      end else
         If index=1 then
            l:=l+1;
      If index<=0 then
         Break;
   end;
   Result:=Copy(s, x, l);
end;

где
s - исходная строка;
index - порядковый номер значения;
c - разделитель.

Например, Copy1('апрель,июль,февраль,май,август,март,июнь,октябрь,сентябрь', 5, ',') выведет 'август'.



Позиция подстроки в строке

function Pos1(index0: integer; substr, s: string): integer;
begin
   If index0<1 then
      index0:=1;
   s:=Copy(s, index0, Length(s));
   Result:=index0+Pos(substr, s)-1;
end;

где
index0 - начальный индекс;
substr - подстрока;
s - исходная строка.

Например, Pos1(3, 'ба', 'барабан') выведет '5'.



Установка минимального по длине строкового значения

function DlinaStroki(s: string; dlina_s: integer; ch: char): string;
begin
   While Length(s)<dlina_s do
      s:=ch+s;
   Result:=s;
end;

где
s - исходная строка;
dlina_s - минимальное количество символов;
ch - заполнитель слева.

Например, DlinaStroki('85672', 7, '0') выведет '0085672'; DlinaStroki('пианино', 10, '!') выведет '!!!пианино'.



Удаление лишних пробелов в начале и в конце строки

function ProbelUdalit(s: string): string;
begin
   While (s<>'') and (s[1]=' ') do
      Delete(s, 1, 1);
   While (s<>'') and (s[Length(s)]=' ') do
      Delete(s, Length(s), 1);
   Result:=s;
end;

где
s - исходная строка.

Например, ProbelUdalit('   Новый год!    ') выведет 'Новый год!'.



Случайный набор символов (генератор новых слов)

function SlowoRandom(dlina: integer; PROPIS, rus, eng, tsifra: boolean): string;
var b: array[0..255] of boolean;
    i, n: integer;
begin
   Result:='';
   If not PROPIS and not rus and not eng and not tsifra then
      Exit;
   For i:=0 to 255 do
      b[i]:=false;
   If tsifra then
      For i:=48 to 57 do
         b[i]:=true;
   If PROPIS and eng then
      For i:=65 to 90 do
         b[i]:=true;
   If eng then
      For i:=97 to 122 do
         b[i]:=true;
   If PROPIS and rus then
      For i:=192 to 223 do
         b[i]:=true;
   If rus then
      For i:=224 to 255 do
         b[i]:=true;
   n:=0;
   While n<dlina do
   begin
      n:=n+1;
      i:=Random(256);
         If b[i] then
            Result:=Result+Char(i) else
            n:=n-1;
   end;
end;

где
dlina - длина строки;
PROPIS - прописные буквы;
rus - русские буквы;
eng - английские буквы;
tsifra - цифры.

Например, SlowoRandom(5, true, true, true, true) выведет случайным образом строку длиной в 5 символов (например, 'r5фSЦ').



Формат имени файла, исключающий "запрещенные" символы

function FormatNameFile(f: string; c: char): string;
var i: integer;
begin
   For i:=Length(f) downto 1 do
      Case f[i] of
      '\', '/', ':', '*', '?', '"', '''', '<', '>', '|':
         If c=#0 then
            Delete(f, i, 1) else
            f[i]:=c;
      end;
   Result:=f;
end;

где
f - имя файла;
c - заменяемый символ.

Например, FormatNameFile('Info?5.txt', '_') выведет 'Info_5.txt'.



Функции даты и времени

1. Форматирование даты и времени путем преобразования в строку

function FormatDateTime(const Format: string; DateTime: TDateTime): string;

где
Format - формат строки;
DateTime - дата и время.

Поддерживаются следующие описатели формата строки Format:
c      - число.месяц.год час:минута:секунда (например, '1.01.2127 1:08:04')
d      - число (1..31)
dd     - число (01..31)
ddd    - день недели (Пн..Вс)
dddd   - день недели (понедельник..воскресенье)
ddddd  - число.месяц.год (например, '04.05.2096')
dddddd - число месяц год (например, '4 мая 2096 год')
g      - эра (выводит 'наша эра' с 1.01.1601)
gg     - эра (выводит 'наша эра' с 1.01.1601)
e      - год в течение текущего периода/эры (0..99)
ee     - год в течение текущего периода/эры (00..99)
m      - месяц (1..12)
mm     - месяц (01..12)
mmm    - месяц (январь..декабрь)
mmmm   - месяц (Январь..Декабрь)
yy     - год (00..99)
yyyy   - год (0000..9999)
h      - час (0..23)
hh     - час (00..23)
n      - минута (0..59)
nn     - минута (00..59)
s      - секунда (0..59)
ss     - секунда (00..59)
z      - миллисекунда (0..999)
zzz    - миллисекунда (000..999)
t      - час:минута (например, '9:02')
tt     - час:минута:секунда (например, '4:08:00')
am/pm  - обозначение времени до и после полудня (выводит 'am' или 'pm')
a/p    - обозначение времени до и после полудня (выводит 'a' или 'p')
ampm   - обозначение времени до и после полудня (выводит в зависимости от настройки компьютера)

Например, FormatDateTime('dd.mm.yyyy hh:nn:ss am/pm', Now) выведет '01.01.2016 08:00:00 am'.

Примечание. Данная функция входит в состав языка Паскаль.

2. Проверка правильности введения даты

function TryEncodeDate(Year, Month, Day: Word; out Date: TDateTime): Boolean;

где
Year - год;
Month - месяц;
Day - день;
Date - полученная дата.

Например, TryEncodeDate(2015, 2, 29, Date) выведет отрицательное значение; TryEncodeDate(2016, 5, 1, Date) выведет положительное значение, а значение Date станет равным '42491'.

Примечание. Данная функция входит в состав языка Паскаль.

3. Объединение года, месяца и дня в дату

function EncodeDate(Year, Month, Day: Word): TDateTime;

где
Year - год;
Month - месяц;
Day - день.

Например, EncodeDate(2012, 9, 30) выведет '41182'.

Примечание. Данная функция входит в состав языка Паскаль.

4. Проверка правильности введения времени

function TryEncodeTime(Hour, Min, Sec, MSec: Word; out Time: TDateTime): Boolean;

где
Hour - часы;
Min - минуты;
Sec - секунды;
MSec - миллисекунды;
Time - полученное время.

Например, TryEncodeTime(24, 8, 60, 984, Time) выведет отрицательное значение; TryEncodeTime(23, 51, 37, 687, Time) выведет положительное значение, а значение Time станет равным '0,994186' (округленно).

Примечание. Данная функция входит в состав языка Паскаль.

5. Объединение часов, минут, секунд и миллисекунд во время

function EncodeTime(Hour, Min, Sec, MSec: Word): TDateTime;

где
Hour - часы;
Min - минуты;
Sec - секунды;
MSec - миллисекунды.

Например, EncodeTime(22, 47, 36, 1) выведет '0,949722' (округленно).

Примечание. Данная функция входит в состав языка Паскаль.

6. Порядковый номер дня года

function DenNomer(DateTime: TDateTime): integer;
var g: integer;
    r: TDateTime;
begin
   DateTime:=Trunc(DateTime);
   g:=StrToInt(FormatDateTime('yyyy', DateTime));
   r:=EncodeDate(g, 1, 1);
   Result:=Round(DateTime-r+1);
end;

где
DateTime - исходная дата.

Например, DenNomer(EncodeDate(2087, 6, 27)) выведет '178' (178-й день 2087-го года).

7. Порядковый номер недели года

function NedelyaNomer(DateTime: TDateTime): integer;
var g, n: integer;
    r: TDateTime;
begin
   DateTime:=Trunc(DateTime);
   g:=StrToInt(FormatDateTime('yyyy', DateTime));
   r:=EncodeDate(g, 1, 1);
   n:=DayOfWeek(DateTime)-1;
   If n=0 then
      n:=7;
   r:=r-n+1;
   n:=Round(DateTime-r);
   Result:=n div 7+1;
end;

где
DateTime - исходная дата.

Например, NedelyaNomer(EncodeDate(2087, 6, 27)) выведет '26' (26-я неделя 2087-го года).

8. Перевод количества секунд в привычный нам формат

function FormatSec(Sec: real): string;
var dn, ch, min, s, ms: integer;
begin
   ms:=Trunc(Frac(Sec)*1000);
   Sec:=Trunc(Sec);
   s:=Trunc(Sec) mod 60;
   Sec:=Trunc(Sec/60);
   min:=Trunc(Sec) mod 60;
   Sec:=Trunc(Sec/60);
   ch:=Trunc(Sec) mod 24;
   Sec:=Trunc(Sec/24);
   dn:=Trunc(Sec);
   Result:='';
   If dn>0 then
      Result:=Format('%d дн. ', [dn]);
   Result:=Format('%s%d:%d:%d', [Result, ch, min, s]);
   If ms>0 then
      Result:=Format('%s,%d', [Result, ms]);
end;

где
Sec - количество секунд.

Например, FormatSec(658745.8) выведет '7 дн. 14:59:05,800'.

9. Количество дней в месяце

function Kol_WoDnejWMesyatse(Month, Year: word): word;
var DayTable: TDayTable;
begin
   DayTable:=MonthDays[IsLeapYear(Year)];
   Result:=DayTable[Month];
end;

где
Month - месяц;
Year - год.

Например, Kol_WoDnejWMesyatse(2, 2096) выведет '29'.

10. Часовой пояс

function Zone: real;
var lp: TTimeZoneInformation;
begin
   GetTimeZoneInformation(lp);
   Result:=-lp.Bias/60;
end;

Примечание. Выводит часовой пояс в зависимости от настройки компьютера (например, '3').

11. Вычисление даты Пасхи

function Pasha(Year: integer): TDateTime;
var a, b, c: integer;
begin
   a:=Year mod 19;
   b:=Year mod 4;
   c:=Year mod 7;
   a:=(19*a+15) mod 30;
   b:=(2*b+4*c+6*a+6) mod 7;
   a:=a+b;
   b:=-2+Year div 100-Year div 400;
   If TryEncodeDate(Year, 3, 22, Result) then
      Result:=Result+a+b else
      Result:=0;
end;

где
Year - год.

Например, FormatDateTime('c', Pasha(2016)) выведет '01.05.2016'.

Автор: © Неверов Евгений Викторович
E-mail: newerow1989@yandex.ru, newerow1989@mail.ru
Сайт: newerow1989.narod.ru
Дата изменения: 23.10.2017 г.