Вот такое задание помогите решить!!! :
Лабораторная работа
«ЗАПИСИ»
Вариант 18
Создать список клиентов банка.
1.Описать и ввести массив, содержащий 10 записей следующей структуры: фамилия (отдельно ФИО) , адрес, возраст, № счета, счет (руб.) .
2.Вывести массив в табличном виде.
3.Вывести списки клиентов, фамилия которых начинается на заданную с терминала букву.
4. Найти средний возраст клиентов (всех из запроса и всех вообще) .
Другие языки программирования и технологии
Помогите с программированием на Паскаль!
Только что такой на такой же вопрос отвечал, странно это все :)
[quote]
ну вот, на скорую руку сваял, пробуйте, компилируйте, у меня компилятор не установлен, так что протестировать не могу и не хочу. Естественно никакой "защиты от дурака" нет, но поидее должно работать. Все выводы на экран русскими буквами советую переписать транслитом, либо перед компиляцией сконвертировать в досовскую кодировку. Удачи!
зы: написал как понял, ввод чувствителен к регистру.
uses crt;
const num = 10;
type person = record
Name: record
Lname: string[20];
Fname: string[20];
Sname: string[20];
end;
Addr: string[20];
Age: integer;
Account: integer;
Money: real; end;
var clients: array[1..num] of person;
request: array[1..num] of boolean;
tType: array[1..6] of boolean;
i,id: integer;
c: string;
mid: real;
ch: char;
function reqNum: integer;
var i:integer;
begin
for i:=1 to num do
if (request) then reqNum:=reqNum+1;
end;
procedure typeRec(var id:integer; var tname,fname,taddr,tage,taccount,tmoney: boolean);
var i:integer;
begin
writeln(id,'. ');
if (tname and fname) then write(clients[id].Name.Lname, ' ', clients[id].Name.Fname,' ',clients[id].Name.Sname,' ')
else if (tname) then write(clients[id].Name.Lname, ' ', clients[id].Name.Fname[1],'. ',clients[id].Name.Sname[1],'. ');
if (taddr) then write(clients[id].Addr,' ');
if (taccount) then write(clients[id].Account,' ');
if (tmoney) then write(clients[id].Money);
writeln;
end;
procedure fillList;
var i:integer;
begin
for i:=1 to num do
begin
writeln('заполните запись №',i,', в формате Фамилия, Имя, Отчество, Адрес, Возраст, Номер счета, Деньги на счете');
read(clients.Name.Lname,clients.Name.Fname,clients.Name.Sname,clients.Addr,clients.Age,clients.Account,clients.Money);
end;
writeln('все записи заполнены, нажмите Enter');
readln;
ClrScr;
end;
procedure typeAll;
var i:integer;
begin
for i:=1 to num do
typeRec(i,tType[1],tType[2],tType[3],tType[4],tType[5],tType[6]);
end;
procedure typeByName(var c:char);
var i:integer;
begin
for i:=1 to num do
if (clients.Name.Lname[1]=c) then
begin
typeRec(i,tType[1],tType[2],tType[3],tType[4],tType[5],tType[6]);
request:=true;
end;
end;
function mAge(all:boolean): real;
var i:integer;
age: real;
begin
for i:=1 to num do
if (not all) then
begin
if (request) then mAge:=age+clients.Age;
end else mAge:=age+clients.Age;
if (all) then age:=age/num else age:=age/reqNum;
mAge:=age;
end;
begin
clrscr;
for i:=1 to num do
request:=false;
fillList;
writeln('введите: ');
repeat
readln(c);
if (c='tall') then typeAll
else if (c='tbname') then begin write('введите первую букву фамилии: '); readln(ch); typeByName(ch); end
else if (c='tbid') then begin write('введите номер клиента'); readln(id); typeRec(id,tType[1],tType[2],tType[3],tType[4],tType[5],tType[6]); end
else if (c='tmage') then begin writeln('всех клиентов? (y,n)'); readln(ch); if (ch='y') then mid:=mAge(true) else mid:=mAge(false); writeln('средний возраст: ',mid:4:2); end
else if (c='clnscr') then clrscr;
until c='exit';
end.
значения c и что при них происходит:
tall выводит все записи
tbname выводит записи по совпадению 1й буквы в фамилии
tbid выводит запись по номеру
tmage выводит средний возраст, будет запрос, всех ли клиентов, если не всех, то считается средний возраст клиентов из последнего запроса по букве в фамилии, если такого запроса не было, то результата быть не должно и скорее всего вылетит ошибка, потомучто будет деление на ноль :)
clnscr очищает экран
exit выход
[/quote]
[quote]
ну вот, на скорую руку сваял, пробуйте, компилируйте, у меня компилятор не установлен, так что протестировать не могу и не хочу. Естественно никакой "защиты от дурака" нет, но поидее должно работать. Все выводы на экран русскими буквами советую переписать транслитом, либо перед компиляцией сконвертировать в досовскую кодировку. Удачи!
зы: написал как понял, ввод чувствителен к регистру.
uses crt;
const num = 10;
type person = record
Name: record
Lname: string[20];
Fname: string[20];
Sname: string[20];
end;
Addr: string[20];
Age: integer;
Account: integer;
Money: real; end;
var clients: array[1..num] of person;
request: array[1..num] of boolean;
tType: array[1..6] of boolean;
i,id: integer;
c: string;
mid: real;
ch: char;
function reqNum: integer;
var i:integer;
begin
for i:=1 to num do
if (request) then reqNum:=reqNum+1;
end;
procedure typeRec(var id:integer; var tname,fname,taddr,tage,taccount,tmoney: boolean);
var i:integer;
begin
writeln(id,'. ');
if (tname and fname) then write(clients[id].Name.Lname, ' ', clients[id].Name.Fname,' ',clients[id].Name.Sname,' ')
else if (tname) then write(clients[id].Name.Lname, ' ', clients[id].Name.Fname[1],'. ',clients[id].Name.Sname[1],'. ');
if (taddr) then write(clients[id].Addr,' ');
if (taccount) then write(clients[id].Account,' ');
if (tmoney) then write(clients[id].Money);
writeln;
end;
procedure fillList;
var i:integer;
begin
for i:=1 to num do
begin
writeln('заполните запись №',i,', в формате Фамилия, Имя, Отчество, Адрес, Возраст, Номер счета, Деньги на счете');
read(clients.Name.Lname,clients.Name.Fname,clients.Name.Sname,clients.Addr,clients.Age,clients.Account,clients.Money);
end;
writeln('все записи заполнены, нажмите Enter');
readln;
ClrScr;
end;
procedure typeAll;
var i:integer;
begin
for i:=1 to num do
typeRec(i,tType[1],tType[2],tType[3],tType[4],tType[5],tType[6]);
end;
procedure typeByName(var c:char);
var i:integer;
begin
for i:=1 to num do
if (clients.Name.Lname[1]=c) then
begin
typeRec(i,tType[1],tType[2],tType[3],tType[4],tType[5],tType[6]);
request:=true;
end;
end;
function mAge(all:boolean): real;
var i:integer;
age: real;
begin
for i:=1 to num do
if (not all) then
begin
if (request) then mAge:=age+clients.Age;
end else mAge:=age+clients.Age;
if (all) then age:=age/num else age:=age/reqNum;
mAge:=age;
end;
begin
clrscr;
for i:=1 to num do
request:=false;
fillList;
writeln('введите: ');
repeat
readln(c);
if (c='tall') then typeAll
else if (c='tbname') then begin write('введите первую букву фамилии: '); readln(ch); typeByName(ch); end
else if (c='tbid') then begin write('введите номер клиента'); readln(id); typeRec(id,tType[1],tType[2],tType[3],tType[4],tType[5],tType[6]); end
else if (c='tmage') then begin writeln('всех клиентов? (y,n)'); readln(ch); if (ch='y') then mid:=mAge(true) else mid:=mAge(false); writeln('средний возраст: ',mid:4:2); end
else if (c='clnscr') then clrscr;
until c='exit';
end.
значения c и что при них происходит:
tall выводит все записи
tbname выводит записи по совпадению 1й буквы в фамилии
tbid выводит запись по номеру
tmage выводит средний возраст, будет запрос, всех ли клиентов, если не всех, то считается средний возраст клиентов из последнего запроса по букве в фамилии, если такого запроса не было, то результата быть не должно и скорее всего вылетит ошибка, потомучто будет деление на ноль :)
clnscr очищает экран
exit выход
[/quote]
Осталось символов – 4000.
Похожие вопросы
- Кто поможет в программировании?Паскаль
- Программирование на Паскале Помогите, пожалуйста , написать программу на паскале
- Помощь по информатике. 9 класс. Программирование .Язык Паскаль. Ветвление
- помогите кто дружит с паскалем! задание : напишите на языке программирования . Дано ...
- Информатика, программирование на Паскале
- Недавно начал изучать программирование с паскаля.Помогите сделать программу которой я ввел бы 3 числа или больше а она
- помогите решить задачи по программированию в ПАСКАЛЕ!!!
- Помогите решить) Задачи по программированию в Паскале
- Помогите решить задачку по программированию в Паскале!
- Помогите решить задачу по Программированию в паскале.