Var a: array[1..100] of integer;
i, n, p: integer;
Begin
Write ('Сколько элементов? '); Readln (n);
P:=1;
for i:=1 to n do
begin
a[i]:= Random(46)-19;
writeln (a[i],' ');
if i mod 2 <> 0 then P:=P*a[i];
end;
Writeln('Произведение элементов с нечетными номерами:', P);
readln;
End.
11. Сконструируйте программу, которая удаляет начальные пробелы в строке.
Решение:
Program primer;
var
st:string[80];
begin
writeln('Удаление начальных пробелов строки');
write('введите строку:');
readln(st);
while (pos(' ',st) = 1) and (length(st)>0) do
delete(st,1,1);
write('Строка без начальных пробелов:',st);
readln; end.
12. Сконструируйте программу вычисления значений функции F1, аргумент которой задан интервалом целых значений отрезка [a1, b1]. Шаг изменения значений аргумента принять равным единице. Данные для решения: F1=Tg(x), [a1, b1]=[-15,5].
Решение:
Program zadanie1;
uses crt;
var i,x:integer;
f1:real;
begin
clrscr;
writeln('Vicislenie znachenia fynkcii F1=Tg(x)');
writeln('---------------------------------------');
for i:=-15 to 5 do begin
x:=i;
f1:=sin(x)/cos(x);
writeln('Znachenie fynkcii F1 pri x = ',x, ' ->>', ' F1', ' = ', f1:5:2);
writeln('----------------------------------------------------'); end;
readln;
end.
13. Создайте массив типа byte, считайте его в не типизированный файл. Найдите среднее арифметическое его элементов.
Решение:
Uses
Crt;
Var
F:File;
M:array [1..100] of byte;
sum:longint;
i,n:integer;
name:string[12];
Procedure BwrFile;
Begin
Write('vvedite ima file:');
Readln(name);
Assign(f,Name);
Rewrite(f);
BlockWrite(f,M,n);
Close(f);
Writeln('file sozdan');
Reset(f);
Sum:=0;
BlockRead(f,M,n);
Close(f);
For i:=1 to n do
sum:=sum+m[i];
End;
Begin
ClrScr;
Randomize;
Writeln('vvedite kol-vo elementov massiva:');
Readln(n);
For i:=1 to n do
begin
M[i]:=Random(255);
end;
BwrFile;
Writeln('srednee znachenie chisel,');
Writeln('zapisannix v file ',sum/n:6:2);
Readln;
End.
14. Сконструируйте программу, которая - вводит данные с клавиатуры и формирует текстовый файл на диске. Данные на диске должны располагаться согласно таблице и занимать n строк; - читает с диска сформированный файл и выводит этот файл на экран.
Токарный станок 0.05 10-10
Колодочный тормоз 1 10-7 - 10-6
Подшипник скольжения 10 10-8 - 10-7
Решение:
program task1;
uses crt;
var
f : text;
a,b,c : array[1..5] of string;
I : integer;
begin
clrscr;
assign(f,'tabl.txt');
rewrite(f);
for i:=1 to 5 do
begin
write('название'); readln(a[i]);
write('допуск'); readln(b[i]);
write('материал'); readln(c[i])
end;
for i:=1 to 5 do
begin
writeln(f,a[i]);
writeln(f,b[i]);
writeln(f,c[i])
end;
close (f);
clrscr;
gotoxy(5,1); write('название');
gotoxy(25,1); write('допуск');
gotoxy(50,1); write('материал');
reset(f);
for i:=1 to 5 do
begin
readln(f,a[i]); readln(f,b[i]); readln(f,c[i]);
gotoxy(8,i+1); write(a[i]);
gotoxy(28,i+1); write(b[i]);
gotoxy(52,i+1); write(c[i])
end;
close(f);
readln; end.
15. Сконструируйте программу для вычисления площади поверхности параллелепипеда. При реализации программы должны выполниться следующие условия:
а) программа должна быть реализована с помощью модуля созданного пользователем;
б) для нахождения площади должна использоваться функция.
Решение:
Модуль
Unit P151;
Interface
Var
A1, A2, A3 : integer;
Function Plochad (var a,b,c : integer):integer;
Implementation
Function Plochad;
Begin
Plochad:=2*a*b+2*a*c+2*b*c;
End;
Begin
End.
Программа
Program t12;
Uses P151;
Var
rez: integer;
begin
writeln ('введите длину'); readln(a1);
writeln ('введите ширину'); readln(a2);
writeln ('введите высоту'); readln(a3);
rez:=Plochad(a1,a2,a3);
writeln(rez);
readln;
end.
16. Сконструируйте программу, с помощью которой происходит запись данных о студентах (ФИО, год рождения) в новый типизированный файл.
Решение:
program DemoWrite;
uses CRT;
type Stud = record
Fam : string[10];
Name : string[10];
Age : 0..150;
end;
var FStud : file of Stud; GrRec : Stud;
FileName : string[30]; n : word;
Begin
ClrScr;
Writeln('Откроем файл для записи данных');
write('Введите имя файла : '); ReadLn(FileName);
Assign(FStud, FileName);
Rewrite(FStud);
n := 0;
with GrRec do
while True do
begin
ClrScr; n := n + 1;
WriteLn('Вводите данные для ',n:2,'студента ');
WriteLn('Для окончания ввода наберите "*" ');
WriteLn;
Write('Фамилия студента: '); ReadLn(Fam);
if Fam <> '*' then
begin
Write('Имя студента: '); ReadLn(Name);
Write('Возраст : '); ReadLn(Age);
Write(FStud, GrRec); ClrScr;
end
else
begin
WriteLn('Информация в файл ',FileName,'записана');
WriteLn('Для продолжения нажмите любую клавишу.');
repeat until KeyPressed;
Close(FStud);
Exit
end; end; End.
17. В массиве хранятся данные об учениках класса: школа, фамилия, класс. Вывести список учеников, которые учатся в восьмом классе. Задачу реализовать с помощью записи. Количество учащихся задавать программно.
Решение:
Program LipovsevM;
Uses
Crt;
Type
Uchenik=record
Shkola : integer;
Fam : string[15];
Klass : integer;
end;
Var
I,n,a,j : integer;
Massiv : array[1..100] of Uchenik;
Procedure
Poisk;
Begin
for i:=1 to n do
if massiv[i].klass=9
then
with massiv[i] do
writeln(Shkola:4,' ',Fam:15,' ',klass);
End;
Begin
ClrScr;
writeln('введите число учеников ');
write('->');
read(n);
for i:=1 to n do
begin
writeln('Введите через пробел номер школы и фамилию учащегося ');
write('->');
with massiv[i] do
begin
readln(Shkola,Fam);
write('Введите класс ученика (число) ->');
read(Klass);
end;
end;
writeln('Ученики 9-ых классов');
writeln('Школа Фамилия Класс');
writeln('---------------------------------');
Poisk;
ReadKey;
End.
18. Опишите запись Pupil, содержащую информацию об учащихся, сдавших зачет по 3 предметам. Выведите на экран фамилии и имена отличников, хорошистов, троишников по желанию пользователя. Количество учащихся задавать программно.
Решение:
Program qq;
Uses Crt;
Type
Pupil=Record
name,surname:String[20];
s1,s2,s3:1..5;
End;
Type
Myarray=Array [1..5] of pupil;
Var
Mas1:MyArray;
i,n,a:Integer;
Procedure Vvod(Var Mas:Myarray);
Begin
Write('введите число учеников '); ReadLn(n);
WriteLn;
For i:=1 to n do
With Mas[i] do
Begin
writeln('Vvedite cherez probel name and surname');
WriteLn('Ученик ',i,'ый');
Write('Фамилия Имя: ');
ReadLn(surname, name);
writeln('vvedite cheraz probel ocenki');
Write('Оценка 1');
ReadLn(s1, s2,s3);
WriteLn; End; End;
Procedure Vivod(Var Mas:myarray);
Begin
Writeln('Чьи фамилии вы хотите увидеть');
Writeln('1-отличники 2-хорошисты 3- троишники');
Readln(a);
For i:=1 to n do
With Mas[i] do
If (s1=5)and(s2=5)and(s3=5)and(a=1) Then
begin
WriteLn('отличники'); WriteLn(surname,' ',name); end
Else
If (s1>=4)and(s2>=4)and(s3>=4)and(a=2) Then
begin
WriteLn('хорошисты'); WriteLn(surname,' ',name); end
Else
If (s1>=3)and(s2>=3)and(s3>=3)and(a=3) Then
begin
WriteLn('троишники'); WriteLn(surname,' ',name); end
Else
Begin
Writeln('двоишники'); writeLn(surname,' ',name); end;
End;
Begin
ClrScr;
Vvod(Mas1);
Vivod(Mas1);
ReadLn; End.
19. Сконструируйте программу в для расчета значения функции f ( x ):
Решение:
program zadanie4;
uses crt;
var x:integer;
f,z:real;
begin
clrscr;
writeln('Vicislenie znachenia fynkcii f');
writeln('------------------------------');
writeln('vvedite x');
readln(x);
if (x>=1) and (x<=5) then
begin
f:=x*x+3*x;
writeln(f:5:2);
end;
if x<1 then
begin
f:=cos(2*x+3);
writeln(f:5:2); end;
if x>5 then
begin
f:=sqr(sin(x+8));
writeln(f:5:2); end
else
writeln('Net rechenii');
readln;
end.
20. Сконструируйте программу, которая выводит таблицу степеней двойки (от нулевой до десятой).
Решение:
Program qqq;
var
n: integer;