Смекни!
smekni.com

Редактирование и отладка программ с помощью Pascal (стр. 10 из 12)

write('Введите код ',i,'-го города: ');

readln(tel.kod);

write('Введите общее время разговора с городом ',tel.kod,' за 1-й месяц: ');

readln(tel.tpm1);

write('Введите стоимость одной минуты разговора с городом ',tel.kod,' в 1-м месяце: ');

readln(tel.price1);

write('Введите общее время разговора с городом ',tel.kod,' за 2-й месяц: ');

readln(tel.tpm2);

write('Введите стоимость одной минуты разговора с городом ',tel.kod,' в 2-м месяце: ');

readln(tel.price2);

write('Введите общее время разговора с городом ',tel.kod,' за 3-й месяц: ');

readln(tel.tpm3);

write('Введите стоимость одной минуты разговора с городом ',tel.kod,' в 3-м месяце: ');

readln(tel.price3);

write(a,tel);

end;

close(a);reset(a);

s:=1;

while not eof(a) do begin

read(a,tel);

res[s].kod:=tel.kod;

res[s].tpm:=tel.tpm1+tel.tpm2+tel.tpm3;

res[s].pr1:=tel.tpm1*tel.price1;

res[s].pr2:=tel.tpm2*tel.price2;

res[s].pr3:=tel.tpm3*tel.price3;

res[s].ob:=res[s].pr1+res[s].pr2+res[s].pr3;

s:=s+1;

end;close(a);

clrscr;

writeln('Код города Общее время разговора за каждый месяц Стоимость минуты разговора');

reset(a);

while not eof(a) do

begin

read(a,tel);

writeln(' ',tel.tpm1,' ',tel.price1);

writeln(' ',tel.kod,' ',tel.tpm2,' ',tel.price2);

writeln(' ',tel.tpm3,' ',tel.price3);

end;

textcolor(14);

gotoxy(18,24);

writeln('Для продолжения работы программы нажмите ENTER');

readln;

clrscr;

textcolor(0);

writeln('Код города Общее время разговора за квартал Плата за месяц Общая плата');

for i:=1 to 7 do

begin

aa:=res[i].kod;

writeln(' ',res[i].pr1);

writeln(' ',aa,' ',res[i].tpm,' ',res[i].pr2,' ',res[i].ob);

writeln(' ',res[i].pr3);

end;

max:=res[1].ob;

for i:=1 to 6 do begin

if res[i+1].ob>max then

begin

max:=res[i+1].ob;

j:=i+1;

end;

end;

writeln('Город с наибольшей платой: ',res[j].kod);

textcolor(14);

gotoxy(18,24);

writeln('Для завершения работы программы нажмите ENTER');

readln;

end.

Задание 5 Упорядочить список студентов по среднему балу и распечатать его

Program spisok_grupp;

Uses Crt;

Const kurs=3;

Const kol=5;

Type

sved=record

famil:string[25];

datar:string[8];

god: integer;

gruppa: integer;

ocenki:array[1..3,1..5] of integer;

srball:array[1..25] of real;

End;

Var

spisok: array[1..25] of sved;

i,i1,j, s,mesto,n,g:integer;

max,t:real;

q:string[25];

Begin

ClrScr;

writeln('Введите количество учеников');

readln(n);

for i:=1 to n do

With spisok[i] do

Begin

Writeln ('Фамилия ',i,' студента');

Readln (famil);

Writeln('Дата рождения');

Readln (datar);

Writeln ('Год поступления');

Readln (god);

Writeln ('Группа');

Readln (gruppa);

s:=0;

for i1:=1 to kurs do

begin

writeln('Оценки ',i1,' года');

for j:=1 to kol do

Begin

Writeln (j,' Предмет');

Readln (ocenki[i1,j]);

s:=s+ocenki[i1,j];

End;

end;

srball[i]:=s/(kol*kurs);

ClrScr;

End;

writeln('Фамилия':8,'Дата рождения':16,'Год поступления':18,'Курс':7,'Группа':8);

for i:=1 to n do

begin

with spisok[i] do write(famil:8,datar:16,god:18,kurs:7,gruppa:8);

writeln;

writeln;

for g:=1 to kurs do

begin

write(g,' год:');

for j:=1 to kol do

with spisok[i] do write(ocenki[g,j]:4);

writeln;

end;

with spisok[i] do writeln('Средний бал =',srball[i]:6:2);

writeln;

end;

writeln;

writeln('По порядку');

for j:=1 to n do

Begin

max:=spisok[j].srball[j];

mesto:=j;

for i:=j to n do

if spisok[i].srball[i]<=max then

Begin

max:=spisok[i].srball[i];

mesto:=i;

End;

t:=spisok[j].srball[j];

spisok[j].srball[j]:=spisok[mesto].srball[mesto];

spisok[mesto].srball[mesto]:=t;

q:=spisok[j].famil;

