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

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

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

 
 Ответить  Открыть новую тему 
> Таблица рекордов с записью в файл.
сообщение
Сообщение #1


Пионер
**

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

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


Всех Приветствую! Вот есть 2 "небольшие" проблемы, 1-ая заключается в том что запись в существующую таблицу не добавляются, а 2-ая интереснее в таблице появляются странные записи и откуда они я не знаю, но если перезаписать файл они исчезают...
вот код программы:

USES
CRT,GRAPH;
TYPE
tablic=record
name:string[20]; {?¬п ЁЈа®Є }
chislohodov:integer;{—Ёб«® 室®ў}
time: record
chast:0..60; {— бл ЁЈал}
mint:0..60; {ЊЁ­гвл}
sect:0..60; {‘ҐЄг­¤л}
end;
razmerpoly:0..6; {ђ §¬Ґа Ї®«п}
end;
shest=0..60;
tabtype=file of tablic;
VAR
sec,min,chas,dlina:shest;
j,i,pr,pt,hodi:integer;
t:boolean;
PROCEDURE PROSMOTR(var f:tabtype);

VAR
st:string;
s:tablic;
h:char;
i,x,y:integer;
BEGIN

reset(f);
setbkcolor(11);
setfillstyle(1,7);
bar(10,10,getmaxX-10,getmaxY-10);
setcolor(4);
setlinestyle(0,0,3);
bar3d(15,15,getmaxX-20,getmaxY-20,0,false);
settextstyle(6,0,1);
rectangle(15,45,getmaxX-20,106);
line(50,47,50,getmaxY-20);
line(290,45,290,getmaxY-20);
line(360,45,360,getmaxY-20);
line(410,80,410,getmaxY-20);
line(360,80,getmaxX-90,80);
line(476,80,476,getmaxY-20);
line(getmaxX-90,45,getmaxX-90,getmaxY-20);
settextstyle(6,0,1);
setcolor(10);
outtextXY(25,55,'N ?Њ…ЌЂ ?ѓђЋЉЋ‚');
outtextXY(293,50,'—Ёб«®');
outtextXY(293,65,'室®ў');
outtextXY(390,50,'‚ђ…Њџ ?ѓђ›');
outtextXY(363,85,'— бл');
outtextXY(413,85,'ЊЁ­гвл');
outtextXY(477,85,'‘ҐЄг­¤л');
outtextXY(getmaxX-85,55,'ђ §¬Ґа');
outtextXY(getmaxX-85,75,' Ї®«п ');
outtextXY(25,20,'‹“—˜Ђџ „…‘џ’ЉЂ ?ѓђЋЉЋ‚, ЉЋѓ„Ђ-‹?ЃЋ ?ѓђЂ‚™?• ‚ ќ’“ ?ѓђ“');
setcolor(1);
setlinestyle(1,1,1);
for i:=1 to 10 do
begin
str(i,st);
outtextXY(25,i*35+80,st);
line(15,i*35+107,getmaxX-20,i*35+107);
end;
x:=55;
y:=85;
setcolor(14);
for i:=1 to 10 do
begin
seek(f,i-1);
read(f,s);
with s do
begin
y:=y+35;
outtextXY(x,y,name);
str(chislohodov,st);
outtextXY(x+250,y,st);
with time do
begin
str(chast,st);
outtextXY(x+320,y,st);
str(mint,st);
outtextXY(x+370,y,st);
str(sect,st);
outtextXY(x+450,y,st);
end;
str(razmerpoly,st);
outtextXY(x+525,y,st);
end;
end;
readkey;
close(f);
cleardevice;
END;

PROCEDURE TABLICA(t:boolean);
VAR
c,s,m:integer;
store,new:array [1..5] of integer;
soder:array [1..12] of tablic;
tabfile:tabtype;
PROCEDURE PEREZAPIS(var f:tabtype);
BEGIN
rewrite(f);
for i:=1 to 12 do
begin
with soder[i] do
begin
name:='';
razmerpoly:=0;
with time do
begin
chast:=0;
mint:=0;
sect:=0;
end;
chislohodov:=0;
write(f,soder[i]);
end;
end;
close(f);
END;
PROCEDURE PROBA(st,ne:integer);
var j:integer;
BEGIN
if st<ne
then begin
for j:=10 downto i do
begin
soder[j+1]:=soder[j];
seek(tabfile,j);
write(tabfile,soder[j+1]);
end;
seek(tabfile,i-1);
write(tabfile,soder[12]);
i:=10;
end
Else if (st=ne) and (m<5)
then begin
m:=m+1;
PROBA(store[m],new[m]);
end;
END;
PROCEDURE ZAPIS(var f:tabtype);
VAR
s:string;
BEGIN
new[1]:=dlina;
store[2]:=chas;
store[3]:=min;
store[4]:=sec;
new[5]:=hodi;
s:='den';
with soder[12] do
begin
name:='adsg';
razmerpoly:=dlina;
with time do
begin
chast:=chas;
mint:=min;
sect:=sec;
end;
chislohodov:=hodi;
end;
reset(f);
for i:=1 to 10 do
begin
with soder[i] do
begin
store[5]:=chislohodov;
with time do
begin
new[2]:=chast;
new[3]:=mint;
new[4]:=sect;
end;
store[1]:=razmerpoly;
end;
m:=1;
PROBA(store[m],new[m]);
end;
close(f);
END;
BEGIN
readkey;
assign(tabfile,'tablica.bak');
{ PEREZAPIS(tabfile);}
ZAPIS(tabfile);
PROSMOTR(tabfile);

