Pascal. Помогите найти ошибку

[virginia]

Pascal. Помогите найти ошибку

 {Создать массив(расписание движения),хранящий информацию о 20 поездах,отправляющихся со станции Воронеж.
 Каждый элемент расписания содержит информацию:номер поезда,пункт назначения,время отправления,количество свободных мест
 в вагонах типа св,купе,плацкарт.а)упорядочить массив по пункту назначения.Вывести информацию о поездах,отходящих в заданный период
 времени и следующих до заданного пункта назначения}
program Project2;

{$APPTYPE CONSOLE}
uses
  SysUtils,
  Windows;
const
    n=3;
type
     telem=record
     numbertrain:integer;
     destination:string;
     timeofdeparture:integer;
     sv:Integer;
     compartment:integer;
     plackart:integer;
     end;
tmas=array [1..n] of telem;
var
  train:tmas;
  i,time1,time2:Integer;
  destination:string;
//-------------------------------------------------------------------
procedure vvoddannuh(var a:tmas);
var i:Integer;
begin
  for i:=1 to n do
  begin
    Writeln('введи  номер поезда');
    Readln(a[i].numbertrain);
    Writeln('введи пункт назначения');
    Readln(a[i].destination);
    Writeln('введи время отправления');
    Readln(a[i].timeofdeparture);
    Writeln('введи количество свободных мест в св');
    Readln(a[i].sv);
    Writeln('введи количество свободных мест в купе');
    Readln(a[i].compartment);
    Writeln('введи количество свободных мест в плацкарте');
    Readln(a[i].plackart);
    writeln;
  end
end;
//-----------------------------------------------------------------
Procedure vuvoddannuh(a:tmas);
var i:Integer;
begin
   writeln ('--------------------------------------------------------------------------');
   writeln ('    номер поезда   / пункт назначения   / время отправления /места в св /места в купе   /места в плацкарте           ');
   writeln ('--------------------------------------------------------------------------');
   for i:=1 to n do
   writeln(a[i].numbertrain:3,' ',a[i].destination:10,' ',a[i].timeofdeparture:7,' ',a[i].sv:3,' ',a[i].compartment:3,' ',a[i].plackart:3);
end;
//------------------------------------------------------------------------------------------
Procedure Swap(Var k, l: telem);
Var m:telem;
 begin
   m := k;
   k := l;
   l := m;
 end;
// --------------------------------------------------------------------------
Procedure sortirovka;
var
 x:telem;
 i,j:Integer;
begin
 for i:=1 to n do
  for j:=1 to n-i do
   if Ord(train[j].destination[1])>Ord(train[j+1].destination[1]) then
  Swap(train[j],train[j+1]);
end;
//--------------------------------------------------------------------------------
Procedure search_train(a:tmas;destination:string;time1,time2:Integer);
var
 i,S:Integer;
begin
   S:=0;
   if (a[i].destination=destination) and (a[i].timeofdeparture>=time1)and(a[i].timeofdeparture<=time2) then
      begin
        Writeln('номер поезда',a[i].numbertrain);
        Writeln('пункт назначения',a[i].destination);
        Writeln('время отправления',a[i].timeofdeparture);
        Writeln('количество мест в св',a[i].sv) ;
        Writeln('количество мест в купе',a[i].compartment);
        Writeln('количество мест в плацкарте',a[i].plackart);
        s:=s+1
      end;
   if S=0 then writeln('таких поездов нет');
end;

begin
  SetConsoleOutputCP(1251);
  vvoddannuh(train);
  writeln;
  vuvoddannuh(train);
  sortirovka;
  vuvoddannuh(train);
  Writeln('введи пункт назначения');
  Readln(destination);
  writeln('введи период времени(формат ввода ччмм) с');
  readln(time1);
  writeln('по');
  Readln(time2);
  search_train(train,destination,time1,time2);
  readln

end.

не работает поиск по указанным параметрам

 

[Vladimir_S]

не работает поиск по указанным параметрам

И не должен, поскольку у Вас в процедуре search_train напрочь отсутствует сам цикл, а введен лишь параметр i, которому по умолчанию присвоено значение i=0, кстати, выходящее за рамки определенного Вами типа tmas.

 

[virginia]

подскажите,пожалуйста,как создать текстовый файл с данными поездов,а из него уже сформировать новый текстовый файл,где поезда отсортированы и выведены данные о поездах,удовлетворяющих критериям?

 

[Vladimir_S]

подскажите,пожалуйста,как создать текстовый файл с данными поездов,а из него уже сформировать новый текстовый файл,где поезда отсортированы и выведены данные о поездах,удовлетворяющих критериям?

Ну, кажется, довел я Вашу программу до ума. Все данные выводятся в файлы, исправлен ввод времени, формат вывода, улучшена процедура сортировки (строковые переменные можно сравнивать непосредственно, не прибегая к функции Ord, она автоматически вызовется; сам недавно узнал про такое), добавлена процедура чтения файла и т.п.

uses
  SysUtils,
  Windows;
const
    n=3;
type
     telem=record
     numbertrain:integer;
     destination:string;
     timeofdeparture_h:integer;
     timeofdeparture_m:integer;
     sv:Integer;
     compartment:integer;
     plackart:integer;
     end;
tmas=array [1..n] of telem;
var
  train:tmas;
  i,t_h,t_m:Integer;
  time1,time2:real;
  destination:string;
//-------------------------------------------------------------------
procedure vvoddannuh;
var
 i,numbertrain,timeofdeparture_h,timeofdeparture_m,
 sv,compartment,plackart:Integer;
 destination:String;
 f:Text;
