Форум «Всё о Паскале»

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

Полная версия: Записи

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

Ursula

19.05.2006 22:08

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

Сама программа: (Показать/Скрыть)

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.

Bokul

19.05.2006 23:06

Цитата

УПОРЯДОЧИТЬ ДОЛЖНОСТИ ПО АЛФАВИТУ

Сортировка массив записей по алфавитному порядку

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