Developing.ru

Код: Выделить всё

program Project3;
{$APPTYPE CONSOLE}
uses
  SysUtils,Windows;
CONST
  sNorma : string = 'Введите норму: ';
  sAddStr : string = '1 - добавить запись  0 - конец добавления';
  Shapka : array [1..3] of string =
      ('-----------------------------------------------------------------------------',
       '|   НОМЕР РЕЙСА    | ФАМИЛИЯ ПАССАЖИРА|    ВЕС БАГАЖА    | ПУНКТ НАЗНАЧЕНИЯ |',
       '-----------------------------------------------------------------------------');

  Menu : array [1..3] of string =
      ('1 - вывод по норме'+#9+'2 - сортировать по алфавиту',
       '3 - сортировать по весу'+#9+'4 - сортировать по пункту назначения',
       '0 - выход');

  InputStr : array [1..4] of string =
      ('Введите номер рейса',
       'Введите фамилию пассажира',
       'Введите вес багажа',
       'Введитепункт назначения');

TYPE
  TZapis = array [1..4] of string[18];
  TMyTabl = array [1..100] of TZapis;
VAR
  MyTabl  : TMyTabl;
  i,Item  : byte;
  LenTabl : byte;
  Norma   : integer;
  OutFile : text;

procedure ViewShapka(var f : text);
var
  i : byte;
begin
  for i:=1 to 3 do writeln(f,Shapka[i])
end;

procedure ViewMenu;
var
  i : byte;
begin
  for i:=1 to 3 do writeln(Menu[i])
end;

procedure AddItem;
var
  i,j : byte;
  Zapis : TZapis;
begin
  inc(LenTabl);
  for i:=1 to 4 do
    begin
      writeln(InputStr[i]);
      readln(Zapis[i]);
      while length(Zapis[i])<18 do Zapis[i]:=' '+Zapis[i]
    end;
  for i:=1 to LenTabl do
    if MyTabl[i][3]<Zapis[3] then
      begin
        for j:=LenTabl downto i+1 do MyTabl[j]:=MyTabl[j-1];
        break;
      end;
  MyTabl[i]:=Zapis
end;

procedure ViewItem(var f: text; n : byte);
var
  i : byte;
begin
  for i := 1 to 4 do write(f,'|',MyTabl[n][i]);
  writeln(f,'|');
  writeln(f,Shapka[1])
end;

procedure Sort(Key : byte);
var
  i,j : byte;
  y   : TZapis;
begin
  for i := 2 to LenTabl do
  for j := LenTabl downto i do
  if MyTabl[j-1][Key] > MyTabl[j][Key] then
    begin
      y:=MyTabl[j-1];
      MyTabl[j-1]:=MyTabl[j];
      MyTabl[j]:=y
    end
end;

procedure ViewTabl(var f : text; n : integer);
var
  i     : byte;
  count : byte;
begin
  count:=0;
  ViewShapka(f);
  for i:=1 to LenTabl do
    if (n=-1) or (n < StrToInt(MyTabl[i][3])) then
      begin
        ViewItem(f,i);
        inc(count);
        if count=78 then
          begin
            writeln('Press `Enter` to continue');
            count:=0;
            readln
          end;
      end
    else if n=-1 then break;
end;

BEGIN
  assign(OutFile,'d:\result.txt');
{$I+}
  rewrite(OutFile);
{$I-}
  if IOResult<>0 then
    begin
      writeln('Error create file');
      halt
    end;

  LenTabl:=0;
  Norma:=-1;
  for i:=1 to 3 do CharToOemBuff(@Shapka[i][1],@Shapka[i][1],Length(Shapka[i]));
  for i:=1 to 3 do CharToOemBuff(@Menu[i][1],@Menu[i][1],Length(Menu[i]));
  for i:=1 to 4 do CharToOemBuff(@InputStr[i][1],@InputStr[i][1],Length(InputStr[i]));
  CharToOemBuff(@sAddStr[1],@sAddStr[1],Length(sAddStr));
  CharToOemBuff(@sNorma[1],@sNorma[1],Length(sNorma));

  ViewShapka(output);
  repeat
    AddItem;
    ViewTabl(output,Norma);
    writeln(sAddStr);
    readln(Item);
  until Item<>1;

  ViewTabl(OutFile,Norma);
  close(OutFile);
  
  repeat
    ViewTabl(output,Norma);
    ViewMenu;
    readln(Item);
    if Item=1 then
       begin
         writeln(sNorma);
         readln(Norma);
         Sort(3);
       end
    else
      begin
        Sort(Item);
        Norma:=-1
      end
  until Item=0
END.

Код: Выделить всё

uses SysUtils,
       Windows;