If copy (a,1,1)=’T’ then
Writeln(a);
End;
Close(f);
Readln;
End.
Задание 9. Имеется текстовый файл посчитать кол-во строк начинающихся на букву А
Program as; readln(f,a);
Uses crt; if copy(a,1,1)=’A’ then k:=k+1;
Var F:text; a:string; k:integer; end;
Begin clrscr; close(f);
Assign(f,’abc.txt’); writeln(k);
Reset(f); end.
While not(Eof(f)) do begin
Задание10. Все четные строки этого файла записать во 2 файл, а не четные в 3 файл
Program as;
Uses crt;
Var F,t,g:text; a:string; k:integer;
Begin clrscr;
Assign(f,’abc.txt’); assign(t,’cop.txt’); Assign(g,’cap.txt’);
Reset(f); rewrite(t); rewrite(g);
While not(Eof(f)) do begin
Readln(f,a);
K:=k+1;
If k mod 2=0 then writeln(t,a) else writeln(g,a);
End;
Close(f); close(t); close(g);
End.
Задание11. Найти сумму элементов одномерного массива рез-т записать в текстовый файл
Program as;
Uses crt;
Var f:text; a:array[1..10] of integer; i,s:integer;
Begin clrscr;
Writeln(‘Ввод массива’);
Assign(f,’abc.txt’); rewrite(f);
For i:=1 to 10 do begin write(‘Введи’,I,’ элемент массива’);
Readln(a[i]);
End;
Writeln;
For i:=1 to 10 do s:=s+a[i];
Writeln(f,s);
Close(f);
End.
Задание12. Создать текстовый файл и записать в него все числа от 5 до 25
Program as;
Uses crt;
Var F:text; a:string; i:integer;
Begin clrscr;
Assign (f,’text.txt’);Rewrite (f);
For i:=5 to 25 do
Writeln(f,i);
Close(f);
End.
Задание13. Дано слово удвоить его каждую букву и записать его в текст. файл
Program as;
Uses crt;
Var f:text; a:string; I,s:integer;
Readln(a);
For i:=1 to length (a)*2 do begin insert
Copy(a,I,1),a,i);
I:=i+1;
End;
Writeln(f,a);
Close(f);
End.
Задание14. Имеется текстовый файл посчитать кол-во строк начинающихся на букву М
Program as;
Uses crt;
Var F:text; a:string; k:integer;
Begin clrscr;
Assign(f,’abc.txt’);
Reset(f);
While not(Eof(f)) do begin
readln(f,a);
if copy(a,1,1)=’М’ then k:=k+1;
end; close(f);
writeln(k);
end.
Задание 15. Создать текстовый файл и записать в него 6 одинаковых чисел
Program as;
Uses crt;
Var F:text; a:string; i:integer;
Begin clrscr;
Assign (f,’text.txt’);
Rewrite (f);
For i:=1 to 6 do
Writeln(f,6);
Close(f);
End.
Записи в Паскале
Задание 1. Составить список учебной группы, включающей 25 человек. Для каждого учащегося указать дату рождения, год поступления в техникум, курс, группу, оценки каждого года обучения. Информацию о каждом учащемся оформить в программе в виде записи. Совокупность записей объединить в массив.
Составить программу, которая обеспечивает ввод полученной информации, распечатку ее в виде таблицы, а также распечатку информации о отличниках
Program Pascal;
Uses crt;
type student=record
fio: string;
d_r:1..31; {день рождения}
m_r:1..12; {месяц рождения}
god_r:1965..1975; {год рождения}
god_p:2004..2008; {год поступления}
group:string; {название группы}
ocenki:array[1..3,1..5] of integer; {оценки по трем предметам}
end;
var
s1: array[1..25] of student;
i,j,x:integer;
ch:char;
f:boolean;
begin
clrscr;
for i:=1 to 25 do begin
writeln('Сведения о ',i,' студенте');
with s1[i] do begin
write('ФИО:');readln(fio);
write('Дата рождения:.. г.');
x:=wherex;
gotoxy(x-13,wherey); read(d_r);
gotoxy(x-10,wherey-1); read(m_r);
gotoxy(x-7,wherey-1); read(god_r);
if keypressed then begin
ch:=readkey;
if ch=#0 then ch:=readkey;
end;
write('Год поступления: ');readln(god_p);
write('Группа: ');readln(group);
j:=0;
for i:=god_p to 2008 do begin
j:=j+1;
writeln('Оценки за ',i,' год:');
write('Математика: ');readln(ocenki[1,j]);
write('Информатика: ');readln(ocenki[2,j]);
write('История: ');readln(ocenki[3,j]);
end;
end;
writeln;
end;
writeln('список отличников');
for i:=1 to 25 do begin
with s1[i] do begin
j:=0;
f:=true;
for i:=god_p to 2008 do begin
j:=j+1;
if not((ocenki[1,j]=5) and (ocenki[1,j]=5) and (ocenki[1,j]=5)) then f:=false;
end;
if f=true then writeln(fio,', группа ',group,', год поступления ',god_p);
end;
end;
writeln('Для выхода нажмите Enter');
readln;
end.
Задание 2. Разработать программу формирования файла, содержащего сведения о студентах. Каждый элемент этого файла должен содержать следующие данные: номер группы; номер в группе по списку; фамилию, имя, отчество; год рождения; оценки за последнюю сессию
Program Pascal;
Uses crt;
Const fname='students.dat';
n=5; {количество предметов за последнию сессию}
Type st=record
n_group:integer; {номер группы}
n_sp:integer; {номер в группе по списку}
fam:string; {фамилия}
im:string; {имя}
ot:string; {отчество}
god_r:integer; {год рождения}
oc:array [1..n] of integer; {оценки за последнию сессию}
end;
Var t:array[1..30] of st;
i,ch,j:integer;
h: file of st;
begin
write('Введите количество студентов в группе: '); readln(ch);
for i:=1 to ch do begin
writeln('Сведения о ',i,' студенте');
write('Номер группы: '); readln(t[i].n_group);
write('Номер в группе по списку: '); readln(t[i].n_sp);
write('Фамилия: '); readln(t[i].fam);
write('Имя: '); readln(t[i].im);
write('Отчество: '); readln(t[i].ot);
write('Год рождения: '); readln(t[i].god_r);
writeln('Оценки за последнию сессию: ');
for j:=1 to n do begin
case j of
1:write('Математика: ');
2:write('Физика: ');
3:write('Химия: ');
4:write('Культурология: ');
5:write('История: ');
end;
readln(t[i].oc[j]);
if not ((t[i].oc[j]>0) and (t[i].oc[j]<=5)) then begin
writeln('Неверно введена оценка! Повторите ввод.');
j:=j-1;
end;
end;
writeln;
end;
Assign (h,fname);
{$I-}
reset(h);
If Ioresult<>0 then rewrite(h);
{$I+}
for i:=1 to ch do write(h,t[i]);
close(h);
writeln('Данные занесены в файл ',fname);
readln;
end.
Задание 3. В ГИБДД имеется следующая информация об автомобилях и их владельцах:
а) марка машины;
б) номер машины;
в) Фамилия владельца.
Необходимо организовать поиск количества автомобилей определенной марки. Информацию об автомобилях и их владельцах оформить в виде записей, хранимых в файле. Ввод данных в запись и сохранение записи в файле
Program N10_1;
Uses Crt;
Const fname='spisok.dat';
{Имя файла, в который будет производиться запись}
Type Person=record
marka:string;
number:string;
familia:string;
end;
Var auto:array[1..5] of person;
i:integer;
h: file of person;
begin
Clrscr;
auto[1].marka:='Мерседес';
auto[1].number:='235';
auto[1].familia:='Иванов';
auto[2].marka:='Мерседес';
auto[2].number:='289';
auto[2].familia:='Петров';
auto[3].marka:='Волга';
auto[3].number:='365';
auto[3].familia:='Сидоров';
auto[4].marka:='Жигули';
auto[4].number:='896';
auto[4].familia:='Кузнецов';
auto[5].marka:='Вольво';
auto[5].number:='957';
auto[5].familia:='Тимофеев';
Assign (h,fname);
{$I-}
reset(h);
If Ioresult<>0 then rewrite(h);
{$I+}
for i:=1 to 5 do begin
write(h,auto[i]);
end;
writeln('Данные занесены в файл ',fname);
write('Нажмите Enter');
readln;
end.
Выполнение задания
Program N10_2;
Uses Crt;
Const fname='spisok.dat';
Type Person=record
marka:string;
number:string;
familia:string;
end;
Var auto:array[1..5] of person;
i,j,l,q:integer;
h: file of person;
s:string;
f:boolean;
begin
Clrscr;
Assign (h,fname);
Reset (h);
i:=0;
While Eof (h) = false do begin
i:=i+1;
Read(h,auto[i]);
end;
Close(h);
writeln('Информация, считанная из файла ',fname);
writeln;
q:=i;
for j:=1 to q do begin
with auto[j] do begin
gotoxy(1,wherey);
write(marka);
gotoxy(15,wherey);
write(number);
gotoxy(20,wherey);
writeln(familia);
end;
end;
writeln;
write('Введите интересующую Вам марку автомобиля: ');
readln(s);
writeln;
l:=0;
for j:=1 to q do begin
with auto[j] do begin
if marka=s then begin
l:=l+1;
gotoxy(1,wherey);
write(number);
gotoxy(10,wherey);
writeln(familia);
end;
end;
end;
writeln('Количество автомобилей данной марки - ',l);
write('Нажмите Enter');
readln;
end.
Задание 4. На телефонном узле в конце каждого квартала составляется на каждого абонента ведомость оплаты междугородных телефонных разговоров (с 7-ю городами) в течение квартала (3 месяца)
Написать программу, которая вводит исходные данные, выполняет расчеты и выводит на экран:
- Исходные данные в виде таблицы, где указаны коды городов, с которыми велись разговоры, общее время разговора с каждым городом за один месяц, стоимость одной минуты разговора (меняется каждый месяц);
- Общая продолжительность разговоров с каждым городом за квартал;
- Плата за каждый месяц;
- Общая плата за 3 месяца;
- Город с наибольшей платой.
program kursovik;
uses crt;
type
telef=record
kod:integer;
tpm1,tpm2,tpm3,price1,price2,price3:integer;
end;
telef1=record
kod,tpm,ob:integer;
pr1,pr2,pr3:integer;
end;
var
a:file of telef;
res:array[1..7] of telef1;
i,j,s,aa,max:integer;
begin;
textbackground(10);
clrscr;
textcolor(0);
gotoxy(15,2);
writeln('Курсовая работа студента группы 01М22 Белоусовой Е.В.');
gotoxy(27,3);
writeln('Задание на курсовую работу:');
textcolor(4);
writeln;
writeln(' На телефонном узле в конце каждого квартала составляется на каждого абонента');
writeln('ведомость оплаты междугородных телефонных разговоров (с 7-ю городами) в течение');
writeln('квартала (3 месяца).');
writeln(' Написать программу, которая вводит исходные данные, выполняет расчеты и ');
writeln('выводит на экран:');
writeln(' - исходные данные в виде таблицы, где указаны коды городов, с которыми велись');
writeln(' разговоры, общее время разговора с каждым городом за один месяц, стоимость');
writeln(' одной минуты разговора (меняется каждый месяц);');
writeln(' - общая продолжительность разговоров с каждым городом за квартал;');
writeln('плата за каждый месяц;');
writeln('общая плата за 3 месяца;');
writeln('город с наибльшей платой.');
gotoxy(27,18);
textcolor(0);
writeln('Требование к вводу информации');
textcolor(4);
writeln(' - исходные данные вводятся с клавиатуры.');
textcolor(0);
writeln;
writeln(' Требование к выводу результатов');
textcolor(4);
writeln(' - результат выводятся на экран.');
textcolor(14);
writeln;
writeln(' Для продолжения работы программы нажмите ENTER');
readln;
clrscr;
textcolor(0);
writeln(' Требования к структуре программы ');
textcolor(4);
writeln(' Программа должна состоять из следующих частей:');
writeln(' - вывод заставки с информацией о студенте и задании;');
writeln(' - ввод данных (выполняется в диалоговом режиме);');
writeln(' - вывод исходных данных и результатов (на один экран).');
textcolor(0);
writeln(' Требования к размещению исходных данных внутри программы ');
textcolor(4);
writeln(' Исходные данные располагаются в файле, компонентами которого являются записи.');
writeln('Структура каждой записи и типы ее полей выбираются в зависимости от задания.');
textcolor(0);
writeln(' Используемые цвета ');
textcolor(4);
writeln(' - черный(0),красный(4), светло-зеленый(10), желтый(14)');
textcolor(14);
gotoxy(18,24);
writeln('Для продолжения работы программы нажмите ENTER');
readln;
clrscr;
assign(a,'kurs.dat');
rewrite(a);
textcolor(0);
for i:=1 to 7 do
begin