spisok[j].famil:=spisok[mesto].famil;

spisok[mesto].famil:=q;

with spisok[j] do writeln(famil:8,srball[j]:6:2);

End;

End.

Задание 6. Запись с вариантами

var R = Record

rem: string;

Case byte of

3: (n:integer);

5: (x,y,z:char);

'a': (i,j:byte);

end;

begin

R.rem:='запись с ваpиантами';

R.n:=25000;

write(R.i,R.x,R.j,R.y); {168и97a}

{ord('и')=168, ord('a')=97, 168+97*256=25000}

end.

Задание 7. Пример объявления типа запись

type Men = Record

FIO,Adress: string;

Year: byte;

End;

var A,B: Men;

begin

A.FIO:='Иванов И.И.';

A.Adress:='пp. Ленина, д. 40, кв. 10';

A.Year:=1981;

end.

Задание 8. Составить программу в которой известны Фамилия, адрес и номера Телефонов 15 человек, организовать поиск номера телефона по фамилии абонента

Program as;

Type

person=record

surname: string[40]

adres: string[20]

nomer: integer

var

mas:array[1..15] of person;

i:integer; poisk: string;

procedure Input.date;

var

begin

writeln(‘Введи данные’,I,’ абонента’);

writeln(‘Фамилия’);

readln(mas[i].surname);

writeln(‘адрес’);

readln(mas[i].adres);

writeln(‘Номер телефона’);

readln(mas[i].nomer);

end;

Procedure write date;

Begin

With mas[i] do

Begin

Writeln(‘фамилия’,surname);

Writeln(‘адрес’,adres);

Writeln(‘номер’,nomer);

End;

End;

Begin

For i:=1 to 15 do Input.date;

Writeln(‘Введи фамилию абонента’);

Readln(poisk);

For i:=1 to 15 do

If mas[i] nomer=poisk then write date;

End.

Задание 9. Создать список учеников класса и вывести на экран Фамилии и Имена в виде таблицы

Program as;

Uses crt;

Type

Klass=record

Surname:string[15];

Name:string[10];

End;

Var A:array [1..10] of klass;

I:integer;

Begin clrscr;

For i:=1 to 10 do begin

Writeln(‘введи фамилию’);

Readln(a[i].surname);

Writeln(‘введи имя’);

Readln(a[i].name);

End;

Writeln;

Clrscr;

For i:=1 to 10 do writeln(a[i].surname,’ ‘,a[i].name);

End.


Задание10. Известны данные о 6 сотрудниках фирмы Фамилия, возраст, и отношение к воен.службе. Вывести на экран фамилии всех военнообязанных сотрудников

Program as;

Uses crt;

Type

S=record

N:string[10]; voz:integer;

V:string[8];

End;

Var a:array[1..6] of s;

I:integer;

Begin clrscr;

For i:=1 to 6 do begin

Writeln(‘какая у тебя фамилия’);

Readln(a[i].s);

Writeln(‘сколько тебе лет’);

Readln(a[i].voz);

Writeln(‘ты относешся к военной части’);

Readln(a[i].v);

End; Writeln; Clrscr;

For i:=1 to 6 do if a[i].v=’DA’ then writeln(a[i].s);

End.

Задание11. Даны названия 6 городов и стран, среди них есть город находящийся в Италии напечатать их название

Program as;

Uses crt;

Type

S=record

strana: string[10];

gorod:string[8];

End;

Var a:array[1..6] of s;

I:integer;

Begin clrscr;

For i:=1 to 6 do begin

Writeln(‘страна?’);

Readln(a[i].strana);

Writeln(‘город’);

Readln(a[i]. gorod);

End; Writeln; Clrscr;

For i:=1 to 6 do if a[i]. strana =’italia’ then writeln(a[i].gorod);

End.

Задание12. Даны названия 10 стран и частей света. Напечатать на экране все страны находящиеся в Азии

Program as;

Uses crt;

Type

S=record

strana: string[10];

ch:string[8];

End;

Var a:array[1..10] of s;

I:integer;

Begin clrscr;

For i:=1 to 10 do begin

Writeln(‘страна’);

Readln(a[i].strana);

Writeln(‘часть света’);

Readln(a[i]. ch);

End; Writeln; Clrscr;

For i:=1 to 10 do if a[i]. ch =’Azia’ then writeln(a[i]. strana);

End.

Задание13. Из ведомости 3-х студентов с их оценками (порядковый номер, Ф.И.О. и три оценки) определить количество отличников и средний бал каждого студента

Program Spic;

Type wed = record {Тип wed включает 3 поля: n, fio, bal}

n: integer;

fio: string[40];

bal: array [1..3] of integer {Поле bal – массив из 3 оценок }

end;

Var spisok: wed; {Запись spicok типа wed}

i, j, kol, s: integer; sr: real;

Begin

kol:=0; {kol- количество отличников}

