IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Типизированный файл. Записи. Сортировка.
-SOKOL-
сообщение 17.04.2008 18:19
Сообщение #1





Группа: Пользователи
Сообщений: 4
Пол: Мужской

Репутация: -  0  +


И снова здраствуйте...
В программе нужно сделать регистрацию товара и вывод списка товаров отсортированных по алфавиту...
У меня получается так, что когда я регистрирую новый товар, на выводе он выводит себя несколько раз+ стирает предыдущий =\ что я не так сделал?

program a;
uses crt;
type
rega=record
num:integer;
name:string;
har:string;
data:integer;
garant:integer;
cenao:integer;end;

var
out:file of rega;
nam:rega; buf:rega;
i,j:integer;
mass:array[1..20] of rega;

procedure registration;begin
clrscr;
assign(out,'firma.dat');
reset(out);

write ('Введите регистрационный номер:');
readln(nam.num);
write ('Введите наименование');
readln (nam.name);
write ('Введите характеристику');
readln (nam.har);
write ('‚Введите дату производства:');
readln (nam.data);
write ('Введите срок гарантии');
readln (nam.garant);
writeln ('Введите оптовую цену:');
readln (nam.cenao);
seek(out,filesize(out));
write(out,nam);
close(out);
end;

procedure prosmotr;
var t,k:integer; begin clrscr;
assign(out,'firma.dat');
reset(out);
t:=filesize(out);
for i:=1 to t-1 do
if mass[i].name>mass[i+1].name then begin
buf:=mass[i];
mass[i]:=mass[i+1];
mass[i+1]:=buf;
end;
rewrite (out);
for i:=1 to t do
write (out,mass[i]);
close(out);
reset(out);
while not eof(out) do
begin
read(out,buf);
writeln (nam.name);
end;
close(out);
readln;
end;

{здесь процедура меню}

begin
menu;
end.

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов(1 - 6)
volvo
сообщение 17.04.2008 18:28
Сообщение #2


Гость






-SOKOL-, то что у тебя есть в процедуре prosmotr - недостаточно для сортировки. Нужно 2 вложенных цикла, посмотри тему в FAQ-е. Да и потом, ты сортируешь содержимое массива, а где ты читаешь данные из файла в mass?
 К началу страницы 
+ Ответить 
-SOKOL-
сообщение 17.04.2008 19:43
Сообщение #3





Группа: Пользователи
Сообщений: 4
Пол: Мужской

Репутация: -  0  +


Думаю вот так? Но ничего не изменилось...

program a;
uses crt;
type
rega=record
num:integer;
name:string;
har:string;
data:integer;
garant:integer;
cenao:integer;end;

var
out:file of rega;
nam:rega; buf:rega;
i,j:integer;
mass:array[1..20] of rega;

procedure registration;begin
clrscr;
assign(out,'firma.dat');
reset(out);

write ('Введите регистрационный номер:');
readln(nam.num);
write ('Введите наименование');
readln (nam.name);
write ('Введите характеристику');
readln (nam.har);
write ('‚Введите дату производства:');
readln (nam.data);
write ('Введите срок гарантии');
readln (nam.garant);
writeln ('Введите оптовую цену:');
readln (nam.cenao);
seek(out,filesize(out));
write(out,nam);
close(out);
end;

procedure prosmotr;
var t,k:integer; begin clrscr;
assign(out,'firma.dat');
reset(out);
t:=filesize(out);
while not eof(out) do begin
read(out,buf)
mas[j]:=buf;
j:=j+1;
end;
for i:=1 to t-1 do
for j:=1 to t-i do
if mass[j].name>mass[j+1].name then begin
buf:=mas[j];
mass[j]:=mass[j+1];
mass[j+1]:=buf;
end;
rewrite (out);
for j:=1 to t do
write (out,mass[j]);
close(out);
reset(out);
while not eof(out) do
begin
read(out,buf);
writeln (nam.name);
end;
close(out);
readln;
end;

{здесь процедура меню}

begin
menu;
end.

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
renesko1
сообщение 17.04.2008 20:40
Сообщение #4


поиск
****

Группа: Пользователи
Сообщений: 346
Пол: Мужской
Реальное имя: nir

Репутация: -  2  +


if mass[j].name>mass[j+1].name then begin

Ты сравнивешь по длине имени или я что то не так понял ?


--------------------
typedef void Śūnyatā ;
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 17.04.2008 20:48
Сообщение #5


Гость






Во-первых, форматируй исходники, их же читать невозможно... А во вторых - внимательнее с несколькими вещами:
procedure prosmotr;
var
i, j: integer; { не надо работать с глобальными переменными - это чревато ошибками }
t,k:integer;

begin
clrscr;
assign(out,'firma.dat'); reset(out);

j := 0; { инициализировать переменную не помешает }
while not eof(out) do begin
read(out,buf);
j:=j+1; mass[j]:=buf; { <-- СНАЧАЛА увеличиваем, потом заносим в массив }
end;

t := j; { <-- как видишь, filesize был лишним, размер известен и так... }
for i:=1 to t do
for j:=t downto i+1 do
if mass[j-1].name>mass[j].name then begin
buf:=mass[j-1];
mass[j-1]:=mass[j];
mass[j]:=buf;
end;

rewrite (out);
for j:=1 to t do
write (out,mass[j]);
reset(out); { <--- переоткрываешь для чтения - close не обязателен }

while not eof(out) do begin
read(out,buf);
writeln (buf.name); { <--- Печатаешь то, что ПРОЧЕЛ, а не что-то другое }
end;
close(out);
readln;
end;


Добавлено через 1 мин.
Цитата
Ты сравнивешь по длине имени или я что то не так понял ?
Сравнение строк - обычная операция...
 К началу страницы 
+ Ответить 
renesko1
сообщение 17.04.2008 20:55
Сообщение #6


поиск
****

Группа: Пользователи
Сообщений: 346
Пол: Мужской
Реальное имя: nir

Репутация: -  2  +


Спасибо, буду знать.


--------------------
typedef void Śūnyatā ;
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
-SOKOL-
сообщение 17.04.2008 21:12
Сообщение #7





Группа: Пользователи
Сообщений: 4
Пол: Мужской

Репутация: -  0  +


volvo, огромное спасибо!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 15.07.2025 9:34
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"