Использование модулей. Разработка оверлейных программ.

Задание:

Составить программу использующую модуль OVERLAY.

Таблица 24.

Приложение

Примеры текстов программ лабораторного практикума

Тексты программ соответствуют первым вариантам заданий лабораторных работ

Лабораторная работа №1

program laba1_1;
uses
crt;
var
{исходные данные}
a, b, c, y: real;
begin
ClrScr;
a := 1.5;
b := 4.3;
c := 7.1;
y := a * Sqr(b) + c * b;
WriteLn('Исходные данные');
Writeln('a = ', a:4:1, ' b = ', b:4:1, ' c = ', c:4:1);
WriteLn('Результаты расчета:', #13, #10, 'y = ', y:0:2);
repeat until KeyPressed;
end.

Лабораторная работа №2

program laba2_1;
uses crt;
var
x, y, z: real;
a, b: real;
begin
ClrScr;
a := 0.25;
b := 1.25;
x := 3.50;
WriteLn('Исходные данные:',
#13, #10, 'a = ', a:4:2,
' b = ', b:4:2, ' x = ', x:4:2);
y := (Exp(abs((1/3) * Ln(x + sin(sqr(x))))) - 2 * a * b) /
(Ln(abs(x)) / Ln(2));
z := (Pi * Ln(Abs(x)) / Ln(10) - a) /
Exp(4 * Ln(Abs(Cos(x))));
WriteLn('Результат:', #13, #10,
'y = ', y:4:2, ' z = ', z:4:2);
repeat until KeyPressed;
end.

Лабораторная работа №3

program laba3_1;
uses crt;
var
a, x, y: real;
begin
ClrScr;
a := 0.265e2; {исходные}
x := 0.927; { данные }
if a < x then
y := Sqrt(Abs(a - x)) * Sqr(Sin(x))
else if a = x then
y := (x / Abs(a + x)) * Exp((1 / 3) * Ln(Abs(Sin(x))))
else if a > x then
y := Exp(Sqrt(Abs(x)));
WriteLn('Исходные данные:', #13, #10,
'a = ', a:4:2, ' x = ', x:4:2);
WriteLn('Результаты:', #13, #10, 'y = ', y:4:2);
repeat until KeyPressed;
end.

Лабораторная работа №4

program laba4_1;
uses crt;
const
da = 0.5;
var
x, y, a: real;
begin
ClrScr;
x := 0.35;
a := 0.5;
while a <= 2.5 do
begin
if (a <= x) then
y := (Sqr(x) - Sqr(a) * x) * Sin(x) /
Cos(x) / Sqrt(Abs(a + x))
else
y := (a + x) * Exp(Sqrt(Abs(x + a)));
WriteLn('x = ', x:4:2, ' a = ', a:4:2,
' y = ', y:4:2);
a := a + 0.5;
end;
repeat until KeyPressed;
end.

Лабораторная работа №5

program laba5_1;
uses
crt;
var
a, x, y: array [1..4] of real;
i: integer;
begin
ClrScr;
a[1] := 1.2; a[2] := -15.1; a[3] := 0.385; a[4] := 0.5;
x[1] := -123e2; x[2] := 8; x[3] := 310; x[4] := 0.012;
for i := 1 to 4 do
begin
if (x[i] < Abs(a[i])) then
y[i] := (a[i] - x[i]) * Sin(Sqr(x[i]))
else if (x[i] < a[i]) then
y[i] := Exp(Sqrt(Abs(x[i]))) * Sin(a[i]) / Cos(a[i])
else if (x[i] > a[i]) then
y[i] := Sqrt(Abs(a[i])) * Cos(x[i]);
WriteLn('x[', i, '] = ', x[i]:9:2,
' a[', i, '] = ', a[i]:9:2,
' -> y[', i, '] = ', y[i]:9:2);
end;
repeat until KeyPressed;
end.

Лабораторная работа №6

program laba6_1;
uses
crt;
type
TVector = array [1..3] of real;
TMatrica = array [1..3, 1..3] of real;
const
B: TVector = (1.21, 3.42, 4.51);
M: TMatrica = ((0.24, 0.027, 0.31),
(0.43, 0.84, 0.92),
(1.21, 1.63, 1.98));
var
i, j: integer;
R: TVector;
begin
ClrScr;
for i := 1 to 3 do
begin
R[i] := 0;
for j := 1 to 3 do
R[i] := R[i] + B[j] * M[j, i];
end;
Write('B = {');
for i := 1 to 3 do Write(B[i]:5:2, ' ');
Write('}', #13, #10, 'M = {');
for i := 1 to 3 do
begin
for j := 1 to 3 do
Write(M[i, j]:5:2, ' ');
if ((i = 3) and (j = 3)) then Write('}');
Write(#13, #10, ' ');
end;
Write(#13, #10, 'R = {');
for i := 1 to 3 do Write(R[i]:5:2, ' ');
Write('}', #13, #10);
repeat until KeyPressed;
end.

Лабораторная работа №7

program laba7_1;
uses
crt;
type
TArray = array [1..9] of real;
var
a, neg: TArray;
i, k: integer;
s: real;
c: char;

procedure InputArray(n: integer; var mas: TArray);
var
i: integer;
begin
for i := 1 to n do
begin
Write('element ', i, ' = ');
Read(mas[i]);
end;
end;

procedure OutputArray(n: integer; mas: TArray);
var
i: integer;
begin
for i := 1 to n do
Write(mas[i]:4:2, ' ');
WriteLn;
end;

procedure LookForNegative(n: integer; mas: TArray;
var neg: TArray; var k: integer; var s: real);
var
i: integer;
begin
k := 0;
s := 0;
for i := 1 to n do
if (mas[i] < 0) then
begin
k := k + 1;
neg[k] := mas[i];
s := s + mas[i];
end;
end;

begin
ClrScr;
WriteLn('Enter array A (9 elements)');
InputArray(9, a);
OutputArray(9, a);
LookForNegative(9, a, neg, k, s);
WriteLn('Negative elements are:');
OutputArray(k, neg);
WriteLn('Amount of negative elements are:');
WriteLn(s:4:2);
WriteLn('Press any key');
repeat until KeyPressed;
c := ReadKey;

ClrScr;
WriteLn('Enter array B (5 elements)');
InputArray(5, a);
OutputArray(5, a);
LookForNegative(5, a, neg, k, s);
WriteLn('Negative elements are:');
OutputArray(k, neg);
WriteLn('Amount of negative elements are:');
WriteLn(s:4:2);
WriteLn('Press any key');
repeat until KeyPressed;
c := ReadKey;

ClrScr;
WriteLn('Enter array C (4 elements)');
InputArray(4, a);
OutputArray(4, a);
LookForNegative(4, a, neg, k, s);
WriteLn('Negative elements are:');
OutputArray(k, neg);
WriteLn('Amount of negative elements are:');
WriteLn(s:4:2);
WriteLn('Press any key');
repeat until KeyPressed;
end.

Лабораторная работа №8

program laba8_1;
uses
crt;
const
p = 2.25;
var
x1, x2, y1, y2: real;

procedure Solve(a, b, c: real; var x1, x2: real);
var
d: real;
begin
d := Sqr(b) - 4 * a * c;
if (d < 0) then
begin
WriteLn('Descriminant is negative', #13, #10,
'Press any key');
repeat until KeyPressed;
Halt(1);
end;
x1 := (-b + Sqrt(d)) / 2 / a;
x2 := (-b - Sqrt(d)) / 2 / a;
end;

function Func(x1, x2, y1, y2: real): real;
begin
Func := (Exp(x1 + y2) + Exp(x2 + y1)) * p;
end;

begin
ClrScr;
Write('x^2 - 6x + 5 = 0 :', #13, #10, ' ');
Solve(1, -6, 5, x1, x2);
WriteLn('x1 = ', x1:4:2,' x2 = ', x2:4:2);
Write('y^2 + 5y + 4 = 0 :', #13, #10, ' ');
Solve(1, 5, 4, y1, y2);
WriteLn('y1 = ', y1:4:2,' y2 = ', y2:4:2);
WriteLn('Y = ', Func(x1, x2, y1, y2):4:4);
repeat until KeyPressed;
end.

Лабораторная работа №9

program laba9_1;
uses crt;
const E = 0.01;
var x, a, b: real;

function Iter(a, b: real): real;
var
x0, x1, x2, fx: real;
begin
x0 := (a + b) / 2;
x2 := x0;
repeat
x1 := x2;
fx := Exp(-x1) - x1;
x2 := Exp(-x1);
until Abs(x2 - x1) - fx <= 0;
Iter := x2;
end;

begin
ClrScr;
WriteLn('Введите границы - a и b');
ReadLn(a, b);
x := Iter(a, b);
WriteLn('Ответ - ', x:4:2);
WriteLn('=======================');
WriteLn(Exp(0.56) + 0.56);
repeat until KeyPressed;
end.

Лабораторная работа №10

program laba10_1;
uses crt;
const
Min = 1;
Max = 100;
Power = 10;
type
TSet = set of Min..Max;
var
x1, x2, x3, y, z: TSet;
e, i: integer;

procedure SetIn (var x: TSet; str: string);
var
e, i: integer;
begin
ClrScr;
WriteLn('Enter set ', str, ':');
for i := 1 to Power do
begin
Write('enter element ', i, ' >> ');
ReadLn(e);
x := x + [e];
end;
ClrScr;
end;

procedure SetOut(x: TSet; str: string);
var
i, e: integer;
begin
Write(str, '{');
for i := Min to Max do
if i in x then
Write(i, ' ');
WriteLn('}');
end;

{ Main Program }
begin
ClrScr;
SetIn(x1, 'x1');
SetIn(x2, 'x2');
SetIn(x3, 'x3');
y := (x1 + x2) * (x1 - x3);
for i := Min to Max do
if (i in y) and (i mod 2 <> 0) then
z := z + [i];
SetOut(x1, 'x1');
SetOut(x2, 'x2');
SetOut(x3, 'x3');
WriteLn('========================');
SetOut(y, 'y');
SetOut(z, 'z');
ReadKey;
end.

Лабораторная работа №11

program laba11_1;
uses crt;
var
Str, bufStr, newStr: string;
StrArray: array [1..4] of string;
i, n: integer;
begin
ClrScr;
WriteLn('enter your 3th name, 1st name, 2nd name, group #');
ReadLn(Str);
WriteLn('String Length - ', Length(Str));
if Str[Length(Str)] <> ' ' then
Str := Str + ' ';
bufStr := '';
n := 1;
for i := 1 to Length(Str) do
begin
bufStr := bufStr + Str[i];
if Str[i] = ' ' then
begin
Delete(bufStr, Length(bufStr), 1);
Writeln('Length of "', bufStr, '" is ', Length(bufStr));
StrArray[n] := bufStr;
n := n + 1;
bufStr := '';
end;
end;
NewStr := StrArray[3] + ' ' +
StrArray[2] + ' ' +
StrArray[1] + ' ' +
StrArray[4];
WriteLn('New String - ', NewStr);
ReadKey;
end.

Лабоаторная работа №12

program laba12_1;
uses crt;
const
n = 17;
FilePath = 'a:\file.txt';
type
TArray = array [1..n] of real;
const
MainArray: TArray = (0, 0, 0, 0.563, 0.98,
1.32, 1.78, 1.94, 2.06,
2.16, 2.24, 2.3, 2.34,
2.36, 2.4, 2.42, 2.44);
var
NewArray: TArray;
i: integer;
procedure WriteToFile(MyArray: TArray; Count: integer);
var
i: integer;
hFile: text;
begin
Assign(hFile, FilePath);
Rewrite(hFile);
for i := 1 to Count do
Write(hFile, MyArray[i]:0:4, ' ');
Close(hFile);
end;

procedure ReadFromFile(var MyArray: TArray; Count: integer);
var
i: integer;
hFile: text;
begin
Assign(hFile, FilePath);
Reset(hFile);
for i := 1 to Count do
Read(hFile, MyArray[i]);
Close(hFile);
end;

function Amount(MyArray: TArray; Count: integer): real;
var
i: integer;
s: real;
begin
s := 0;
for i := 1 to Count do
s := s + MyArray[i];
Amount := s;
end;

begin
ClrScr;
WriteToFile(MainArray, n);
ReadFromFile(NewArray, n);
for i := 1 to n do
Write(NewArray[i]:0:3, ' ');
WriteLn;
WriteLn('Amount - ', Amount(NewArray, n):0:3);
ReadKey;
end.

Лабораторная работа №13

program laba13_1;
uses crt;
const
n = 3;
FilePath = 'a:\data.dat';
type
TRailway = record
Date: string[12];
RunNumber: integer;
FinalPoinOfDest: string[20];
DepartureTime: string[6];
NumberOfCompartments: integer;
NumberOfReservedSeats: integer;
end;
var
Railways: array [1..n] of TRailway;
i: integer;

procedure FillRailwayRecord(var Railway: TRailway);
begin
ClrScr;
with Railway do
begin
Write('Enter date >> ');
ReadLn(Date);
Write('Enter run number >> ');
ReadLn(RunNumber);
Write('Enter final poin of destenation >> ');
ReadLn(FinalPoinOfDest);
Write('Enter departure time >> ');
ReadLn(DepartureTime);
Write('Enter number of compartments >> ');
ReadLn(NumberOfCompartments);
Write('Enter number of reserved seats >> ');
ReadLn(NumberOfReservedSeats);
end;
ClrScr;
end;

procedure WriteRecordToFile(Railway: TRailway);
var
hFile: file of TRailway;
begin
Assign(hFile, FilePath);
Rewrite(hFile);
Write(hFile, Railway);
Close(hFile);
end;

procedure ReadRecordFromFile(var Railway: TRailway);
var
hFile: file of TRailway;
begin
Assign(hFile, FilePath);
Reset(hFile);
Read(hFile, Railway);
Close(hFile);
end;

procedure WriteRecordToScreen(Railway: TRailway);
begin
ClrScr;
with Railway do
begin
WriteLn('Date - ', Date);
WriteLn('Run number - ', RunNumber);
WriteLn('Final poin of destenation - ', FinalPoinOfDest);
WriteLn('Departure time - ', DepartureTime);
WriteLn('Number of compartments - ', NumberOfCompartments);
WriteLn('Number of reserved seats - ', NumberOfReservedSeats);
end;
end;

begin
for i := 1 to n do
FillRailwayRecord(Railways[1]);
for i := 1 to n do
WriteRecordToFile(Railways[1]);
for i := 1 to n do
ReadRecordFromFile(Railways[1]);
for i := 1 to n do
WriteRecordToScreen(Railways[1]);
ReadKey;
end.