ANTICHAT.XYZ    VIDEO.ANTICHAT.XYZ    НОВЫЕ СООБЩЕНИЯ    ФОРУМ  
Баннер 1   Баннер 2
Antichat снова доступен.
Форум Antichat (Античат) возвращается и снова открыт для пользователей. Здесь обсуждаются безопасность, программирование, технологии и многое другое. Сообщество снова собирается вместе.
Новый адрес: forum.antichat.xyz
Вернуться   Форум АНТИЧАТ > Программирование > С/С++, C#, Delphi, .NET, Asm
   
 
 
Опции темы Поиск в этой теме Опции просмотра

Помогите сделать двух связный список(или переобразовать существующий если такое возм)
  #11  
Старый 25.03.2010, 19:49
Аватар для NTFF
NTFF
Новичок
Регистрация: 09.12.2009
Сообщений: 23
Провел на форуме:
42989

Репутация: 0
По умолчанию Помогите сделать двух связный список(или переобразовать существующий если такое возм)

Помогите с реализацией двухсвязного списка в паскале

может есть вариант как-то преобразовать существующий список если это возможно то вот код:

Если нет то вот условие
Разработать справочник пассажирских поездов с полями: номер поезда, станции отправления и назначения, время в дороге, категория поезду. Реализовать подпрограммы поиска: 1) по станциям отправления и назначения, 2) по категории поезду.

program Records;
uses
crt, strings;
const
max = 100;
type

Ttrain = record
Otpravlenie : string[40];
Pribitie : string[40];
Category : string[10];
Time : string[10];
Number : string[10];
end;

Ttrains = array [1..max] of Ttrain;


procedure SngWindow(x1,y1,x2,y2,tc,c : byte);
begin
window(x1,y1,x2,y2);
textbackground(c); textcolor(tc);
clrscr;
end;


procedure DblWindow(x1,y1,x2,y2,tcolor, c1, c2 : byte);
begin
window(x1,y1,x2,y2);
textbackground(c1);
clrscr;
window(x1+1,y1+1,x2-1,y2-1);
textbackground(c2);
textcolor(tcolor);
clrscr;
end;


function Menu : byte;
var
punkt : byte;
er : integer;
s : string;
begin

SngWindow(1,1,80,25,WHITE,BLACK);

SngWindow(1,6,80,25,WHITE,BLUE);

repeat

DblWindow(1,1,80,5,YELLOW,MAGENTA,BLUE);
writeln;
write(' 1.ADD 2.DELETE 3.PRINT 4.SEARCH 5.EXIT');
readln(s);
val(s,punkt,er);
until (er=0) and (punkt>=1) and (punkt<=5);
Menu := punkt;
end;

function SubMenu : byte;
var
punkt : byte;
er : integer;
s : string;
begin

SngWindow(1,1,80,25,WHITE,BLACK);
SngWindow(1,6,80,25,WHITE,BLUE);
repeat

DblWindow(1,1,80,5,YELLOW,MAGENTA,BLUE);
writeln;
write(' 1.Otpravlenie 2.Pribitie 3.Number 4.Exit');
readln(s);
val(s,punkt,er);
until (er=0) and (punkt>=1) and (punkt<=4);
SubMenu := punkt;
end;

procedure AddRecord(var mas : Ttrains; var n : byte; size : byte);
var
s : String;
er : integer;
begin

if (n+1 <= size) then
begin
inc(n);

write('Point of otpravlenie =>'); readln(mas[n].Otpravlenie);
write('Point of pribitie =>'); readln(mas[n].Pribitie);
write('Category of train =>'); readln(mas[n].Category);
write('Time in the way =>'); readln(mas[n].Time);
write('Number of train =>'); readln(mas[n].number);

writeln('Record is saving....');
end
else writeln('ERROR record is lost');
end;

procedure PrintRecord(var mas : Ttrains; i : integer);
begin
write(i:3);
with mas[i] do
begin
write(Otpravlenie:23); write(Pribitie:20);
write(Category:10); write(Time:10);
write(Number:12);
writeln;
end;
end;

