{ процедуру с параметрами, обеспечивающую перестановку двух заданных строк матрицы написан на PascalABC.NET но должно работать в TurboPascal }
PROGRAM A5; const rows = 5; cols = 8;
type matrix = array [1..rows,1..cols] of integer;
var AR : matrix;// рабочая матрица i,j:byte;// счетчики k1,k2:byte;// номера строк
// обмен строк матрицы местами procedure SwapRows(row1:byte; row2:byte; var m:matrix); var i,j:byte; ax:integer; begin for i:=1 to cols do begin ax := m[row1,i]; m[row1,i] := m[row2,i]; m[row2,i] := ax; end; end;
// выравнивание по правому краю - пробелы перед числом function trailSpace(num:byte; len:byte):string; var s:string; i:byte; begin s := ''+num; i := s.Length; while (i<len) do begin s := ' ' + s; i := i+1; end; trailSpace := s; end;
// вывод матрицы на экран procedure displayMatrix(var m:matrix); var i,j:byte; begin for i:=1 to rows do begin write('Строка ', i, ': '); for j:=1 to cols do begin write(); write(trailSpace(AR[i,j], 4) ); end; writeln(' '); end; end;
BEGIN // заполнение массива и вывод его на экран randomize(); for i:=1 to rows do for j:=1 to cols do AR[i,j] := random(256); writeln('Начальный массив'); displayMatrix(AR);
// ввод данных writeln(' '); write('введите номер строк которые следует поменять местами: '); readln(k1, k2);
if (k1<=rows) and (k2<=rows) then begin SwapRows(k1, k2, AR); writeln('Результат'); displayMatrix(AR); end else writeln('Номера строк должны быть меньше ', rows); END.
Без проверки полагаем, что по заданным координатам точек можно построить треугольники.
//PascalABC.Net 3.0, сборка 1111 type Point=record x,y:double end;
function TriangleSquare(A,B,C:Point):double; begin Result:=0.5*abs(A.x*(B.y-C.y)+B.x*(C.y-A.y)+C.x*(A.y-B.y)) end;
procedure GetPoint(c:char; var A:Point); begin Write('Введите координаты точки ',c,': '); Readln(A.x,A.y) end;
var A:array['A'..'F'] of Point; i:'A'..'F'; s1,s2:double; begin for i:='A' to 'F' do GetPoint(i,A[i]); s1:=TriangleSquare(A['A'],A['B'],A['C']); s2:=TriangleSquare(A['D'],A['E'],A['F']); if s1>s2 then Writeln('Площадь первого треугольника больше') else if s2>s1 then Writeln('Площадь второго треугольника больше') else Writeln('Площади треугольников равны') end.
Тестовое решение: Введите координаты точки A: -4 3.7 Введите координаты точки B: -6.3 0 Введите координаты точки C: 10.2 5.93 Введите координаты точки D: 7.143 8.1 Введите координаты точки E: -6 -3 Введите координаты точки F: 7.4 -5.7 Площадь второго треугольника больше
процедуру с параметрами, обеспечивающую перестановку двух заданных строк матрицы
написан на PascalABC.NET
но должно работать в TurboPascal
}
PROGRAM A5;
const
rows = 5;
cols = 8;
type
matrix = array [1..rows,1..cols] of integer;
var
AR : matrix;// рабочая матрица
i,j:byte;// счетчики
k1,k2:byte;// номера строк
// обмен строк матрицы местами
procedure SwapRows(row1:byte; row2:byte; var m:matrix);
var i,j:byte;
ax:integer;
begin
for i:=1 to cols do begin
ax := m[row1,i];
m[row1,i] := m[row2,i];
m[row2,i] := ax;
end;
end;
// выравнивание по правому краю - пробелы перед числом
function trailSpace(num:byte; len:byte):string;
var s:string;
i:byte;
begin
s := ''+num;
i := s.Length;
while (i<len) do begin
s := ' ' + s;
i := i+1;
end;
trailSpace := s;
end;
// вывод матрицы на экран
procedure displayMatrix(var m:matrix);
var i,j:byte;
begin
for i:=1 to rows do begin
write('Строка ', i, ': ');
for j:=1 to cols do begin
write();
write(trailSpace(AR[i,j], 4) );
end;
writeln(' ');
end;
end;
BEGIN
// заполнение массива и вывод его на экран
randomize();
for i:=1 to rows do
for j:=1 to cols do
AR[i,j] := random(256);
writeln('Начальный массив');
displayMatrix(AR);
// ввод данных
writeln(' ');
write('введите номер строк которые следует поменять местами: ');
readln(k1, k2);
if (k1<=rows) and (k2<=rows) then begin
SwapRows(k1, k2, AR);
writeln('Результат');
displayMatrix(AR);
end else
writeln('Номера строк должны быть меньше ', rows);
END.
//PascalABC.Net 3.0, сборка 1111
type
Point=record
x,y:double
end;
function TriangleSquare(A,B,C:Point):double;
begin
Result:=0.5*abs(A.x*(B.y-C.y)+B.x*(C.y-A.y)+C.x*(A.y-B.y))
end;
procedure GetPoint(c:char; var A:Point);
begin
Write('Введите координаты точки ',c,': ');
Readln(A.x,A.y)
end;
var
A:array['A'..'F'] of Point;
i:'A'..'F';
s1,s2:double;
begin
for i:='A' to 'F' do GetPoint(i,A[i]);
s1:=TriangleSquare(A['A'],A['B'],A['C']);
s2:=TriangleSquare(A['D'],A['E'],A['F']);
if s1>s2 then Writeln('Площадь первого треугольника больше')
else
if s2>s1 then Writeln('Площадь второго треугольника больше')
else Writeln('Площади треугольников равны')
end.
Тестовое решение:
Введите координаты точки A: -4 3.7
Введите координаты точки B: -6.3 0
Введите координаты точки C: 10.2 5.93
Введите координаты точки D: 7.143 8.1
Введите координаты точки E: -6 -3
Введите координаты точки F: 7.4 -5.7
Площадь второго треугольника больше