Форум «Всё о Паскале» > Записи, Динамика, Текстовые и Типизированые файлы

Помощь - Поиск - Пользователи - Календарь

Полная версия: Записи, Динамика, Текстовые и Типизированые файлы

Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи

punkska

22.05.2006 14:31

Поля
1. ф
2. И
3. О
4. оценка
5. др
пойск по оценке

Проверте пожалуйста правильность написанной программы
особенно с файлами! не на путал ли я что...
может есть излишества или глупости!

Нажмите для просмотра прикрепленного файла

и может кто поможет с процедурой пойска...а то что-то она не получаеться...

volvo

22.05.2006 15:23

Вроде никаких явно бросающихся в глаза недочетов нет, за исключением, возможно, вот чего:

У тебя в программе сразу выделяется память под 1000 записей, так? Зададимся вопросом: "А почему именно 1000?"

Не в том ли дело, что больше при таком размере структуры New может и не дать, ибо есть ограничение на размер блока, выделяемого с помощью New?

Вот я и клоню к тому, что... А почему бы не перестать забивать память сразу заведомо ограниченным количеством записей (которые, возможно, никто и не использует, но с другой стороны - а если понадобится больше? А нельзя

)

Так вот, собственно, предложение:

Type
  PClass_r = ^Class_r;
  Class_r = Record
    { Ну, тут то что у тебя и было... }
  End;

Const
  q = 65520 div sizeof(PClass_r);

  _class = array [1 .. q] of PClass_r; { <--- Чувствуешь разницу? }
  PtrClass = ^_class;

И потом Выделить, как ты и делал, память под массив Stud, только он будет содержать НЕ сами данные, а указатели на них.

Тогда при необходимости добавить данные в массив - делается так:


  { где-то в начале программы}
  new(Stud);

  { ... }
  { а при добавлении студентов: }
  writeln('Tape quantity of adding students'); readln(n);
  for i:=1 to n do begin

    new(stud^[i]); { Выделяем память под ДАННЫЕ }

    with Stud^[i]^ do begin
      // Все действия - как у тебя и было
    end;
...

Как результат - более гибкая работа с памятью (которой, как известно, много никогда не бывает), да и обрабатывать сможешь не до 1000, а до 16380 записей, что, согласись, серьезнее

Как тебе такой вариант?

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

Надо - покажу, как...

punkska

22.05.2006 15:39

Цитата

отлично! переделаем)

ой блин! тут надо ещё удаление сделать, но с этим разберёмся!

ещё немножко над процедурой пойска посижу и покажу её...

зы а что за скрипт работает на странице?! он очень не нравиться фоксу)

наверно паскоде или ещё что-то...

volvo

22.05.2006 15:48

Цитата

а что за скрипт работает на странице?!

Это подсветка синтаксиса. На больших исходниках может подтормаживать (хотя у меня тоже FF, и в этой теме пока тормозов не заметно).

Если хочешь - убери из поста программу, все равно есть присоединенный архив...
Done

punkska

22.05.2006 15:56

а вот с удалением крах полный! если у кого есть минутка помогите мне с этими злобными процедурами

procedure Delete(var n:integer;var Stud: PtrClass;
                 D_kol: integer; D_mas: mas;  Opis: PtrClass;
                 OutPuе:outproc);
var
  b,j,i,c:integer;
  An:char;
begin

  repeat
     repeat
        repeat
           ClrScr;
           OutPut(D_kol,Opis);
           writeln('Do you want to delete some elements?');
           readln(An);
           if (An<>'n') and (An<>'y') then
              begin
                   writeln('Answer Yes or No!');
                   writeln('Try again. Press Enter...');
                   readln;
              end;
        until (An='n') or (An='y');
        if An='n' then exit;
        repeat
              clrscr;
              OutPut(D_kol,Opis);
              writeln('Tape the number to delete: ');
              readln(b);
              if (b>D_kol) or (b<1) then
                 begin
                      writeln('Error in number!!');
                      writeln('Try again.Press Enter...');
                      readln;
                      end;
        until (b<=D_kol) and (b>=1);
 что-то тут я хотел написать....

