Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Записи, проверьте задачу

Автор: Вася 20.05.2007 15:03

{Сведения об ученике состоят из его имени и фамилии, названия класса (года
обучения и буквы), в котором он учится, оценок, полученных учеником за пос-
леднюю четверть. Пусть дан массив, содержащий сведения об учениках школы:

d) выясните, в каких классах насчитывается более 15 учащихся;}
program s129n24dxXx;

{$APPTYPE CONSOLE}

uses
SysUtils,
windows;

const n = 100; // кол-во учеников
MaxN = 100; // макс кол-во оценок одного ученика
type
Tocenka = array [1..maxn] of integer; // тип массив оценок одного ученика
data = record // запись, данные ученика
fio: string; // фамилия и имя
klass1: integer; // класс (цифра)
klass2: char; // класс (литера)
chetvert: Tocenka; // оценки за последнюю четверть
end;
Tmas = array [1..n] of data; // массив данных учеников
var
ucheniki: Tmas; //массив данных учеников
i: integer; //счётчик
// процедура ввода данных об одном ученике
procedure read_data (var a: data);
var i: integer;
begin
writeln ('Введите сведения об ученике: ');
with a do
begin
write ('Фамилия и имя: ');
readln (fio);
write ('класс (цифру): ');
readln (klass1);
write ('класс (литеру): ');
readln (klass2);
write ('оценки за четверть: ');
readln (chetvert[i]);
end;
end;
// процедура поиска классов, в которых более 15 учеников
procedure poisk (var a: Tmas);
var i, j, k: integer;
begin
i:=0;
while i<=n do
begin
k:=1;
i:=i+1;
for j:=1 to n do
begin
if (a[i].klass1=a[j].klass1) and (a[i].klass2=a[j].klass2)
and (i<>j)
then
k:=k+1;
end;
if (k>=15) then
begin
writeln (a[i].klass1, ' ', a[i].klass2);
end;
end;
end;
begin{main}
// подключение модуля русского языка
SetConsoleCp (1251);
SetConsoleOutputCp (1251);
for i:=1 to n do // ввод данных всех учеников
begin
read_data (ucheniki[i]);
end;
poisk (ucheniki);
readln;
end.

Автор: мисс_граффити 20.05.2007 15:19

Приведи, пожалуйста, тему в соответствие с п.2 правил (наверху страницы).

Автор: Krisss 20.05.2007 20:12

Здравствуйте,я новичок))Мне нужна ваша помощь,я делала программу которая звучит так"Создайте набор данных, содержащий сведения о частоте материалов.Записи представляют собой таблицу,которая состоит из двух колонок:материал и частота.К созданному набору данных нужно добавить 2 новые записи".Я поняла как создать таблицу,а вот как потом к готовой таблице добавить новые записи непонятно.
тест программы:
USES CRT;

type rec=record
material:string[18];
chastota:real;
{Name:string[18];}
{ H:string[4];
SS:real;
C:real;}
end;
var zap:rec;
f:file of rec;
NameF:string;
m,I,IORes: BYTE;
vo:string[3];


PROCEDURE SHAP_TAB;
BEGIN
WRITELN(' ╔══════════════╦═════════╗');
WRITELN(' ║ Material ║ Chastota║');
WRITELN(' ║ ║ ║');
WRITELN(' ╠════════════════════════╣');
END;





PROCEDURE ZAG_TAB1;
BEGIN

writeln('Vvedite dannie o materialah');

END;

PROCEDURE PODVAL_TAB;
BEGIN
WRITELN('╚══════════════╩═════════╝');
END;

PROCEDURE PAUSE;
BEGIN
gotoXY(4,24);
WRITELN('ДЛЯ ПРОДОЛЖЕНИЯ НАЖМИ КЛАВИШУ Enter ');
readln;
clrscr
END;


BEGIN
clrscr;
m:=3;
i:=1;
vo:='';
Repeat
{$I-}
WRITELN(' Введите ИМЯ ФАЙЛА для записи ');
readln(NameF);
m:=m+2;
assign(f,NameF);
rewrite(f); { открыть в режиме перезаписи }
{$I+}
IORes:=IOResult;
if IORes<>0 then
WriteLn('Неверное имя');
Until IORes=0;

ZAG_TAB1;
SHAP_TAB;

while vo ='' do


BEGIN
GOTOxy(8,I+m+3);
WRITE('║');
GOTOxy(9,I+m+3);
READLN( zap.Material );
GOTOxy(23,I+m+3);
WRITE('║');
GOTOxy(24,I+m+3);
READLN( zap.Chastota );

GOTOxy(33,I+m+3);
WRITELN('║');

write(f,zap);


GOTOxy(4,24);
write('Продолжить ввод(да-Enter,нет-н)=>...');
readln(vo);

i:=i+1
END;
GOTOxy(8,I+m+3);
PODVAL_TAB;

PAUSE;

CLOSE(F);
writeln('Файл создан')

end.