Program Derevo;
Uses Crt;
Type
St12 = string[12];
Pstruct = ^Struct;
Struct = Record
Nz : 57..90;
Stancia : St12;
Vremia : integer;
Left, Right : Pstruct;
end;
Const c : array[1..7] of String = ('Сведенья о поездах',
'ЪДДДДДДДВДДДДДДДДДДДДДВДДДДДДДДДДДДДї',
'і Номер і Станция і Время і',
'і поезда і назначения і отправления і',
& #39;ГДДДДДДДДЕДДДДДДДДДДДДДЕДДДДДДДДДДДДДґ
',
& #39;ГДДДДДДДДЕДДДДДДДДДДДДДЕДДДДДДДДДДДДДґ
',
& #39;АДДДДДДДДБДДДДДДДДДДДДДБДДДДДДДДДДДДДЩ
');

Var Tree : Pstruct;
F2, F1 :TEXT;

{-------Вывод данных одной строки таблицы----------}
Procedure P(Z:STRUCT);
Begin
Writeln(F1,#179, Z.Nz:5,#179:4,' ',Z.Stancia,#179:13-length(Z.Stancia),' ', Z.Vremia:5,#179:8,' ');
Writeln(#179, Z.Nz:5,#179:4,' ',Z.Stancia,#179:13-length(Z.Stancia),' ', Z.Vremia:5,#179:8,' ');
end;
{-------------Вывод шапки таблицы----------}
Procedure Shapka;
Var
i : Byte;
Begin
For i := 1 to 5 do
Writeln (C[i]);
End;
{-------------Удаление пробелов в начале и в конце строки----------}
Function Filtr (Str:St12):St12;
var
i,j,l:integer;
Begin
l:=length(Str);
For i:=1 to l do
if Str[i]<>' ' then
For j:=l downto i do
If Str[j] <> ' ' then
begin
Filtr:=copy (Str,i,j-i+1);
Exit
End;
Filtr:='';
end;
{-------------Включение нового элимента в дерево----------}
Procedure Form (Var TR:Pstruct; z:struct);
Begin
If TR = Nil Then
Begin new(TR);
TR^ :=Z;
End
Else
If z.Stancia < TR^.Stancia Then Form(TR^.Left,z)
Else
Form(TR^.Right,z);
End;
{-------------Ввод всех записей в дерево----------}
Procedure Vvod (NF: String);
Var
z: Struct;
b: Char;
Begin
Assign(F2, NF);
Reset (F2);
Writeln (F1,'Заполнение дерева новыми записями');
Shapka;
While not Seekeof(F2) DO
With z do
Begin
Readln(F2,Nz,b,Stancia,b,Vremia);
Stancia:=Filtr(Stancia);
Left :=Nil;
Right:=Nil;
P(z);
Form(Tree,z)
End;
Close(F2);
End;
{-------Обход дерева для вывода сортировочных данных дерева----------}
Procedure Sort(TR:Pstruct);
Begin
If TR<>Nil Then
Begin
Sort(TR^.Left);
P(TR^);
Sort(TR^.Right);
End;
End;
{-------Поиск по дереву----------}
Procedure Poisk_TR (TR: Pstruct; TFM : St12);
Begin
While TR<>Nil do
If TFM = TR^.Stancia Then
Begin
P(TR^);
Exit;
End
Else
If TFM < TR^.Stancia Then
TR:=TR^.Left
Else
TR:= TR^.Right;
Writeln (F1,'Станция введена не верно');
End;
{-------Поиск по дереву по заданному значению станции----------}
Procedure Poisk;
Var
TStancia : St12;
Begin
Assign(F2,'c:\TRPOI.DAT');
Reset (F2);
While not Seekeof(F2) do
Begin
Readln (F2,TStancia);
TStancia := Filtr (TStancia);
If TStancia = '' Then
Begin
Writeln(F1,'Нет станции для поиска');
Continue
End;
Writeln(F1,'Поиск',TStancia);
Poisk_TR(Tree,TStancia);
End;
End;
{-------Основная программа----------}
Begin
Clrscr;
Assign(F1,'c:\TR.Res');
Rewrite(F1);
Writeln(F1,'Создание дерева:');
Tree := Nil;
Vvod('c:\TR.DAT');
Writeln (F1,'Сортировка деревом:');
Shapka;
Sort(Tree);
Readln;
Poisk;
Close(F1);
end.

когда речь заходит о нескольких поездах идуших до одной станции, вместо того чтобы вывести их всех, он выводит только один

{-------Поиск по дереву----------}
Procedure Poisk_TR (TR: Pstruct; TFM : St12);
var count: integer;
Begin
  count := 0;
  While TR<>Nil do Begin
    If TFM = TR^.Stancia Then Begin
      P(TR^); Inc(count);
    end;

    If TFM < TR^.Stancia Then TR:=TR^.Left
    Else TR:= TR^.Right;

  End;

  if count = 0 then Writeln (F1,'Станция введена не верно');
End;

Спасибо, теперь все заработало...

Вот мне такой же поиск надо сделать для Номера поезда, я так понимаю что процедура "поиска по заданному значению " аналогична, той что у меня есть, но и в Procedure Poisk_TR тоже нужно добавить записи по параметру Nz... вот тут и возникает такая несостыковка как (Несоответствие типов)... что мне с этим делать?

Кстати не подскажите как мне здесь произвести вывод бинарного дерева...? а то я находила примеры, но соотнести их с текстом прграммы пока не смогла...

вот тут и возникает такая несостыковка как (Несоответствие типов)... что мне с этим делать?

А вообще я просто пыталась написать такое:

Procedure Poisk_TR_num(TR: Pstruct; search_num: integer);
Begin
  if TR <> nil Then Begin
    If search_num = TR^.Nz Then P(TR^);

    Poisk_TR_num(TR^.Left, search_num);
    Poisk_TR_num(TR^.Right, search_num);
  End;
End;

Procedure Poisk2;
Var
TNz : St12;
Begin
Assign(F2,'c:\TRPOISK.DAT');
Reset (F2);
While not Seekeof(F2) do
Begin
Readln (F2,TNz );
TNz := Filtr (TNz);
If TNz = '' Then
Begin
Writeln(F1,'Net NOMERA POEZDA dla poiska');
Continue
End;
Writeln(F1,'Poisk ',TNz);
Poisk_TR_num(Tree,TNz);
End;
End;

procedure PrintTree(t:Pstruct; h:integer);
var
i:integer;
begin
if t<>nil then
begin
PrintTree(t^.Left,h+1);
for i:=1 to h do write(' ');
WriteLn (t^.Nz,' ',t^.Stancia,' ',t^.Vremia);
PrintTree(t^.right,h+1);
end;
end;

{-------Поиск по дереву----------}
Procedure Poisk_TR (TR: Pstruct; TFM : St12);
var count: integer;
Begin
count := 0;
While TR<>Nil do
Begin
If TFM = TR^.Stancia Then
Begin
P(TR^);
Inc(count);
end;
If TFM < TR^.Stancia Then
TR:=TR^.Left
Else
TR:= TR^.Right;
End;
if count = 0 then
Writeln (F1,'Станция введена не верно');
Writeln ('Станция введена не верно');
End;

{-------Второй поиск по дереву ----------}
Procedure Poisk_TR_num(TR: Pstruct; search_num: integer);
Begin
If TR <> nil Then
Begin
If search_num = TR^.Nz Then
P(TR^);
Poisk_TR_num(TR^.Left, search_num);
Poisk_TR_num(TR^.Right, search_num);
end;
End;

if count = 0 then BEGIN { <--- Не забыла, что у тебя несколько операторов? }
Writeln (F1,'Станция введена не верно');
Writeln ('Станция введена не верно');
END; { <--- }

как мне во второй поиск поставит это пресловутое 'Номер поезда введен не верно'

Var count_trains: integer; { Глобальная переменная }

Procedure Poisk_TR_num(TR: Pstruct; search_num: integer);
Begin
  If TR <> nil Then Begin
    If search_num = TR^.Nz Then Begin
      P(TR^); Inc(count_trains);
    End;
    Poisk_TR_num(TR^.Left, search_num);
    Poisk_TR_num(TR^.Right, search_num);
  end;
End;