writeln('Are you shure? (y/n)');
              readln(An);
        until (An='y') or (An='n');
     until An='y';
     for i:=1 to D_kol do
         begin
          if i=b then
             begin
                  n:=n-1;
                  D_kol:=D_kol-1;
                  for c:=D_mas[i] to n do
                      Stud^[c]:=Stud^[c+1];
                  for i:=b to D_kol do
                      begin
                           Opis^[i]:=Opis^[i+1];
                           D_mas[i]:=D_mas[i+1]-1;
                      end;
             end;
         end;
         clrscr;
         writeln ('Element is erased!');
         readln;
     until An='n';
end;

такой набросок! я в нём уже запутался 100 раз!

volvo

22.05.2006 16:09

Ты расскажи, что именно ты удалять хочешь? какой-то один конкретный элемент, или несколько сразу? (можно и так и так сделать)

punkska

22.05.2006 16:13

да...я думаю не стоит заморачиваться и стоит удалять по 1 элементу...

volvo

22.05.2006 16:30

Ну, если по одному, тогда вот так:

procedure Delete(var n:integer; var Stud: PtrClass);
var
  b: integer;
  An:char;
begin

  repeat
    repeat
      repeat
        ClrScr;
        OutPut(n, stud);
        writeln('Do you want to delete some elements?');
        readln(An);
        if (An<>'n') and (An<>'y') then begin
          writeln('Answer Yes or No!');
          writeln('Try again. Press Enter...');
          readln;
        end;
      until (An='n') or (An='y');

      if An='n' then exit;

      repeat
        clrscr;
        OutPut(n, stud);
        writeln('Tape the number to delete: ');
        readln(b);
        if (b>n) or (b<1) then begin
          writeln('Error in number!!');
          writeln('Try again.Press Enter...');
          readln;
        end;
      until (b<=n) and (b>=1);

      writeln('Are you sure? (y/n)');
      readln(An);
    until (An='y') or (An='n');

  until An='y';

  move(stud^[b+1], stud^[b], (n - b)*sizeof(stud^[1]));
  dec(n);

  clrscr;
  writeln ('Element is erased!');
  readln;
end;

punkska

22.05.2006 21:56

