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