Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 18.06.2011, 21:36   #1
rusfin01
Пользователь
 
Регистрация: 14.12.2010
Сообщений: 25
Стрелка Тема записи. Сортировка

Нужно отсортировать по возрасту, но не работает что-то.
Вот код, поправьте пожалуйста эту процедуру сортировки:
Код:
 procedure Sort;
var
 b: stud;
begin
  reset(f2);
  i:=0;
  while i < filesize(f2) - 1 do begin
    seek(f2, i);
    read(f2, a, b);
 
    if (a.DR.God < b.DR.God) then begin seek(f2, i);
               write(f2, b, a);if i>0 then dec(i)
                                  end
    else
    if (a.DR.God = b.Dr.God)   then begin
      if (a.DR.Mes < b.Dr.Mes) then begin seek(f2, i);
               write(f2, b, a); if i>0 then dec(i)
                                    end
 
      else
      if (a.Dr.mes = b.DR.mes)  then begin
        if (a.Dr.den < b.Dr.den) then begin seek(f2, i);
               write(f2, b, a); if i>0 then dec(i)
                                      end
end;end; end;
end;
rusfin01 вне форума Ответить с цитированием
Старый 19.06.2011, 13:40   #2
rusfin01
Пользователь
 
Регистрация: 14.12.2010
Сообщений: 25
По умолчанию

Вот вся задача!
Код:
 uses crt;
type
  class = record
     Cifra: byte;
  end;

  datar = record
      Den: integer;
      Mes: integer;
      God: integer;
  end;

  stud = record
    FIO: string[40];
    DR: datar;
    Clas: class;
  end;

 mas = record
    Clas: class;
    kol_ob: integer;
 end;

 var
  f1: text;
  f2, f3: file of stud;
  a : stud;
  Clasi : array[1..10] of mas;
  q     : byte;
  i     : byte;
  max   : mas;

function Vozrast (DR: datar): integer;
var
  TDate: datar;
  V: integer;
  polnih: boolean;
  begin
  TDate.Den:=18;
  TDate.Mes:=6;
  TDate.God:=2011;
  V:=TDate.God - DR.God;
  if polnih then begin
     if not (TDate.Mes >= DR.Mes) and  (TDate.Den >= DR.Den) then
     dec(V);
  end;
  Vozrast:=V;
end;

procedure Sort;
var
 b: stud;
begin
  reset(f2);
  i:=0;
  while i < filesize(f2) - 1 do begin
    seek(f2, i);
    read(f2, a, b);

    if (a.DR.God < b.DR.God) then begin seek(f2, i);
               write(f2, b, a);if i>0 then dec(i)
                                  end
    else
    if (a.DR.God = b.Dr.God)   then begin
      if (a.DR.Mes < b.Dr.Mes) then begin seek(f2, i);
               write(f2, b, a); if i>0 then dec(i)
                                    end

      else
      if (a.Dr.mes = b.DR.mes)  then begin
        if (a.Dr.den < b.Dr.den) then begin seek(f2, i);
               write(f2, b, a); if i>0 then dec(i)
                                      end

                        end;end; end;




end;

Procedure VivStr(b: stud);
 begin
  write(b.FIO:41, ' ');
  write(b.DR.Den:5,' ');
  write(b.DR.Mes:5,' ');
  write(b.DR.God:5,' ');
  writeln(b.Clas.Cifra:5, ' ');
  end;

procedure Proverka(cl: class);
 var
  p: boolean;
begin
   p:=false;
   for i:=1 to q-1 do
    if (Clasi[i].Clas.Cifra = cl.Cifra) then begin
      inc(Clasi[i].kol_ob);
      p:=true;
                                             end;
    if not p then begin
		   Clasi[q].Clas:=cl;
                   inc(Clasi[q].kol_ob);
                   inc(q);
                  end;
end;

BEGIN
  clrscr;
  assign(f1, 'Infa.txt');
  assign(f2, 'Ucheniki.typ');
  assign(f3, 'Uchenik2.typ');
  {$i-} reset(f1); {$i+}
  if ioresult <> 0 then begin
    writeln('Textovii file ne bil naiden. Sozdaite textovii file iz neskolkih strok.');
     end
  else begin
    rewrite(f2);
    while not eof(f1) do begin
      read(f1, a.DR.Den);
      read(f1, a.DR.Mes);
      read(f1, a.DR.God);
      read(f1, a.Clas.Cifra);
      readln(f1, a.FIO);
      write(f2,a);
    end;
    close(f2);
    close(f1);
    reset(f2);
    q:=1;
    while not eof(f2) do begin
      read(f2,a);
      Proverka(a.Clas);
    end;
    max.kol_ob:=0;
    for i:=1 to q-1 do
    if max.kol_ob < Clasi[i].kol_ob then max:=Clasi[i];
    Sort;
    writeln('Samii mladshii uchashiisya:');
    reset(f2);
    read(f2, a);
    VivStr(a);
    writeln;
    writeln('Samii starshii uchashiisya:');
    seek(f2, filesize(f2)-1);
    read(f2, a);
    VivStr(a);
    readln;

    reset(f2);
    rewrite(f3);
    writeln;
    writeln('Spisok klassa s max chislom uchenikov:');
    writeln;
    writeln('FIO':40,'|','Den':5,' |','Mes':5,' |','God':5,' |','Clas':3);
    writeln;

    while not eof(f2) do begin
      read(f2, a);
          if (a.Clas.Cifra = max.Clas.Cifra)  then begin
          write(f3, a);
             VivStr(a);
      end;
    end;
    writeln;
    close(f3);
  end;
 readln;
END.
rusfin01 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Тема записи! rusfin01 Паскаль, Turbo Pascal, PascalABC.NET 0 06.06.2011 20:25
задача на паскале тема текстовые файлы, записи шушара Паскаль, Turbo Pascal, PascalABC.NET 4 19.04.2011 20:15
тема записи nickitoos Помощь студентам 2 21.03.2011 14:31
Сортировка записи на DbGrid mavlon_m Общие вопросы Delphi 1 24.08.2009 10:01
Помогите, пожалуйста, решить задачу на Turbo Pascal. Тема: записи. Morrigan13 Помощь студентам 1 28.03.2008 21:09