begin
  Assign(f,'train_1.txt');
  Rewrite(f);
  writeln (f,'------------------------------------------------------------');
  writeln (f,'номер / пункт назначения / время отпр. / св / купе / плацк. ');
  writeln (f,'------------------------------------------------------------');
  for i:=1 to n do
  begin
    Write('введи номер поезда: ');
    Readln(numbertrain);
    Write('введи пункт назначения: ');
    Readln(destination);
    Write('введи время отправления (чч мм): ');
    Readln(timeofdeparture_h,timeofdeparture_m);
    Write('введи количество свободных мест в св: ');
    Readln(sv);
    Write('введи количество свободных мест в купе: ');
    Readln(compartment);
    Write('введи количество свободных мест в плацкарте: ');
    Readln(plackart);
    writeln(f,numbertrain:5,destination:19,timeofdeparture_h:8,timeofdeparture_m:3,sv:8,compartment:7,plackart:8);
    writeln
  end;
 Close(f)
end;
//-----------------------------------------------------------------
Procedure vuvoddannuh(a:tmas);
var
 i:Integer;
 f:Text;
begin
   Assign(f,'train_2.txt');
   Rewrite(f);
   writeln (f,'------------------------------------------------------------');
   writeln (f,'номер / пункт назначения / время отпр. / св / купе / плацк. ');
   writeln (f,'------------------------------------------------------------');
   for i:=1 to n do
   writeln(f,a[i].numbertrain:5,a[i].destination:19,a[i].timeofdeparture_h:8,a[i].timeofdeparture_m:3,a[i].sv:8,a[i].compartment:7,a[i].plackart:8);
   Close(f)
end;
//------------------------------------------------------------------------------------------
Procedure Read_data(Var a: tmas);
Var
 i,j:Integer;
 f:Text;
 C:Char;
 begin
   Assign(f,'train_1.txt');
   Reset(f);
   readln(f);
   readln(f);
   readln(f);
   for i:=1 to n do
     begin
       read(f,a[i].numbertrain);
       repeat
        read(f,C);
       until C<>' ';
       a[i].destination:=C;
       repeat
         read(f,C);
         if C<>' ' then  a[i].destination:=a[i].destination+C;
       until C=' ';
       readln(f,a[i].timeofdeparture_h,a[i].timeofdeparture_m,a[i].sv,a[i].compartment,a[i].plackart);
     end;
   Close(f)
 end;
//------------------------------------------------------------------------------------------
Procedure Swap(Var k, l: telem);
Var m:telem;
 begin
   m := k;
   k := l;
   l := m;
 end;
// --------------------------------------------------------------------------
Procedure sortirovka;
var
 x:telem;
 i,j:Integer;
begin
 for i:=1 to n-1 do
  for j:=1 to n-i do
   if train[j].destination>train[j+1].destination then
  Swap(train[j],train[j+1]);
end;
//--------------------------------------------------------------------------------
Procedure search_train(a:tmas;destination:string;tm1,tm2:real);
var
 i,S:Integer;
 f:Text;
begin
   Assign(f,'train_2.txt');
   Append(f);
   Writeln(f);
   S:=0;
   for i:=1 to n do
   if (a[i].destination=destination) and
    (a[i].timeofdeparture_h+a[i].timeofdeparture_m/100>=tm1) and
    (a[i].timeofdeparture_h+a[i].timeofdeparture_m/100<=tm2) then
      begin
        Writeln(f,'номер поезда: ',a[i].numbertrain);
        Writeln(f,'пункт назначения: ',a[i].destination);
        Writeln(f,'время отправления: ',a[i].timeofdeparture_h,'-',a[i].timeofdeparture_m);
        Writeln(f,'количество мест в св: ',a[i].sv) ;
        Writeln(f,'количество мест в купе: ',a[i].compartment);
        Writeln(f,'количество мест в плацкарте: ',a[i].plackart);
        Writeln(f);
        S:=S+1
      end;
   if S=0 then writeln(f,'таких поездов нет');
   Close(f);
end;

begin
  SetConsoleOutputCP(1251); 
  vvoddannuh;
  read_data(train);
  sortirovka;
  vuvoddannuh(train);
  Writeln('введи пункт назначения:');
  Readln(destination);
  writeln('введи период времени(формат ввода чч мм) с');
  readln(t_h,t_m);
  time1:=t_h+t_m/100;
  writeln('по');
  Readln(t_h,t_m);
  time2:=t_h+t_m/100;
  search_train(train,destination,time1,time2);
end.

 

[virginia]

Procedure Read_data(Var a: tmas);
Var
 i,j:Integer;
 f:Text;
 C:Char;
 begin
   Assign(f,'train_1.txt');
   Reset(f);
   readln(f);
   readln(f);
   readln(f);
   for i:=1 to n do
     begin
       read(f,a[i].numbertrain);
       repeat
        read(f,C);
       until C<>' ';
       a[i].destination:=C;
       repeat
         read(f,C);
         if C<>' ' then  a[i].destination:=a[i].destination+C;
       until C=' ';
       readln(f,a[i].timeofdeparture_h,a[i].timeofdeparture_m,a[i].sv,a[i].compartment,a[i].plackart);
     end;
   Close(f)
 end;

данная процедура считывает данные о поездах?

 

[Vladimir_S]

данная процедура считывает данные о поездах?

Да. Если уже есть файл, см. первая миниатюра в предыдущем посте, то данная процедура считает из него данные и сформирует массив записей.