Здравствуйте! Помогите пожалуйста!! Нужно исправить ошибки, вот задание: В бюро занятости ведется список вакантных мест на предприятиях города. Каждая запись имеет поля: Наименование организацииб расстояние в км от центра городаб должность, требуемая квалификация(разряд), стаж работы по специальности, зарплата, наличие страхованияКлиент бюро вводит информацию о своей квалификации и требованиях, распечатать для каждого клиента список, УПОРЯДОЧИТЬ ДОЛЖНОСТИ ПО АЛФАВИТУ
Сама программа:(Показать/Скрыть)
Program vacant; uses wincrt, windos, My_ZS; Const n=20; n_max=10; type vac=record Org:String[40]; Dist:Longint; Dolgn:string[20]; Razr:integer; stag:integer; zarpl:longint; strah:String[3]; end; var a:array [1..n] of vac; s:string; i:integer; PROCEDURE menu; const str1='1-Ввод записей'; str2='2-Вывод записей на экран'; str3='3-Обработка записей'; str4='4-Выход'; Begin ClrScr; GotoXY(20,3); Writeln('Выполняемые действия:'); GotoXY(1,6); Writeln(Str1); Writeln(Str2); Writeln(Str3); Writeln(Str4); End; Procedure Operation(var m:byte); var F:boolean; Begin Writeln; Repeat GotoXY(1,17);ClrEol;GotoXY(1,17); write('Выберите требуемое действие'); Readln(m); F:=(M=1) or (M=2) or (M=3) or (M=4); if not F then begin GotoXY(1,19); Writeln('Вы ошиблись, попробуйте ещё раз'); end; Until F;GotoXY(1,19);ClrEol;Writeln; end; procedure new; begin Write('Введите число записей '); Readln(N); For i:=1 to N do With a[i] do begin Writeln(i:2,'-ая запись'); Write('Введите наименование организации '); Readln(a[i].Org); Write('Введите расстояние от центра города '); Readln(a[i].Dist); Write('Введите наименование должности '); Readln(a[i].Dolgn); Write('Введите разряд(квалификацию) '); Readln(a[i].Razr); Write('Введите стаж работы '); Readln(a[i].Stag); Write('Введите зарплату '); Readln(a[i].Zarpl); Write('Введите наличие страховки("да" или "нет") '); Readln(a[i].Strah); end; end; Procedure Vivod(N:integer; a:vac); Type Mes=Record O:String[40]; D:Longint; Dl:String[20]; R:integer; S:integer; Z:Longint; Str:String[3]; end; Var K,L:Integer; Mst:Mes; Begin For i:=1 to N do with a[i] do Writeln(Org,'. ',Dist,' км. ',Dolgn,',',Razr,'разряд, стаж - ',Stag, ' зарплата - ',Zarpl,' руб., страховка - ',Strah); end; Procedure Work(N:integer; Spisok:Zapis); Var K:integer; Dl:string[20]; Rst:Longint; Qul,j:Integer; buf:vac; Begin {упорядочивание по алфавиту} clrscr; for i:=1 to n-1 do for j:=i+1 to n do if a[i].name>a[j].name then begin buf:=a[i]; a[i]:=a[j]; a[j]:=buf; For i:=1 to N do with a[i] do Writeln(Org,'. ',Dist,' км. ',Dolgn,',',Razr,'разряд, стаж - ',Stag, ' зарплата - ',Zarpl,' руб., страховка - ',Strah); Write('Введите вашу должность'); Readln(dl); For a:=1 to N do Begin with a[i] do if Dolgn=Dl Then begin Writeln(org,' ',Dolgn,' Разряд - ',Razr,' Зарплата - ',Zarpl, ' Расстояние - ',Dist,' Страховка - ',Strah); end; end; end; end; Procedure Realiz(M:Integer); Var Begin case M of 1: Begin Vvod(N,Spisok); end; 2: Begin Vivod(N,Spisok) end; 3: Begin Work(N,Spisok) end; 4:Exit; end; end; Begin repeat Menu; Operation(M); Realiz(M); povtorka(f); until f=false; end.
Мой модуль:(Показать/Скрыть)
Unit My_ZS; interface Uses winCrt, windos; const max=50; type mas1r_x=array[1..max] of integer;{тип 1мерного массива целочисленного типа} mas1r_i=array[1..max] of string[50];{тип 1мерного массива целочисленного типа} mas2r_i=array[1..max,1..max] of integer;{тип 2мерного массива целочисленного типа} mas2r_r=array[1..max,1..max] of real; {тип 2мерного массива вещественного типа} var i, j: integer;{индексы элеметов, где i-сттрока, j-столбец} procedure vvod_mas2r(max: byte; name: string;var m, k: integer; var a: mas2r_i);{ввод 2мерного масссива} procedure vvod_mas1r(max: byte; name: string; var m: integer; var x: mas1r_x);{ввод 2мерного масссива} procedure vivod_mas2r(m,k: integer; name: string;a: mas2r_i); procedure vivod_1r(n:integer; name:string; x:mas1r_x); procedure In_Real(g:char; var x:real); procedure Out_real(g: char;var a: real); Procedure WaitDos (WaitTime :word); procedure In_integer(g: char; var a: integer); procedure wait; procedure In_real_comment(g: string; var a: real); procedure chetnost ( var a: integer) ; procedure In_integer_comment(g: string; var a: integer); procedure Out_real_comment(g: string; var a: real); procedure Out_integer_comment(g: string; var a: integer); procedure povtor(var f: boolean); procedure povtorka(var f: boolean); элементов массива} implementation procedure vvod_mas2r(max: byte;name: string; var m, k: integer; var a: mas2r_i); label L; var f: boolean; begin repeat writeln('введите количество строк массива ',name,'< ',max); readln(m); writeln('введите количество столбцов массива ',name,'< ',max); readln(k); f:=((m>=0)and(m<max))and((k>=0)and(k<max)); if not f then writeln('Вы ошиблись. Максимальное кол-во строк ',max, ' Максимальное кол-во столбцов ',max); until f; for i:=1 to m do begin for j:=1 to k do begin {$I-} L: write (name,'[', i:2,',',j:2,']='); read(a[i,j]); {$I+} if IOResult<>0 then begin writeln('вы ошиблись, повторите ввод'); goto L; end; end; writeln; end; end; procedure vvod_mas1r(max: byte;name: string; var m: integer; var x: mas1r_x); label L; var f: boolean; begin ClrScr; repeat writeln('введите количество строк массива ',name,'< ',max); readln(m); f:=((m>=0)and(m<max)); if not f then writeln('Вы ошиблись. Максимальное кол-во строк ',max); until f; for i:=1 to m do begin {$I-} L: write (name,'[', i:2,']='); read(x[i]); {$I+} if IOResult<>0 then begin writeln('вы ошиблись, повторите ввод'); goto L; end; end; writeln; end; procedure vivod_mas2r(m,k: integer; name: string;a: mas2r_i); begin for i:=1 to m do begin for j:=1 to k do begin write(' ',name,'[',i:2,',',j:2,']=', a[i,j]:3); end; writeln; end; readln; end; procedure vivod_1r(n:integer; name:string; x: mas1r_x); var i:integer; begin for i:=1 to n do write (' ',name,'[',i:2,']=',x[i]:3); writeln; end; {ввод переменной вщественного типа} PROCEDURE In_Real; Label 1; BEGIN 1: Write('Введите значение ',g,'='); {$I-} Readln(x) {$I+}; If Ioresult<>0 then BEGIN Writeln('Неверный ввод! повторите! '); Goto 1 END; end; procedure Out_real(g: char;var a: real); begin write(g,'= ', a:8:6); end; Procedure WaitDos; VAR House, Minute, Second, Sec100, Second_0:word; Begin GetTime(House, Minute, Second, Sec100); if WaitTime+Second >= 60 then Second_0:= WaitTime + Second-60 else Second_0:= Second + WaitTime; repeat GetTime(House, Minute, Second, Sec100); until Second = Second_0; END; {ввод целочисленной переменной} procedure In_integer(g: char; var a: integer); label 1; begin {$I-} 1: write ('введите значение ',g,' '); read (a); {$I+} if IOResult <>0 then begin writeln('Вы ошиблись повторите ввод');goto 1; end else end; procedure wait; begin write('Выход-ENTER'); readln; donewincrt; end; {ввод переменной вещественного типа с комментарием} procedure In_real_comment(g: string; var a: real); label 1; begin {$I-} 1: write (' ',g,' '); readln(a); {$I+} if IOResult <>0 then begin writeln('Вы ошиблись!!! повторите ввод!');goto 1; end else end; {процедура, определяющая перемиенную на четность} procedure chetnost ( var a: integer) ; var D: boolean; begin d:=odd(a); If d=true then writeln (a,' нечетное') else writeln(a,' четное'); writeln; readln; end; procedure In_integer_comment(g: string; var a:integer); label 1; begin {$I-} 1: write (' ',g,' '); readln(a); {$I+} if IOResult <>0 then begin writeln('Вы ошиблись, повторите ввод');goto 1; end else end; procedure Out_real_comment(g: string; var a: real);label 1; begin {$I-} writeln; 1: write(g,'= ', a:8:6); {$I+} if IOResult <>0 then begin writeln('Вы ошиблись, повторите ввод');goto 1; end; end; procedure Out_integer_comment(g: string; var a: integer); begin write(g,'= ', a); end; procedure povtor(var f: boolean); var x: char; begin REPEAT ClrEol; writeln('Хотите перейти к выбору работ? Y или N?'); readln(x); f:=(x='y')or(x='n'); if not f then begin writeln('Вы ошиблись. Повторите ввод'); end; UNTIL f; if (x='y') or (x='Y') then f:=true else begin F:=false; donewincrt; end; end; procedure povtorka(var f: boolean); var x: char; begin REPEAT ClrEol; writeln('Хотите повторить? Y или N?'); readln(x); f:=(x='y')or(x='n'); if not f then begin writeln('Вы ошиблись. Повторите ввод'); end; UNTIL f; if (x='y') or (x='Y') then f:=true else begin F:=false; donewincrt; end; end; end.
Автор: Merlin 19.05.2006 22:41
Ursula вот тебе пример, такая же почти задача как у тебя.
Условие
Создать типизированный файл, запись которого имеет следующую структуру: номер УДК, фамилию и инициалы автора, название книги, год издания, количество экземпляров данной книги в библиотеке. Вывести на экран в алфавитном порядке название книг, количество экземпляров которых больше 3. Создание и обработку файла оформить в виде подпрограмм
uses crt; const n=2; type knigi=record fio,name:string[20]; udk:real; date,kol:integer; end; var f:file of knigi; a:array [1..n] of knigi; s:string; i,vybor:integer; {Создание} procedure new; Begin rewrite(f); for i:=1 to n do begin clrscr; write('Введите номер Удк'); readln(a[i].udk); write('Введите ФИО '); readln(a[i].fio); write('Введите название '); readln(a[i].name); write('Введите год издания '); readln(a[i].date); write('Введите кол-во экземпляров '); readln(a[i].kol); write(f,a[i]); end; close(f); End; {Чтение} procedure open; Begin reset(f); for i:=1 to n do read(f,a[i]); close(f); End; {Вывод на экран} procedure print; var j:integer; buf:knigi; Begin clrscr; for i:=1 to n-1 do for j:=i+1 to n do if a[i].name>a[j].name then begin buf:=a[i]; a[i]:=a[j]; a[j]:=buf; end; writeln(' УДК ФИО Название Дата Кол-во'); for i:=1 to n do if a[i].kol > 3 then writeln(a[i].udk:5:0,' ',a[i].fio:20,' ',a[i].name:20,' ',a[i].date:5,' ',a[i].kol); End; BEGIN clrscr; write('1 - Создать новый, 0 - открыть '); readln(vybor); write('Введите полный путь к файлу '); readln(s); assign(f,s); if vybor=1 then new; if vybor=0 then open; print; readln; END.