Помощь - Поиск - Пользователи - Календарь
Полная версия: Таблица рекордов с записью в файл.
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
dream-x
Всех Приветствую! Вот есть 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.
dream-x
Ну неужели никто не знает в чем дело, в чем косяк...
volvo
Программа запутана чрезмерно, вот и не хочется ползать по исходнику... Ты лучше скажи, все, что тебе надо - это уметь создавать пустую таблицу, и добавлять в нее рекорды? Так это делается гораздо проще... По какому признаку эта таблица должна сортироваться?
dream-x
Цитата(volvo @ 9.05.2008 23:00) *

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

Да мне просто нужно чтобы был файл (например tablica) и в него добавлялись записи это как бы первое и чтобы можно было все очищать... А сортироваться они должны по количеству совершенных ходов и все... Я буду тебе очень признателен если покажешь как это сделать или посмотришь мой исходник и еще я не могу понть почему в него добавляются какие-то числа , символы...
volvo
Ну, в общем, вот что у меня получилось. При 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.

dream-x
Ой спасибо volvo! Но все равно туда заносятся непонятные имена и числа... У тебя так же?
Щас сделаю чтобы по возрастанию сортировалась и все. Спасибо...
volvo
Цитата
Но все равно туда заносятся непонятные имена и числа... У тебя так же?

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

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

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

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


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
Цитата(volvo @ 10.05.2008 11:31) *

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

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

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;
dream-x
Спасибо ОГРОМНОЕ. Вот то что мне было нужно все понятно теперь уже все разобрал... Еще раз спасибо!!!
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.