With spisok do {with присоединяет имя записи spisok ко всем }

For i:=1 to 3 do { полям внутри цикла For по i }

begin

n:=i;

Write (' Vvedite FIO # ', i,' ');

Readln (fio);

s:=0;

For j:= 1 to 3 do

begin

write ('Vvedite ocenky: ');

readln (bal [j]);

s:= s+ bal [j];

end;

if s=15 then kol:=kol+1; {подсчет количества отличников}

sr:= s/3; writeln (fio, ', Sredniy bal = ', sr:4:1); end;

writeln (' Kolichestvo otlichnikov = ', kol);

readln;

end.

Задание14. Пусть нам необходимо заполнить сведения о студенте (Ф.И.О., дата рождения, адрес, курс и группа), а затем вывести эти сведения на экран

program primer1;

type anketa=record

fio: string[45];

dat_r: string[8];

adres: string[50];

curs: 1..5;

grupp: string[3]

end;

var student: anketa;

begin

writeln (‘введите сведения о студенте’);

{обратите внимание, ввод каждого поля осуществляется отдельно}

writeln (‘введите фамилию, имя и отчество’);

readln (student.fio);

writeln (‘введите дату рождения’);

readln (student.dat_r);

writeln (‘введите адрес’);

readln(student.adres);

writeln (‘введите курс’);

readln(student.curs);

writeln (‘введите группу’);

readln (student.grupp);

writeln (‘ввод закончен’);

writeln;

{обратите внимание, что вывод записи осуществляется по полям}

writeln (‘фамилия студента: ’, student. fio);

writeln(‘ дата рождения: ’, student.dat_r);

writeln(‘ адрес: ’, student.adres);

writeln(‘ курс: ’, student.curs);

writeln(‘ группа: ’, student.grupp);

end.

Задание15. Пусть нам необходимо иметь сведения о многих студентах, например, нашего факультета. Следовательно, необходимо организовать массив записей Паскаля. А затем из общего списка вывести фамилии студентов 2-го курса

program primer 2;

type anketa=record

fio: string[45];

dat_r: string[8];

adres: string[50];

curs: 1..5;

grupp: string[3]

end;

var student: array [1..100] of anketa;

I: integer;

begin

{последовательно вводим каждую запись}

for I:=1 to 100 do

begin

writeln (‘введите сведения о’, I, ‘-м студенте’);

writeln (‘введите фамилию, имя и отчество’);

readln (student[I].fio);

writeln (‘введите дату рождения’);

readln (student[I].dat_r);

writeln (‘введите адрес’);

readln(student[I].adres);

writeln (‘введите курс’);

readln(student[I].curs);

writeln (‘введите группу’);

readln (student[I].grupp);

end;

writeln (‘ввод закончен’);

writeln;

{просматриваем массив записей и выбираем только студентов 2-го курса }

for I:=1 to 100 do

if student[I].curs=2 then

writeln(‘ фамилия студента: ’, student[I].fio);

end.

Строки

Задание 1. Дана последовательность слов. Напечатать те слова последовательности, которые отличны от последнего слова и удовлетворяют свойству: слово симметрично

Program Stroki;

Uses Crt;

Var s,k:string;

a:array[1..100] of string;

i,n,j,l:Integer;

f:boolean;

begin

ClrScr;

{Ввод последовательности слов}

Writeln('Введите последовательность слов:');

Readln(s);

{Запись слов в массив a}

for i:=1 to length(s) do begin

if (s[i-1]<>' ') and (s[i]=' ') and (length(k)<>0) then begin

inc(n);

a[n]:=k;

k:='';

end;

if s[i]<>' ' then k:=k+s[i];

if (i=length(s)) and (length(k)<>0) then begin

inc(n);

a[n]:=k;

k:='';

end;

end;

{Проверка на симметричность слов, содержащихся в массиве а}

l:=0;

for i:=1 to n-1 do begin

f:=false;

if a[i]<>a[n] then

if length(a[i]) mod 2 = 0 then begin

for j:=1 to length(a[i]) div 2 do

if a[i][j]<>a[i][length(a[i])+1-j] then f:=true;

if f=False then begin

l:=l+1;

if l=1 then Write('Симметричные слова: ');

Write(a[i],' ');

end;

end;

end;

Writeln;

if l=0 then Writeln('Симметричные слова отсутствуют');

Write('Нажмите Enter');

Readln;

end.

Задание 2. Дана строка символов. Преобразовать эту строку удалив из нее каждые ">>" и повторив (вставив еще раз) каждую пару символов "<<". После преобразования полученную строку вывести на печать

Program Stroki;

Uses Crt;

Var s:string;

i:integer;

begin

ClrScr;

Write('Введите строку символов: ');

Readln(s);

for i:=1 to length(s) do begin

if (s[i-1]='>') and (s[i]='>') then delete(s,i-1,2);

if (s[i-1]='<') and (s[i]='<') then begin