11.08.2012, 12:57 | #1 (permalink) |
Member
Регистрация: 29.10.2011
Сообщений: 42
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: -42
|
Паскаль. Задача о расписании поездов
Каждый элемент расписания содержит информацию:номер поезда,пункт назначения,время отправления,количество свободных мест в вагонах типа св,купе,плацкарт.а)упорядочить массив по пункту назначения.Вывести информацию о поездах,отходящих в заданный период времени и следующих до заданного пункта назначения в типизированный файл}.помогите сделать вывод в типизированный файл Код:
program Project2; {$APPTYPE CONSOLE} uses SysUtils, Windows; const n=20; type traininfo=record numbertrain:integer; destination:string; timeofdeparture_h:integer; timeofdeparture_m:integer; sv:Integer; compartment:integer; plackart:integer; end; tmas=array [1..n] of traininfo; var train:tmas; i,t_h,t_m:Integer; time1,time2:real; destination,s:string; f,f1:Text; //----------------------------------------------------------------- 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: traininfo); Var m:traininfo; begin m := k; k := l; l := m; end; // -------------------------------------------------------------------------- Procedure sortirovka; var x:traininfo; 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); if FileExists('train_1.txt')then begin read_data(train); assign(f,'train_1.txt'); reset(f); while not eof(f) do begin readln(f,s); writeln(s); end; close(f); 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); assign(f1,'train_2.txt'); reset(f1); while not eof(f1) do begin readln(f1,s); writeln(s) end; close(f1) end else vvoddannuh; Writeln('Для выхода нажмите enter'); readln end. |
11.08.2012, 12:57 | |
Helpmaster
Member
Регистрация: 08.03.2016
Сообщений: 0
|
Прочитайте схожие топики, это не должно занять много времени Паскаль. Задача по преобразованию Задача на Паскаль Задача, Паскаль Задача. Паскаль |
12.08.2012, 11:19 | #3 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Ну вот, как-то так. Вроде довёл до ума с типизированными файлами. Добавил немного украшений типа запроса о переписывании исходного файла, буде он существует, ну и еще по мелочи. Что касается функции FileExists, то в моём Паскале таковой среди стандартных не имеется, а потому я изготовил самодельную. Если не нужна, смахните ее.
Код:
program Project2a; {$APPTYPE CONSOLE} uses SysUtils, Windows; const n=20; type traininfo=record numbertrain:integer; destination:string[30]; timeofdeparture_h:integer; timeofdeparture_m:integer; sv:Integer; compartment:integer; plackart:integer; end; tmas=array [1..n] of traininfo; f_tr=file of traininfo; var train:tmas; i,t_h,t_m,M,fd:Integer; time1,time2:real; destination,s:string; fx:f_tr; //----------------------------------------------------------------- function FileExists(Name:String):Boolean; Var ffe:f_tr; IOres:Integer; begin {$I-} Assign(ffe,Name); Reset(ffe); IOres:=IOResult; If IOres=0 then Close(ffe); FileExists:=IOres=0; {$I+} end; //----------------------------------------------------------------- procedure vvoddannuh; var i:Integer; destination:String; f:f_tr; begin Assign(f,'train_1'); Rewrite(f); for i:=1 to n do begin Write('Введите номер поезда: '); Readln(train[i].numbertrain); Write('Введите пункт назначения: '); Readln(train[i].destination); Write('Введите время отправления (чч мм): '); Readln(train[i].timeofdeparture_h,train[i].timeofdeparture_m); Write('Введите количество свободных мест в СВ: '); Readln(train[i].sv); Write('Введите количество свободных мест в купе: '); Readln(train[i].compartment); Write('Введите количество свободных мест в плацкарте: '); Readln(train[i].plackart); write(f,train[i]); end; Close(f) end; //----------------------------------------------------------------- Procedure Show_data(a:tmas;Nshd:Integer); var i:Integer; begin If Nshd=0 then writeln('Таких поездов нет!') else begin writeln ('------------------------------------------------------------'); writeln ('номер / пункт назначения / время отпр. / св / купе / плацк. '); writeln ('------------------------------------------------------------'); for i:=1 to Nshd do writeln(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); end end; //----------------------------------------------------------------- Procedure vuvoddannuh(F_Name:String;a:tmas;Nvuv:Integer); var i:Integer; f:f_tr; begin Assign(f,F_Name); Rewrite(f); for i:=1 to Nvuv do write(f,a[i]); Close(f) end; //------------------------------------------------------------------------------------------ Procedure Read_data(F_Name:String; Nrd:Integer; Var a: tmas); Var i:Integer; f:f_tr; begin Assign(f,F_Name); Reset(f); for i:=1 to Nrd do read(f,a[i]); Close(f) end; //------------------------------------------------------------------------------------------ Procedure Swap(Var k, l: traininfo); Var m:traininfo; begin m:=k; k:=l; l:=m; end; // -------------------------------------------------------------------------- Procedure sortirovka(a1:tmas;var a2:tmas); var b:tmas; x:traininfo; i,j:Integer; begin b:=a1; for i:=1 to n-1 do for j:=1 to n-i do if b[j].destination>b[j+1].destination then Swap(b[j],b[j+1]); a2:=b; end; //-------------------------------------------------------------------------------- Procedure search_train(a:tmas;destination:string;tm1,tm2:real;var Nst:Integer); var i,S:Integer; f:f_tr; begin S:=0; Assign(f,'train_3'); Rewrite(f); 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 Inc(S); Write(f,a[i]); end; Close(f); Nst:=S; end; begin SetConsoleOutputCP(1251); if FileExists('train_1') then begin Writeln('Файл данных существует. Что с ним делать?'); Writeln(' 1 - удалить и ввести данные заново'); Writeln(' 2 - работать с существующими данными'); Readln(fd); if fd=2 then begin Read_Data('train_1',n,train); Writeln('Исходное расписание:'); Show_Data(train,n); Writeln('Нажмите "Enter" для продолжения...'); Readln; sortirovka(train,train); vuvoddannuh('train_2',train,n); Read_Data('train_2',n,train); Writeln('Упорядоченное расписание:'); Show_Data(train,n); Writeln('Нажмите "Enter" для продолжения...'); Readln; Writeln('Введите пункт назначения:'); Readln(destination); writeln('Введите период времени (формат ввода чч мм):'); write('с '); readln(t_h,t_m); time1:=t_h+t_m/100; write('по '); Readln(t_h,t_m); time2:=t_h+t_m/100; search_train(train,destination,time1,time2,M); Read_Data('train_3',M,train); Show_Data(train,M); end else begin Assign(fx,'train_1'); Erase(fx); vvoddannuh; end; end else vvoddannuh; Writeln('Для выхода нажмите "Enter"'); readln end. |
12.08.2012, 15:03 | #5 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Ну вот те здрасьте!
Несколько часов отлаживал, гонял в хвост и в гриву и пожалуйста! На всякий случай, перечень отличий. Поскольку у меня DOS Free Pascal, то: 1. Были закомментарены указание транслятору {$APPTYPE CONSOLE} и радел Uses - у меня таких модулей нет, да и не нужны. 2. В начале тела программы была закомментарена строка SetConsoleOutputCP(1251); По той же причине. 3. В путях к файлам был прописан диск D, т.е, например, не Assign(f,'train_2'); а Assign(f,'D:\train_2'); Вроде и всё. А подробнее можно? На что именно ругается, что сообщает и т.п. |
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
12.08.2012, 15:28 | #8 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Ага - ну понял! Вернее, вычитал.
Всё дело во втором поле записи - destination. Этот Ваш Object-Pascal, как и Delphi, не переносит в записи строк необъявленной длины. Поставьте вместо destination:string; что-нибудь типа destination:string[30]; и всё пойдет. Мой-то Паскаль жрёт и не давится. |
12.08.2012, 20:33 | #10 (permalink) |
support
Регистрация: 19.08.2007
Адрес: Зея
Сообщений: 15,797
Записей в дневнике: 71
Сказал(а) спасибо: 166
Поблагодарили 203 раз(а) в 86 сообщениях
Репутация: 75760
|
Что-то мне подсказывает, что у ТС какая-нибудь версия не к добру упомянутого ПаскальАБС
|
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
|
|