| lenchik1 |
26.09.2012 20:06 |
Найти ошибки
Код:
rogram Project2;
{$APPTYPE CONSOLE}
uses
SysUtils,
windows;
const n=20;
type
tstudent = record
name:string[10];
kurs:Byte;
group:Byte;
spec:string[10];
mark:String[9];
end;
tmas=array [1..n] of tstudent;
tfile=file of tstudent;
var a:tmas;
f,f1:Text;
f2:tfile;
s:String;
//-----------------------------------------------------------------
procedure vvoddannuh(var a:tmas);
var i:Integer;
p:tstudent;
begin
Rewrite(f);
writeln (f,'------------------------------------------------------------');
writeln (f,' фио /к/г/ спец-ть /оценки ');
writeln (f,'------------------------------------------------------------');
for i:=1 to n do
with p do
begin
Write('введи фамилию');
Readln(f,name);
Write('введи курс');
Readln(f,kurs);
Write('введи специальность');
Readln(f,spec);
Write('введи результат последней сессии');
Readln(f,mark);
writeln(f,name:10,kurs:1,spec:10,mark:9);
writeln
end;
Close(f)
end;
//------------------------------------------------------------------------------
Procedure printdannuh(a:tmas);
var i:Integer;
begin
Rewrite(f1);
Rewrite(f2);
writeln (f1,'------------------------------------------------------------');
writeln (f1,' фио /к/г/ спец-ть /оценки ');
writeln (f1,'------------------------------------------------------------');
for i:=1 to n do
With a[i] Do
begin
writeln(f1,name,kurs,spec,mark);
write(f2,a[i])
end;
Close(f1);
Close(f2);
end;
//-----------------------------------------------
procedure read_info( a:tmas);
var i:integer;
begin
Reset(f);
readln(f);
readln(f);
readln(f);
for i:=1 to n do
With a[i] Do
begin
Readln(f,name,kurs,group,spec,mark);
//Здесь нужно убрать лишние пробелы ...
name:=TrimLeft(name);
spec:=TrimLeft(spec)
end;
Close(f)
end;
procedure sort(var a:tmas);
var x:tstudent; i,j:integer;
begin
for i:=1 to n-1 do
for j:=1 to n-i do
begin
if a[j].kurs>a[j+1].kurs then
begin
x:=a[j]; a[j]:=a[j+1]; a[j+1]:=x;
end;
if a[j].kurs=a[j+1].kurs then
if a[j].group>a[j+1].group then
begin
x:=a[j]; a[j]:=a[j+1]; a[j+1]:=x;
end;
end;
end;
procedure Odnofam (r:byte; a:tmas);
var i,j,kk,k: byte; aa:tmas; s,ss: string; f1: Text; f3:tfile;
begin
Append(f1);
Reset(f2);
Seek(f2,FileSize(f2)); //Указатель в конец файла
Writeln(f1);
s:='Список групп, в которых есть однофамильцы: ';
k:=0;
for i:=1 to r do
for j:=i+1 to r do
with a[i] do
if a[i].name=a[j].name then
begin
inc(k);
kk:=0;
str(a[i].group,ss);
ss:=' '+ss+' ';
if pos(ss,s)=0 then s:=s+ss;
if kk=0 then
aa[k]:=a[i]
end;
if k>=1 then
for i:=1 to k do
with aa[i] do
begin
Writeln(f1,'Фио', name);
Writeln(f1,'к', kurs);
Writeln(f1,'г', group);
Writeln(f1,'спец-ть', spec);
Writeln(f1,'оценки',mark);
Writeln(f1);
Write(f2,aa[i])
end
else
writeln('таких групп нет');
writeln(s);
Close(f1);
Close(f2);
readln;
end;
begin
setconsoleoutputcp(1251);
SetConsoleCP(1251);
Assign(f,'список.txt');
Assign(f1,'список2.txt');
Assign(f2,'список3.dat');
if FileExists('список.txt') then
begin
read_info(a);
Reset(f);
while not Eof(f) do
begin
Readln(f,s);
Writeln(s)
end;
Close(f);
sort(a);
writeln('список отсортирован');
printdannuh(a);
Odnofam(n,a);
Reset(f1);
while not Eof(f1) do
begin
Readln(f1,s);
Writeln(s)
end;
Close(f1);
end
else
vvoddannuh(a);
Readln
end.
Создать массив из 20-ти элементов, хранящий информацию о студентах. Каждый элемент содержит: фамилию, курс, форму обучения (специалист, бакалавр, магистр) и оценки по 5 предметам за последнюю сессию. Упорядочить массив по курсу, внутри курса - по группе. Найти группы, в которых есть однофамильцы. Распечатать их фамилии и оценки за последнюю сессию.
задача зависает при запуске |
