Таблица рекордов с записью в файл. Опции

[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]

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

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

Сообщение отредактировано: dream-x - 9.05.2008 22:16

[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]

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

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


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

Добавлено через 1 мин.

Щас сделаю чтобы по возрастанию сортировалась и все.

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

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

Сообщение отредактировано: volvo - 10.05.2008 11:02

[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 мин.

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


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

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

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

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

Сообщение отредактировано: dream-x - 10.05.2008 14:13

[dream-x]

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

Покажи как я что-то не пойму у меня они с низу вверх удут... Но по убыванию...

[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]

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