procedure Print(var mas : Ttrains; n : integer);
var
i : integer;
begin
writeln('#':3,'Otpravlenie':23,'Pribitie':20,'Cate gory':10,'Time':10,'Number':12);
for i:=1 to n do
PrintRecord(mas,i);
end;

procedure DelRecordByotpr(var mas : Ttrains; var n : byte; botpr : string);
var
i,j : integer;
begin
writeln('#':3,'Otpravlenie':23,'Pribitie':20,'Cate gory':10,'Time':10,'Number':12);
for i:=1 to n do
begin
with mas[i] do

if (Otpravlenie = botpr) then
begin
PrintRecord(mas,i);

for j:=i+1 to n do
mas[j-1] := mas[j];
dec(n);
end;
end;
end;

procedure FindByotpr(var mas : Ttrains; n : integer; botpravlenie : string);
var
i : integer;
begin
writeln('#':3,'Otpravlenie':23,'Pribitie':20,'Cate gory':10,'Time':10,'Number':12);

for i:=1 to n do
with mas[i] do

if otpravlenie=botpravlenie then PrintRecord(mas,i);
end;

procedure FindByCat(var mas : Ttrains; n : integer; ba, bst : string);
var
i : integer;
begin
writeln('#':3,'Otpravlenie':23,'Pribitie':20,'Cate gory':10,'Time':10,'Number':12);

for i:=1 to n do
with mas[i] do

if (pribitie=ba) and (Category=bst) then PrintRecord(mas,i);
end;

procedure FindBynum(var mas : Ttrains; n : integer; bnumber : string);
var
i : integer;
begin writeln('#':3,'Otpravlenie':23,'Pribitie':20,'Cate gory':10,'Time':10,'Number':12);

for i:=1 to n do
with mas[i] do

if number=bnumber then PrintRecord(mas,i);
end;

var
b : Ttrains;
n : byte;
punkt : byte;
subpunkt : byte;
trainotprav,
a,
st : string;
y : string;
s : string;
er : integer;
begin
n := 0;
SngWindow(1,1,80,25,WHITE,BLACK);
repeat
punkt:= Menu;
case (punkt) of
1:begin
SngWindow(1,6,80,25,WHITE,BLUE);
writeln(' ADD train');
AddRecord(b,n,max);
readkey;
end;
2:begin
SngWindow(1,6,80,25,WHITE,BLUE);
writeln(' Delete by otpravlenie');

write('Otpravlenie =>');
readln(trainotprav);

DelRecordByotpr(b,n,trainotprav);
readkey;
end;
3:begin
SngWindow(1,6,80,25,WHITE,BLUE);
writeln(' Catalog of trains');
Print(b,n);
readkey;
end;
4:begin
repeat
subpunkt := SubMenu;
case (subpunkt) of
1:begin
SngWindow(1,6,80,25,WHITE,BLUE);
writeln(' Train by otpravlenie ');
write('Otpravlenie =>');
readln(trainotprav);
findbyotpr(b,n,trainotprav);
readkey;
end;
2:begin
SngWindow(1,6,80,25,WHITE,BLUE);
writeln(' Train by pribitie and category ');

write('Pribitie =>');
readln(a);

write('Category =>');
readln(st);
findByCat(b,n,a,st);
readkey;
end;
3:begin
SngWindow(1,6,80,25,WHITE,BLUE);
writeln(' Train by number ');
write('number =>');
readln(y);
findbynum(b,n,y);
readkey;
end;
end;
until (subpunkt = 4);
end;
end;
until (punkt = 5);
SngWindow(1,1,80,25,WHITE,BLACK);
end.
 
Ответить с цитированием
 



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сюда выкладываем все проги для фрикринга мобильников, которых знаем! nigger Сотовый фрикинг 5 11.04.2009 11:15
Американским студентам запретили пользоваться Skype KPOT_f!nd Мировые новости 1 28.09.2006 03:47
Любителям квестов сюда!! FoX's Болталка 10 25.01.2005 20:42



Здесь присутствуют: 1 (пользователей: 0 , гостей: 1)
 


Быстрый переход




ANTICHAT.XYZ