Правила форума
Прочтите прежде чем задавать вопрос!
В бюро занятости ведется список вакантных мест на предприятиях города. Каждая запись имеет поля:
Наименование организацииб расстояние в км от центра городаб должность, требуемая квалификация(разряд),
стаж работы по специальности, зарплата, наличие страхованияКлиент бюро вводит информацию о своей квалификации и требованиях, распечатать для каждого клиента список, УПОРЯДОЧИТЬ ДОЛЖНОСТИ ПО АЛФАВИТУ
Сама программа: (Показать/Скрыть)
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.