END;


{prog}
begin
pr:=detect;
initgraph(pr,pt,'');
t:=true;
hodi:=88;
chas:=4;
min:=55;
sec:=4;
dlina:=4;
tablica(t);
readkey
End.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Пионер
**

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

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


Ну неужели никто не знает в чем дело, в чем косяк...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Гость






Программа запутана чрезмерно, вот и не хочется ползать по исходнику... Ты лучше скажи, все, что тебе надо - это уметь создавать пустую таблицу, и добавлять в нее рекорды? Так это делается гораздо проще... По какому признаку эта таблица должна сортироваться?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Пионер
**

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

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


Цитата(volvo @ 9.05.2008 23:00) *

Программа запутана чрезмерно, вот и не хочется ползать по исходнику... Ты лучше скажи, все, что тебе надо - это уметь создавать пустую таблицу, и добавлять в нее рекорды? Так это делается гораздо проще... По какому признаку эта таблица должна сортироваться?

Да мне просто нужно чтобы был файл (например tablica) и в него добавлялись записи это как бы первое и чтобы можно было все очищать... А сортироваться они должны по количеству совершенных ходов и все... Я буду тебе очень признателен если покажешь как это сделать или посмотришь мой исходник и еще я не могу понть почему в него добавляются какие-то числа , символы...

Сообщение отредактировано: dream-x -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Гость






Ну, в общем, вот что у меня получилось. При T = false происходит очистка таблицы, при T = true в таблицу на нужное место добавляется информация, заданная записью NewRec... Запусти сначала один раз с T = false, потом еще несколько раз с T = true, меняя содержимое этой записи, увидишь работу программы... Все лишние переменные убраны.

USES
CRT,GRAPH;
TYPE
tablic=record
name:string[20];
chislohodov:integer;
time:
record
chast:0..60;
mint:0..60;
sect:0..60;
end;
razmerpoly:0..6;
end;

tabtype = file of tablic;

const
EmptyRec: Tablic = (
name:'';
chislohodov:0;
time:(chast:0; mint:0; sect:0);
razmerpoly:0;
);

VAR
NewRec: Tablic;

procedure sort(var arr: array of Tablic; const n: integer);
var
i, j: integer;
T: Tablic;
begin
for i := 0 to n - 1 do
for j := n - 1 downto i + 1 do
if arr[j - 1].chislohodov < arr[j].chislohodov then begin
T := arr[j - 1]; arr[j - 1] := arr[j]; arr[j] := T;
end;
end;

PROCEDURE PROSMOTR(var f:tabtype);
VAR
st:string;
s:tablic;
h:char;
i,x,y:integer;
BEGIN
setbkcolor(11);
setfillstyle(1,7);
bar(10,10,getmaxX-10,getmaxY-10);
setcolor(4);
setlinestyle(0,0,3);
bar3d(15,15,getmaxX-20,getmaxY-20,0,false);
settextstyle(6,0,1);
rectangle(15,45,getmaxX-20,106);
line(50,47,50,getmaxY-20);
line(290,45,290,getmaxY-20);
line(360,45,360,getmaxY-20);
line(410,80,410,getmaxY-20);
line(360,80,getmaxX-90,80);
line(476,80,476,getmaxY-20);
line(getmaxX-90,45,getmaxX-90,getmaxY-20);
settextstyle(6,0,1);
setcolor(10);

outtextXY(25,55,'N Имена игроков');
outtextXY(293,50,'Число');
outtextXY(293,65,'ходов');
outtextXY(390,50,'ВРЕМЯ ИГРЫ');
outtextXY(363,85,'Часы');
outtextXY(413,85,'Минуты');
outtextXY(477,85,'Секунды');
outtextXY(getmaxX-85,55,'Размер');
outtextXY(getmaxX-85,75,' поля ');
outtextXY(25,20,'Лучшая десятка игроков, когда-либо игравших в эту игру');
setcolor(1);
setlinestyle(1,1,1);

for i:=1 to 10 do begin
str(i, st);
outtextXY(25,i*35+80,st);
line(15,i*35+107,getmaxX-20,i*35+107);
end;
x:=55;
y:=85;
setcolor(14);

