СУБД - Turbo Pascal

program DBMS;
{Database Management Systems}
{Mustafin Ruslan EPI-1-14}
{date: }
uses DOS, Graph, CRT;
 
type
  Properties = record
    Model: string[12];
    Role: char;
    Country: string[6];
    Crew: integer;
    Length: extended;
    Wingspan: extended;
    MaxSpeed: integer;
    Used: boolean;
  end;
 
var
  plane: array[1..13] of Properties;
  x, y, x1, y1, k, i, Position: integer;
  size: word;
  Background: pointer;
  s, path: string[100];
  ch: char;
  Sort1: boolean;
  Pos1: 0..2;
 
procedure Graphint;{Procedure starts graphmode}
var
  grdriver, grmode, errcode: integer;
begin
  GrDriver := 0;
  InitGraph(GrDriver, GrMode, '');
  ErrCode := GraphResult;
  if ErrCode <> GrOK then                               {if an error has happen, it will show a message}
  begin
    WriteLn('Graphics error:', GraphErrorMsg(ErrCode));
    ReadLn;
    HaLT;
  end;
end;
 
procedure Button(x, y, x1, y1: integer; s: string);{draws picture for buttons with entered text}
begin
  SetColor(9);
  Rectangle(x, y, x1, y1);
  SetColor(6);
  Rectangle(x + 2, y + 2, x1 - 2, y1 - 2);
  OutTextxy(x + 10, y + 11, s);
end;
 
procedure Interface1;{draws interface with buttons, table and names for columns}
begin
  SetColor(2);
  Rectangle(2, 2, 637, 477);  {DRAWS FRAME}
  SetColor(10);
  Rectangle(4, 4, 635, 475);
  for i := 1 to 7 do              {draws table}
  begin
    line(79 * i, 4, i * 79, 427);
  end;
  for i := 1 to 13 do
    line(4, 33 * i, 635, i * 33);
  OutTextxy(10, 11, 'Model');       {names columns}
  OutTextxy(87, 11, 'Role');
  OutTextxy(164, 11, 'Country');
  OutTextxy(242, 11, 'Crew');
  OutTextxy(321, 11, 'Length');
  OutTextxy(400, 11, 'Wingspan');
  OutTextxy(480, 11, 'Max speed');
  OutTextxy(557, 11, 'is used');
  Button(10, 435, 65, 465, 'READ');      {draws buttons}
  Button(85, 435, 140, 465, 'SORT');
  Button(160, 435, 215, 465, 'WRITE');
  Button(235, 435, 290, 465, 'INFO');
  Button(310, 435, 365, 465, 'END');
end;
 
procedure ReadFile;{procedure for reading typed of text files}
type
  FileOfText = text;
  TypedFile = file of Properties;
var
  F1: FileOfText;
  FT: TypedFile;
  DirInfo: SearchRec;
