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

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

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

 
 Ответить  Открыть новую тему 
> Типизированный файл. Записи. Сортировка.
сообщение
Сообщение #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 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






-SOKOL-, то что у тебя есть в процедуре prosmotr - недостаточно для сортировки. Нужно 2 вложенных цикла, посмотри тему в FAQ-е. Да и потом, ты сортируешь содержимое массива, а где ты читаешь данные из файла в mass?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #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 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


поиск
****

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

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


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

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


--------------------
typedef void Śūnyatā ;
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #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 мин.
Цитата
Ты сравнивешь по длине имени или я что то не так понял ?
Сравнение строк - обычная операция...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


поиск
****

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

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


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


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





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

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


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

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

 





- Текстовая версия 19.04.2024 4:30
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name