reset(f);
for i:=1 to 10 do begin
read(f, s);
with s do begin
y:=y+35;
outtextXY(x,y,name);
str(chislohodov,st);
outtextXY(x+250,y,st);
with time do begin
str(chast,st);
outtextXY(x+320,y,st);
str(mint,st);
outtextXY(x+370,y,st);
str(sect,st);
outtextXY(x+450,y,st);
end;
str(razmerpoly,st);
outtextXY(x+525,y,st);
end;
end;
readkey;
close(f);
cleardevice;
END;

PROCEDURE TABLICA(t:boolean);
VAR
soder: array[1 .. 11] of tablic;

PROCEDURE PEREZAPIS(var f:tabtype);
var i: integer;
BEGIN
rewrite(f);
for i := 1 to 10 do
write(f, EmptyRec);
close(f);
END;

procedure Insert(var f: tabtype; NewRec: Tablic);
var i: integer;
begin
reset(f);
for i := 1 to 10 do
read(f, soder[i]);
soder[11] := NewRec;
sort(soder, 11);
rewrite(f);
for i := 1 to 10 do
write(f, soder[i]);
close(f)
end;

var
tabfile: tabtype;

BEGIN
readkey;
assign(tabfile,'tablica.bak');
if t then
Insert(tabfile, NewRec)
else
PEREZAPIS(tabfile);

PROSMOTR(tabfile);
END;

var
pr, pt: integer;
t: boolean;

begin
pr := detect;
initgraph(pr, pt, '');
t := true;

with NewRec do begin
name := 'petr';
chislohodov := 82;
time.chast := 3;
time.mint := 56;
time.sect := 14;
razmerpoly := 4;
end;

tablica(t);
readkey
End.

 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Пионер
**

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

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


Ой спасибо volvo! Но все равно туда заносятся непонятные имена и числа... У тебя так же?
Щас сделаю чтобы по возрастанию сортировалась и все. Спасибо...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Гость






Цитата
Но все равно туда заносятся непонятные имена и числа... У тебя так же?

mad.gif Если б у меня было так же, я бы не выложил !!!

Прикрепленное изображение
(с кириллицей разбирайся сам, я ставить другие шрифты не буду...)

Добавлено через 1 мин.
Цитата
Щас сделаю чтобы по возрастанию сортировалась и все.
Великая проблема... Для этого достаточно поменять в программе один символ...

P.S. В следующий раз давай нормальное название теме: какая ж это таблица рекордов, в которой "рекордсмены" сортируются по возрастанию достижений? Это какая-то таблица лузеров... Рекорд - это МАКСИМУМ... И значит сортировать таблицу надо по убыванию поля...

Сообщение отредактировано: volvo -
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Пионер
**

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

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


Смотри вот я правильно делаю если чтобы список сотртиравался по убыванию...
вот код:


procedure sort(var arr: array of Tablic; const n: integer);
var
i, j: integer;
T: Tablic;
begin
for i := 0 to n - 1 do
for j := n - 1 downto i do
if arr[j ].chislohodov < arr[j - 1].chislohodov then begin
T := arr[j - 1];
arr[j - 1] := arr[j];
arr[j] := T;
end;
end;


тоько они выводятся с конца...
Добавлено через 2 мин.
Цитата(volvo @ 10.05.2008 11:31) *

mad.gif Если б у меня было так же, я бы не выложил !!!

Прикрепленное изображение
(с кириллицей разбирайся сам, я ставить другие шрифты не буду...)

Добавлено через 1 мин.
Великая проблема... Для этого достаточно поменять в программе один символ...

P.S. В следующий раз давай нормальное название теме: какая ж это таблица рекордов, в которой "рекордсмены" сортируются по возрастанию достижений? Это какая-то таблица лузеров... Рекорд - это МАКСИМУМ... И значит сортировать таблицу надо по убыванию поля...

Извини я тут просто эксперементировал все ок спасибо большое... а сортировку я правильно сделал в посте повыше?

Сообщение отредактировано: dream-x -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Пионер
**

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

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


Цитата(volvo @ 10.05.2008 11:31) *

Великая проблема... Для этого достаточно поменять в программе один символ...

Покажи как я что-то не пойму у меня они с низу вверх удут... Но по убыванию...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Гость






Если я правильно понял, что тебе нужно - это отсортировать все по возрастанию, но не принимать во внимание "пустые" (еще не заполненные) записи? Тогда тут чуть сложнее:

procedure sort(var arr: array of Tablic; const n: integer);
var
i, j: integer;
T: Tablic;
begin
for i := 0 to n - 1 do
for j := n - 1 downto i + 1 do
if ((arr[j-1].name = '') and (arr[j].name <> ''))
or
(
(arr[j-1].name <> '') and (arr[j].name <> '') and
(arr[j - 1].chislohodov > arr[j].chislohodov)
)
then begin
T := arr[j - 1]; arr[j - 1] := arr[j]; arr[j] := T;
end;
end;
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Пионер
**

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

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


Спасибо ОГРОМНОЕ. Вот то что мне было нужно все понятно теперь уже все разобрал... Еще раз спасибо!!!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





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