Текст программы. //перевод натуральных чисел из одной системы счисления в другую

 

program Project1;

//перевод натуральных чисел из одной системы счисления в другую

{$APPTYPE CONSOLE}

Uses

SysUtils;

Var

cs1, cs2: integer;

TD: string;

{функция перевода Dec числа в любую сс}

function FromDec(n: integer; const r: integer): string;

Var

s: String;

Const

digit: string[16]='0123456789ABCDEF';

Begin

s: ='';

Repeat

s: =digit[(n mod r)+1]+s;

n: =n div r;

until n=0;

FromDec: =s;

end;

{функция перевода любой сс в Dec}

function ToDec(n: string; const r: integer): integer;

Var

m, i: integer;

Const

digit: string[16]='0123456789ABCDEF';

Begin

m: =0;

while n[1]='0' do

delete(n, 1, 1);

for i: =1 to length(n) do

m: =m*r+pos(n[i], digit)-1;

ToDec: =m;

end;

{основная программа}

Begin

writeln('Iz kakoy systemi: ');

Repeat

readln(cs1);

until (cs1> =2) and (cs1< =16);

writeln('vvedite chislo v sootvetstvujushey systeme: ');

readln(TD);

writeln('V kakuju systemu: ');

Repeat

readln(cs2);

until (cs2> =2) and (cs2< =16);

writeln('Perevod iz ', cs1, ' ss --> ', cs2, ' ss: ');

writeln(FromDec(ToDec(TD, cs1), cs2));

Readln;

end.

 

Рассмотрим пример использования в качестве параметра функции элемента процедугного типа.

Пример 3. Составьте программу нахождения определенного интеграла на отрезке [a, b] методом трапеций с использованием функции в качестве параметра.

 

Текст программы

 

program Project1;

//Вычисление интеграла методом трапеций

{$APPTYPE CONSOLE}

Uses

SysUtils;

Type

tfunc= function (x: Real): Real; //процедурный тип

Var

a, b, x: Real;

 

function f1(x: Real): Real; far;

Begin

f1: =Sin(x);

end;

 

function f2(x: Real): Real; far;

Begin

f2: =cos(x);

end;

 

function f3(x: Real): Real; far;

Begin

f3: =sqr(x);

end;

 

function trap(func: tfunc; a, b: Real; n: Integer): real;

//Метод трапеций

Var

h, y: Real;

Begin

y: =(func(a)+func(b))/2;

h: =(b-a)/n;

x: =a+h;

while x< =b-h do

Begin

y: =y+func(x);

x: =x+h;

end;

trap: =y*h;

end;

Begin

Writeln('Integral ot sin(x)dx= ', trap(f1, 0, pi/2, 1000): 8: 4);

Writeln('Integral ot cos(x)dx= ', trap(f2, 0, pi/2, 1000): 8: 4);

Writeln('Integral ot sqr(x)dx= ', trap(f3, 0, 1, 1000): 8: 4);

readln;

end.

 

Следующий пример иллюстрирует использование параметра процедуры без типа.

Пример 4. Составьте программу нахождения суммы элементов одномерного и двухмерного массивов с помощью одной процедуры с использованием параметра процедуры без типа.

 

Текст программы

 

program Project1;

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

//Нахождение суммы элементов массива

{$APPTYPE CONSOLE}

 

Uses

SysUtils;

 

Type

tmas1= array [1..100] of Real;

tmas2= array [1..10, 1..10] of Real;

Var

a1: tmas1;

a2: tmas2 absolute a1;

m, n: Integer;

s: Real;

procedure vvodm1(var mas; var n: integer);

//Ввод элементов одномерного массива

Var

fin: TextFile;

i: Integer;

a: array [1..100] of Real absolute mas;

Begin

AssignFile(fin, 'File1.txt');

Reset(fin);

Readln(fin, n);

for i: =1 to n do

read(fin, a[i]);

CloseFile(fin);

end;

 

procedure vvodm2(var mas; var m, n: integer);

//Ввод элементов двухмерного массива

Var

fin: TextFile;

i, j: Integer;

a: array [1..10, 1..10] of Real absolute mas;

Begin

AssignFile(fin, 'File2.txt');

Reset(fin);

Readln(fin, m, n);

for i: =1 to m do

for j: =1 to n do

read(fin, a[i, j]);

CloseFile(fin);

end;

 

procedure sum(var mas; n: integer; var s: Real);

//Нахождение суммы элементов массива

Var

i: Integer;

a: array [1..100] of Real absolute mas;

Begin

s: =0;

for i: =1 to n do

s: =s+a[i];

end;

 

Begin

vvodm1(a1, n);

sum(a1, n, s);

Writeln('s1= ', s: 8: 2);

vvodm2(a2, m, n);

sum(a2, m*n, s);

Writeln('s2= ', s: 8: 2);

readln;

end.