опять я решил делать как легче и ошибся(

голова гудит от преподавателя!

вот набросал процедуру удаления как и плонировал, но опять прокол! и процедура пойска не удаёться(((

" (Показать/Скрыть)


procedure Search(n:integer; Stud: PtrClass;
                 Data: Data_r;
                 var F_kol: integer; var F_mas: mas;
                 var opis:PtrClass);
var
   i:integer;
   begin
     ClrScr;
     F_kol:=0;
     new(Opis);
     for i:=1 to n do
              begin
                   if 
                      begin
                           F_kol:=F_kol+1;
                           F_mas[F_kol]:=i;
                           Opis^[F_kol]:=Stud^[i];
                      end;
              end;
end;


procedure Delete(var n:integer;var Stud: PtrClass;
                 D_kol: integer; D_mas: mas; Opis: PtrClass;
                 OutPut:outclass);
{ дата мне тут не к чему?}
var
  b,j,i,c:integer;
  An:char;
begin

  repeat
     repeat
        repeat
           ClrScr;
           OutPut(D_kol,Opis);
           writeln('Do you want to delete some students?');
           readln(An);
           if (An<>'n') and (An<>'y') then
              begin
                   writeln('Answer Yes or No!');
                   writeln('Try again. Press Enter...');
                   readln;
              end;
        until (An='n') or (An='y');
        if An='n' then exit;
        repeat
              clrscr;
              OutPut(D_kol,Opis);
              writeln('Tape the number to delete: ');
              readln(b);
              if (b>D_kol) or (b<1) then
                 begin
                      writeln('Error in number!!');
                      writeln('Try again.Press Enter...');
                      readln;
                      end;
        until (b<=D_kol) and (b>=1);
{как используя обойти эту табличку, не кдалось приспособить outclass}
        repeat
              clrscr;
              writeln(
  & #39;ДДДДДВДДДДДДДДДДВДДДДДДДДДДДВДДДДДДДДД
ДДДДВДДДДДДДДДДДДВДДДДДДДДДДДДДДДДДД'
              );
             writeln('і  ь  і   Name   і  Surname  і Partionymic і Estimation і    Data          і');
             writeln(
  & #39;ГДДДДДЕДДДДДДДДДДЕДДДДДДДДДДДЕДДДДДДДД
ДДДДДЕДДДДДДДДДДДДЕДДДДДДДДДДДДДДДДДД'
              );
              with Stud^[D_mas[b]] do
               writeln('і  ', i ,'  і ',name:7, '  і ',surname:9,' і ',Partonymic:10,'  і' ,Estimation :11, ' і  ',
                Day:4,'.',Month:2,'.',Year:4,     '    і');
            writeln(
  & #39;ДДДДДБДДДДДДДДДДБДДДДДДДДДДДБДДДДДДДДД
ДДДДБДДДДДДДДДДДДБДДДДДДДДДДДДДДДДДД'
              );
              writeln;
              writeln('Are you shure? (y/n)');
              readln(An);
        until (An='y') or (An='n');
     until An='y';
     for i:=1 to D_kol do
         begin
          if i=b then
             begin
                  n:=n-1;
                  D_kol:=D_kol-1;
                  for c:=D_mas[i] to n do
                      Stud^[c]:=Stud^[c+1];
                  for i:=b to D_kol do
                      begin
                           Opis^[i]:=Opis^[i+1];
                           D_mas[i]:=D_mas[i+1]-1;
                      end;
             end;
         end;
         clrscr;
         writeln ('Element is erased!');
         readln;
     until An='n';
end;

набросок

а ещё надо сделать эту же задачу используя связанный список
а потом всё это в виде объектов да и занимательную графику вставить...но этим я займусь в среду! а пока надо это доколотить! *помогите люди добрые* (С)

volvo

22.05.2006 22:15

punkska, пойми, ты даешь выдранную из контекста информацию, и я ничем не могу тебе помочь... Ты не объяснил, что значат параметры, которые ты передаешь в Delete, но тот вариант, который предложил я (безо всяких параметров кроме количества элементов в массиве, и собственно массива Stud - прямое удаление по номеру) тебя не устроил...

Так расскажи, что содержат параметры Data, F_kol, F_mas, opis...

punkska

30.05.2006 2:54

Вечер добрый
Вон я что написал! и за что получал целый день по голове!
что необходимо сделать
1 пойск по дате (оказываеться) ! как вам мой выриант? мне пока не нравиться...
2 сделать ввод в процедуре пойска (раньше было в меню)
3. разделитьь на 2 пункта УДАЛИТЬ и ПОЙСК (ну это не проблема)
на что прошу обратить внимание
на процедуру пойска и удаления! что-то я там репитов дофига наставил (в один момент даже запутался)
ну и просто ошибочки посмотрите! ПРЕПОДАВАТЕЛЬ ОЧЕНЬ СТРОГО относиться к правильности и грамотности прог.!

" (Показать/Скрыть)

procedure Search(n:integer; Stud: PtrClass;
                 Data: Data_r;
                 var F_kol: integer; var F_mas: mas;
                 var opis:PtrClass);
var
   i:integer;
   Y_,Y,M_,M,D_,D:word;
begin
     WriteLn('Enter date');

     InPutDate(Date);
     readln;
     ClrScr;
     F_kol:=0;
     Y_:=Data.Year;
     M_:=Data.Month;
     D_:=Data.Day;
     new(Opis);
     for i:=1 to n do
         with stud^[i] do
         with data do
              begin
                   Y:=Data.Year;
                   M:=Data.Month;
                   D:=Data.Day;
                   if ((Y_>Y) or
                      ((Y_=Y) and (M_>M)) or
                      ((Y_=Y) and (M_=M) and (D_>=D))) then
                      begin
                           F_kol:=F_kol+1;
                           F_mas[F_kol]:=i;
                           Opis^[F_kol]:=Stud^[i];
                      end;
              end;
end;


procedure Delete(var n:integer;var Stud: PtrClass;
                 D_kol: integer; D_mas: mas; Opis: PtrClass;
                 OutPut:outclass);
var
  b,j,i,c:integer;
  An:char;
begin

           ClrScr;
       repeat
           OutPut(D_kol,Opis);
           writeln('Do you want to delete some students?');
           readln(An);
           if (An<>'n') and (An<>'y') then
              begin
                   writeln('Answer Yes or No!');
                   writeln('Try again. Press Enter...');
                   readln;
              end;
        until (An='n') or (An='y');
        if An='n' then exit;

        repeat
              clrscr;
              OutPut(D_kol,Opis);
              writeln('Tape the number to delete: ');
              readln(b);
              if (b>D_kol) or (b<1) then
                 begin
                      writeln('Error in number!!');
                      writeln('Try again.Press Enter...');
                      readln;
                      end;
        until (b<=D_kol) and (b>=1);

        repeat
              clrscr;
              OutPut(b,Opis);
              writeln('Are you shure? (y/n)');
              readln(An);
        until (An='y') or (An='n');
     for i:=1 to D_kol do
         begin
          if i=b then
             begin
                  n:=n-1;
                  D_kol:=D_kol-1;
                  for c:=D_mas[i] to n do
                      Stud^[c]:=Stud^[c+1];
                  for i:=b to D_kol do
                      begin
                           Opis^[i]:=Opis^[i+1];
                           D_mas[i]:=D_mas[i+1]-1;
                      end;
             end;
         end;
         clrscr;
         writeln ('Element is erased!');
         readln;
end;

изменил ввывод! убрал лишнюю кашу!
оцените!

punkska

5.06.2006 22:08

почему если внести ввод даты для пойска в тело процедуры... процедура начинает работать не верно?

volvo

5.06.2006 22:53

Телепатия? Как изменил, что сделал - покажи...

punkska

6.06.2006 0:10

Внимание на процедуры ПОЙСК и УДАЛИТЬ и на их обращение в меню
1. убрал запрос из меню и добавил в тело ПОЙСКА ( ввод даты для пойска)
после этого не отображаеться таблица найденных (она пуста)
я понимаю почему это...точнее догадываюсь, но мне кажеться и так должно рабатать...
Если вернуть ЗАПРОС НА ДАТУ ДЛЯ ПОЙСКа в меню, то таблица найденных отображаеться но тогда -->
2. удаление! что-то тут не чисто ! удаляет не по одному а по 2, 3 и тп (с первого и по номерр вводимый с кл)
вроде ясно где искать ошибки! но не вижу их(((

зы Лето только наступилп, а телепаты уже в отпуске((( жаль( =)

volvo

6.06.2006 1:01

Глобальные переменные - зло... Избавляйся от них. Это одно.

Второе: в процедуре Search есть такие строки:

...
WriteLn('Enter date');
InPutDate(Date);
...

А расскажи мне, зачем ты вводишь дату, если потом ее нигде на протяжении этой процедуры не используешь? Да и не только в этой процедуре, а вообще...

Ты часом Date с Data не перепутал???

Это условие тоже порадовало:

if (Y_=Y) and (M_=M) and ((D_=D) or (D_<>D)) then

особенно его правая часть

punkska

6.06.2006 1:24

Спасибо Volvo, выручил) и насмешил))

особенно его правая часть

ага! крутезна!!!! ))))) тока заметил)))

блин... меня еле откачали! в юмор надо)

осталось удаление... будем ошибку искать)

Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.