begin
  {$I-}
  case Pos1 of
 
    0:
      begin
        Assign(F1, Path + '\SUBD\Planes.txt');   {}
        Reset(F1);
      end;
    1:
      begin
        Assign(F1, Path + 'PlanesIsxod.txt');   {}
        Reset(F1);
      end;
    2:  {Depands on boolean variable Sort1. The way is written in S}
      begin
        Assign(FT, Path + '\SUBD\Planes.bak');
        Reset(FT);
      end;
  end;
  {$I+}
  if IOResult <> 0 then {if file isn't found then it will write a message and come back to main to buttons}
  begin
    OutTextxy(375, 450, 'File planes.txt(bak) is not found');
    Delay(100);
    repeat until KeyPressed;
    ClearDevice;
    Interface1;
  end
    else                 {if file has been found then...}
  begin
    ClearDevice;      {clears space for new data on the screen}
    Interface1;
    if Pos1 < 2 then
    begin
             {if sort1 is true then reads text file}
      i := 0;
      while (i < 12) and not EoF(F1) do  {reads until 12 rows were read or there is end of file}
      begin
        i := i + 1;
        Readln(F1, plane[i].Model,
              plane[i].Role, ch, plane[i].Country,
              plane[i].Crew, plane[i].Length,
              plane[i].Wingspan, plane[i].MaxSpeed, k);
        if k = 0 then plane[i].Used := false else plane[i].Used := true;
      end;
      Close(f1);  {closes file and saves number of rows in ''k''}
      k := i;
    end
         else              {reads typed file}
    begin
      Reset(FT);
      i := 0;
      while (i < 12) and not EoF(FT) do    {reads until 12 rows were read or there is end of file}
      begin
        i := i + 1;
        Read(FT, plane[i]);
      end;
      Close(FT); {closes file and saves the number of rows}
      k := i;
    end;
    for I := 1 to k do      {displays data on the screen}
    begin
      SetColor(6);
      OutTextxy(8, 15 + i * 33, plane[i].Model);
      SetColor(4);
      OutTextxy(110, 15 + i * 33, plane[i].Role);
      SetColor(2);
      OutTextxy(170, 15 + i * 33, plane[i].Country);
      Str(plane[i].Crew, S);
      OutTextxy(270, 15 + i * 33, S);
      Str(plane[i].Length:2:2, S);
      OutTextxy(320, 15 + i * 33, S);
      Str(plane[i].Wingspan:3:2, S);
      OutTextxy(400, 15 + i * 33, S);
      Str(plane[i].MaxSpeed, S);
      OutTextxy(480, 15 + i * 33, S);
      if plane[i].Used then
        OutTextxy(560, 15 + i * 33, 'YES')
      else
        OutTextxy(560, 15 + i * 33, 'NO');
    end;
  end;
end;
 
procedure Left;
begin
  if Position > 0 then        {control system for arrows, moves to the left}
  begin
    Position := Position - 1;         {counts current position in this variable}
    SetFillStyle(1, 0);
    Bar(10 + (Position + 1) * 75, 435, 65 + (Position + 1) * 75, 465);
    SetFillStyle(1, 11);                                  {clears place for redrawing buttons}
    Bar(10 + Position * 75, 435, 65 + Position * 75, 465);
    case Position of
      0:
        begin{draws buttons}
          Button(10, 435, 65, 465, 'READ');
          Button(85, 435, 140, 465, 'SORT');
        end;
      1:
        begin
          Button(85, 435, 140, 465, 'SORT');
          Button(160, 435, 215, 465, 'WRITE');
        end;
      2:
        begin
          Button(160, 435, 215, 465, 'WRITE');
          Button(235, 435, 290, 465, 'INFO');
        end;
      3:
        begin
          Button(235, 435, 290, 465, 'INFO');
          Button(310, 435, 365, 465, 'END');
        end;
    end;
  end;
end;
 
procedure Right;
begin
  if Position < 4 then     {control system for arrows, moves to the right}
  begin
    Position := Position + 1;            {clears space for drawing buttons}
    SetFillStyle(1, 0);
    Bar(10 + (Position - 1) * 75, 435, 65 + (Position - 1) * 75, 465);
    SetFillStyle(1, 11);
    Bar(10 + Position * 75, 435, 65 + Position * 75, 465);
    case Position of
      1:
        begin
          Button(10, 435, 65, 465, 'READ');           {draws buttons}
          Button(85, 435, 140, 465, 'SORT');
        end;
      2:
        begin
          Button(85, 435, 140, 465, 'SORT');
          Button(160, 435, 215, 465, 'WRITE');
        end;
      3:
        begin
          Button(160, 435, 215, 465, 'WRITE');
          Button(235, 435, 290, 465, 'INFO');
        end;
      4:
        begin
          Button(235, 435, 290, 465, 'INFO');
          Button(310, 435, 365, 465, 'END');
        end;
    end;
  end;
end;
 
procedure TopAndDownArrows;{procedure for context window of sort, control system for arrows}
var
  Position1: integer;
 
  procedure Sort;{pocedure for sorting records}
  var
    j: integer;
  begin
    for i := 1 to (k - 1) do
      for j := i + 1 to k do      {case of chosen column for sorting, variable is changed in procedure TopAndDownArrows}
        case position1 of
 
          0:
            case Sort1 of                                      {bubble sort. sort1 chooses ascending or descending sort}
              true:
                if (plane[j].model < plane[i].model) then
                begin
                  plane[13] := plane[i];
                  plane[i] := plane[j];
                  plane[j] := plane[13];
                end;
              false:
                if (plane[j].model > plane[i].model) then
                begin
                  plane[13] := plane[i];
                  plane[i] := plane[j];
                  plane[j] := plane[13];
                end;
            end;
 
          1:
            case Sort1 of
              true:
                if (plane[j].Role < plane[i].Role) then
                begin
                  plane[13] := plane[i];
                  plane[i] := plane[j];
                  plane[j] := plane[13];
                end;
              false:
                if (plane[j].Role > plane[i].Role) then
                begin
                  plane[13] := plane[i];
                  plane[i] := plane[j];
                  plane[j] := plane[13];
                end;
            end;
 
          2:
            case Sort1 of
              true:
                if (plane[j].Country < plane[i].Country) then
                begin
                  plane[13] := plane[i];
                  plane[i] := plane[j];
                  plane[j] := plane[13];
                end;
              false:
                if (plane[j].Country > plane[i].Country) then
                begin
                  plane[13] := plane[i];
                  plane[i] := plane[j];
                  plane[j] := plane[13];
                end;
            end;
 
          3:
            case Sort1 of
              true:
                if (plane[j].Crew > plane[i].Crew) then
                begin
                  plane[13] := plane[i];
                  plane[i] := plane[j];
                  plane[j] := plane[13];
                end;
              false:
                if (plane[j].Crew < plane[i].Crew) then
                begin
                  plane[13] := plane[i];
                  plane[i] := plane[j];
                  plane[j] := plane[13];
                end;
            end;
 
          4:
            case Sort1 of
              true:
                if (plane[j].Length > plane[i].Length) then
                begin
                  plane[13] := plane[i];
                  plane[i] := plane[j];
                  plane[j] := plane[13];
                end;
              false:
                if (plane[j].Length < plane[i].Length) then
                begin
                  plane[13] := plane[i];
                  plane[i] := plane[j];
                  plane[j] := plane[13];
                end;
            end;
 
          5:
            case Sort1 of
              true:
                if (plane[j].Wingspan > plane[i].Wingspan) then
                begin
                  plane[13] := plane[i];
                  plane[i] := plane[j];
                  plane[j] := plane[13];
                end;
              false:
                if (plane[j].Wingspan < plane[i].Wingspan) then
                begin
                  plane[13] := plane[i];
                  plane[i] := plane[j];
                  plane[j] := plane[13];
                end;
            end;
 
          6:
            case Sort1 of
              true:
                if (plane[j].MaxSpeed > plane[i].MaxSpeed) then
                begin
                  plane[13] := plane[i];
                  plane[i] := plane[j];
                  plane[j] := plane[13];
                end;
              false:
                if (plane[j].MaxSpeed < plane[i].MaxSpeed) then
                begin
                  plane[13] := plane[i];
                  plane[i] := plane[j];
                  plane[j] := plane[13];
                end;
            end;
 
          7:
            case Sort1 of
              true:
                if (plane[j].Used > plane[i].Used) then
                begin
                  plane[13] := plane[i];
                  plane[i] := plane[j];
                  plane[j] := plane[13];
                end;
              false:
                if (plane[j].Used < plane[i].Used) then
                begin
                  plane[13] := plane[i];
                  plane[i] := plane[j];
                  plane[j] := plane[13];
                end;
            end;
 
        end;
    ClearDevice;   {after sort clear and draw again interface and then display data}
    Interface1;
    for i := 1 to k do
    begin
      SetColor(6);
      OutTextxy(8, 15 + i * 33, plane[i].Model);
      SetColor(4);
      OutTextxy(110, 15 + i * 33, plane[i].Role);
      SetColor(2);
      OutTextxy(170, 15 + i * 33, plane[i].Country);
      Str(plane[i].Crew, S);
      OutTextxy(270, 15 + i * 33, S);
      Str(plane[i].Length:2:2, S);
      OutTextxy(320, 15 + i * 33, S);
      Str(plane[i].Wingspan:3:2, S);
      OutTextxy(400, 15 + i * 33, S);
      Str(plane[i].MaxSpeed, S);
      OutTextxy(480, 15 + i * 33, S);
      if plane[i].Used then
        OutTextxy(560, 15 + i * 33, 'YES')
      else
        OutTextxy(560, 15 + i * 33, 'NO');
    end;
  end;
 
begin
  Position1 := 0;
  repeat
    repeat until KeyPressed;
    ch := ReadKey;
    if ch = #0 then               {control system for top and down arrows}
    begin
      ch := ReadKey;
      case ch of
        #72:
          if Position1 > 0 then
          begin
            Position1 := Position1 - 1;     {top arrow}
            SetFillStyle(1, 8);
            Bar(160, 271 + (Position1 + 1) * 14, 170, 282 + (Position1 + 1) * 14);
            SetColor(6);
            OutTextxy(160, 273 + Position1 * 14, #17);
          end;
        #80:
          if Position1 < 7 then
          begin{down arrow}
            Position1 := Position1 + 1;
            SetFillStyle(1, 8);
            Bar(160, 271 + (Position1 - 1) * 14, 170, 282 + (Position1 - 1) * 14);
            SetColor(6);
            OutTextxy(160, 275 + Position1 * 14, #17);
          end;
      end;
    end;
  until ch = #13;   {enter}
  SetColor(5);
  SetFillStyle(1, 8);  {window for choosing ascending or descending sort}
  Bar(183, 270, 220, 305);
  Rectangle(184, 271, 219, 304);
  SetTextStyle(0, 0, 2);
  SetColor(3);
  OutTextxy(186, 273, #24);
  OutTextxy(186, 290, #25);
  SetTextStyle(0, 0, 1);
  SetColor(12);
  repeat
    repeat until KeyPressed;
    ch := ReadKey;
    if ch = #0 then     {control system for arrows. Chooses type of sort in variable Sort1(ascending or descending)}
    begin
      ch := ReadKey;
      case ch of
        #72:
          begin
            OutTextxy(205, 274, #17);
            Bar(205, 294, 212, 300);
            Sort1 := true;
          end;
        #80:
          begin
            OutTextxy(205, 294, #17);
            Bar(205, 274, 212, 280);
            Sort1 := false;
          end;
      end;
    end;
  until ch = #13;
  delay(100);
  Sort;            {sorts}
  repeat until KeyPressed;
end;
 
procedure ContextWindow;{draws context window}
begin
  SetFillStyle(1, 8);
  Bar(80, 270, 181, 421);
  SetColor(4);
  Rectangle(82, 272, 179, 419);
  SetColor(3);
  OutTextxy(85, 275, 'Model');
  OutTextxy(85, 289, 'Role');
  OutTextxy(85, 303, 'Country');
  OutTextxy(85, 317, 'Crew');
  OutTextxy(85, 331, 'Length');
  OutTextxy(85, 345, 'Wingspan');
  OutTextxy(85, 359, 'Max Speed');
  OutTextxy(85, 373, 'Is Used');
  TopAndDownArrows;      {uses control system of arrows and procedure for sort}
end;
 
procedure INFO;{reference}
begin
  Size := ImageSize(400, 300, 601, 451);    {copies place where the informational window appear}
  GetMem(BackGround, Size);
  GetImage(400, 300, 601, 451, BackGround^);
  Bar(400, 300, 601, 451);                        {draws info window}
  SetColor(4);
  Rectangle(402, 302, 599, 449);
  SetColor(4);
  OutTextxy(404, 305, 'B - Bomber');
  OutTextxy(404, 319, 'S - Strike Aircraft');
  OutTextxy(404, 333, 'M - Maritime Patrol');
  OutTextxy(404, 347, 'F - Fighter');
  OutTextxy(404, 361, 'T - Advanced Trainer');
  repeat until keypressed;
  PutImage(400, 300, BackGround^, 0);      {draws back previous image}
  FreeMem(BackGround, size);
end;
 
procedure SaveTipAndText;{procedure for saving typed and text file}
type
  Typed = file of Properties;
  TextFile = text;
var
  Ftyped: typed;
  FileOfText: TextFile;
begin
  Chdir('SUBD');    {saves into 'subd' directory}
  SetFillStyle(1, 8);
  Size := ImageSize(40, 370, 142, 410);
  GetMem(Background, Size);
  GetImage(40, 370, 142, 410, BackGround^);
  Bar(40, 370, 142, 410);    {draws window}
  SetColor(15);
  Rectangle(41, 371, 140, 409);
  OutTextxy(44, 374, 'planes.txt');
  OutTextxy(44, 389, 'planes.bak');
  Delay(450);
  repeat
    repeat until KeyPressed;
    ch := ReadKey;           {control system. arrows top and down}
    if ch = #0 then
    begin
      ch := ReadKey;
      case ch of
        #72:
          begin{top}
            OutTextxy(125, 375, #17);
            Bar(125, 390, 131, 396);
            Sort1 := true;            {chooses which type of file to open}
          end;
        #80:
          begin{down}
            OutTextxy(125, 390, #17);
            Bar(125, 375, 131, 381);
            Sort1 := false;
          end;
      end;
    end;
  until ch = #13;
  if not sort1 then
  begin
    Assign(Ftyped, 'planes.bak');
    Assign(FileOfText, 'planes.txt');
    Rewrite(Ftyped);        {rewrites typed file}
    for i := 1 to k do
      Write(Ftyped, plane[i]);
    Close(Ftyped);
  end
  else
  begin
    Assign(FileOfText, 'planes.txt');
    Rewrite(FileOfText);     {rewrites text file}
    Append(FileOfText);
    for i := 1 to k do    {writes data into file. Takes into consideration gaps between words and numeric symbols}
    begin
      write(FileOfText, plane[i].model, plane[i].Role, ' ', plane[i].Country);
      Str(plane[i].Crew, s);
      write(FileOfText, s, '  ');
      Str(plane[i].Length:2:3, s);
      write(FileOfText, s, ' ');
      Str(plane[i].Wingspan:3:2, s);
      write(FileOfText, s, ' ');
      Str(plane[i].Maxspeed:5, s);
      write(FileOfText, s, ' ');
      if plane[i].Used then writeln(FileOfText, '1')
      else writeln(FileOfText, '0');
    end;
    Close(FileOfText);
  end;
  SetColor(15);
  OutTextxy(371, 450, 'Complete.');
  repeat until KeyPressed;
  SetFillStyle(1, 0);
  Bar(371, 450, 633, 460);  {>633 viidet za ramku}
  ChDir('..');
  PutImage(40, 370, BackGround^, 0);
  FreeMem(BackGround, size);
end;
 
procedure ReadWindow;{context window for operation 'read' with control system}
begin
  SetFillStyle(1, 8);
  Bar(40, 350, 182, 410);    {draws window}
  SetColor(15);
  Rectangle(41, 351, 180, 409);
  OutTextxy(44, 354, 'SUBD\Planes.txt');
  OutTextxy(44, 374, 'PlanesIsxod.txt');
  OutTextxy(44, 393, 'SUBD\Planes.bak');
  Delay(450);
  Pos1 := 0;
  repeat
    repeat until KeyPressed;
    ch := ReadKey;           {control system. arrows top and down}
    if ch = #0 then
    begin
      ch := ReadKey;
      case ch of
        #72:
          if Pos1 > 0 then
          begin{top}
            Pos1 := Pos1 - 1;
            OutTextxy(172, 354 + Pos1 * 20, #17);
            Bar(172, 354 + (Pos1 + 1) * 20, 178, 360 + (Pos1 + 1) * 20); {chooses which type of file to open}
          end;
        #80:
          if Pos1 < 2 then
          begin{down}
            Pos1 := Pos1 + 1;
            OutTextxy(172, 354 + Pos1 * 20, #17);
            Bar(172, 354 + (Pos1 - 1) * 20, 178, 360 + (Pos1 - 1) * 20);
          end;
      end;
    end;
  until ch = #13;
  ReadFile;
end;
 
var
  P: PathStr;
  D: DirStr;
  N: NameStr;
  E: ExtStr;
 
begin
  clrscr;
  Path := paramstr(0);  {determines the current location of the file dmbs.exe}
  writeln(Path);
  FSplit(Path, D, N, E);
  path:=d; 
  writeln(d);
  Chdir(d);  {moves to directory where the file lies}
  GraphInt;    {start graph mode}
  Interface1;   {draw interface}
  repeat
    repeat until keypressed;
    ch := ReadKey;
    if ch = #0 then      {part of control system for arrows and hotkeys}
    begin{arrow keys}
      ch := ReadKey;
      case ch of
        #75: Left;        {control system for arrows, moves to the left}
        #77: Right;       {moves to the right}
      end;
    end;
    if ch = #13 then  {Enter}   {part of control system for arrows}
      case Position of  {variable changes its value depending on selected button}
        0: ReadWindow;
        1: ContextWindow;  {variable position determines which procedure will be chosen}
        2: SaveTipAndText;
        3: INFO;
        4: Halt;
      end;
  until false;
end.