1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Записи, Динамика, Текстовые и Типизированые файлы, простая база
Вроде никаких явно бросающихся в глаза недочетов нет, за исключением, возможно, вот чего:
У тебя в программе сразу выделяется память под 1000 записей, так? Зададимся вопросом: "А почему именно 1000?" Не в том ли дело, что больше при таком размере структуры New может и не дать, ибо есть ограничение на размер блока, выделяемого с помощью New?
Вот я и клоню к тому, что... А почему бы не перестать забивать память сразу заведомо ограниченным количеством записей (которые, возможно, никто и не использует, но с другой стороны - а если понадобится больше? А нельзя )
Так вот, собственно, предложение:
Type PClass_r = ^Class_r; Class_r = Record { Ну, тут то что у тебя и было... } End;
И потом Выделить, как ты и делал, память под массив 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 записей, что, согласись, серьезнее
Как тебе такой вариант?
А насчет поиска - что именно у тебя не получается? Что надо сделать с теми, кто критерию поиска удовлетворяет? Просто распечатать? Или где-то сохранить? Так ведь множества тоже никто не отменял. Или эмуляторы множеств для большего числа элементов Надо - покажу, как...
Как результат - более гибкая работа с памятью (которой, как известно, много никогда не бывает), да и обрабатывать сможешь не до 1000, а до 16380 записей, что, согласись, серьезнее
отлично! переделаем)
ой блин! тут надо ещё удаление сделать, но с этим разберёмся!
ещё немножко над процедурой пойска посижу и покажу её...
зы а что за скрипт работает на странице?! он очень не нравиться фоксу) наверно паскоде или ещё что-то...
а вот с удалением крах полный! если у кого есть минутка помогите мне с этими злобными процедурами
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;
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');
голова гудит от преподавателя! вот набросал процедуру удаления как и плонировал, но опять прокол! и процедура пойска не удаёться(((
"(Показать/Скрыть)
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;
набросок
а ещё надо сделать эту же задачу используя связанный список а потом всё это в виде объектов да и занимательную графику вставить...но этим я займусь в среду! а пока надо это доколотить! *помогите люди добрые* (С)
punkska, пойми, ты даешь выдранную из контекста информацию, и я ничем не могу тебе помочь... Ты не объяснил, что значат параметры, которые ты передаешь в Delete, но тот вариант, который предложил я (безо всяких параметров кроме количества элементов в массиве, и собственно массива Stud - прямое удаление по номеру) тебя не устроил...
Так расскажи, что содержат параметры Data, F_kol, F_mas, opis...
Вечер добрый Вон я что написал! и за что получал целый день по голове! что необходимо сделать 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;
Внимание на процедуры ПОЙСК и УДАЛИТЬ и на их обращение в меню 1. убрал запрос из меню и добавил в тело ПОЙСКА ( ввод даты для пойска) после этого не отображаеться таблица найденных (она пуста) я понимаю почему это...точнее догадываюсь, но мне кажеться и так должно рабатать... Если вернуть ЗАПРОС НА ДАТУ ДЛЯ ПОЙСКа в меню, то таблица найденных отображаеться но тогда --> 2. удаление! что-то тут не чисто ! удаляет не по одному а по 2, 3 и тп (с первого и по номерр вводимый с кл) вроде ясно где искать ошибки! но не вижу их(((
зы Лето только наступилп, а телепаты уже в отпуске((( жаль( =)