(*  UpcaseStr converts a string to upper case *)

function UpcaseStr(S : Str80) : Str80;
var
  P : Integer;
begin
  for P := 1 to Length(S) do
    S[P] := Upcase(S[P]);
  UpcaseStr := S;
end;

(*  ConstStr returns a string with N characters of value C *)

function ConstStr(C : Char; N : Integer) : Str80;
var
  S : string[80];
begin
  if N < 0 then
    N := 0;
  S[0] := Chr(N);
  FillChar(S[1],N,C);
  ConstStr := S;
end;

(*  Beep sounds the terminal bell or beeper *)

procedure Beep;
begin
  Write(^G);
end;

procedure InputStr(var S     : AnyStr;
                       L,X,Y : Integer;
                       Term  : CharSet;
                   var TC    : Char    );
const
  UnderScore  =  '_';
var
  P : Integer;
  Ch : Char;
begin
  GotoXY(X + 1,Y + 1); Write(S,ConstStr(UnderScore,L - Length(S)));
  P := 0;
  repeat
    GotoXY(X + P + 1,Y + 1); Read(Kbd,Ch); Ch:=Upcase(Ch);
    case Ch of
      #32..#126 : if P < L then
                  begin
                    if Length(S) = L then
                      Delete(S,L,1);
                    P := P + 1;
                    Insert(Ch,S,P);
                    Write(Copy(S,P,L));
                  end
                  else Beep;
      ^S        : if P > 0 then
                    P := P - 1
                  else Beep;
      ^D        : if P < Length(S) then
                    P := P + 1
                  else Beep;
      ^A        : P := 0;
      ^F        : P := Length(S);
      ^G        : if P < Length(S) then
                  begin
                    Delete(S,P + 1,1);
                    Write(Copy(S,P + 1,L),UnderScore);
                  end;
      ^H,#127   : if P > 0 then
                  begin
                    Delete(S,P,1);
                    Write(^H,Copy(S,P,L),UnderScore);
                    P := P - 1;
                  end
                  else Beep;
      ^Y        : begin
                    Write(ConstStr(UnderScore,Length(S) - P));
                    Delete(S,P + 1,L);
                  end;
    else
      if not (Ch in Term) then Beep;
    end;  {of case}
  until Ch in Term;
  P := Length(S);
  GotoXY(X + P + 1,Y + 1);
  Write('' :L - P);
  TC := Ch;
end;


procedure Select(    Prompt : Str80;
                     Term   : CharSet;
                 var TC     : Char    );
var
  Ch : Char;
begin
  GotoXY(1,23); Write(Prompt,'? ' ); ClrEol;
  repeat
    Read(Kbd,Ch);
    TC := Upcase(Ch);
    if not (TC in Term) then
      Beep;
  until TC in Term;
  Write(Ch);
end;

(*  ClearFrame clears the display frame, I.E. Lines 3 to 20 *)

procedure ClearFrame;
var
  I : Integer;
begin
  for I := 3 to 20 do
  begin
    GotoXY(1,I + 1); ClrEol ;
  end;
end;

(*  OutForm displays the entry form on the screen *)

procedure OutForm;
begin
  GotoXY(9, 6); Write('Artikel     :');
  GotoXY(9, 9); Write('Preis       :');
  GotoXY(9,13); Write('Bemerkung 1 :');
  GotoXY(9,15); Write('Bemerkung 2 :');
  GotoXY(9,17); Write('Bemerkung 3 :')
end;

(*  ClearForm clears all fields in the entry form *)

procedure ClearForm;
begin
  GotoXY(22, 6); ClrEol;
  GotoXY(22, 9); ClrEol;
  GotoXY(22,13); ClrEol;
  GotoXY(22,15); ClrEol;
  GotoXY(22,17); ClrEol
end;

procedure InputCust(var Cust : CustRec);
const
  Term : CharSet  =  [^E,^I,^M,^X,^Z];
var
  L : Integer;
  TC : Char;
begin
  L := 1;
  with Cust do
  repeat
    case L of
      1 : InputStr(DeviceName,20,22,5,Term,TC);
      2 : InputStr(Preis,8,22,8,Term,TC);
      3 : InputStr(Remarks1,20,22,12,Term,TC);
      4 : InputStr(Remarks2,20,22,14,Term,TC);
      5 : InputStr(Remarks3,20,22,16,Term,TC);
    end;
    if (TC = ^I) or (TC = ^M) or (TC = ^X) then
      if L = 5 then
        L := 1
      else L := L + 1
    else
      if TC = ^E then
        if L = 1 then
          L := 5
        else L := L - 1;
  until (TC = ^M) and (L = 1) or (TC = ^Z);
end;

(*  OutCust displays the customer data contained in Cust *)

procedure OutCust(var Cust : CustRec);
begin
  with Cust do
  begin
    GotoXY(23, 6); Write(DeviceName); ClrEol;
    GotoXY(23, 9); Write(Preis);      ClrEol;
    GotoXY(23,13); Write(Remarks1);   ClrEol;
    GotoXY(23,15); Write(Remarks2);   ClrEol;
    GotoXY(23,17); Write(Remarks3);   ClrEol
  end
end;

function KeyFromName(Name : Str20) : Str20;
begin
  KeyFromName := UpcaseStr(Name)
end;

(*  Update is used to update the data base *)

procedure Update;
var
  Ch : Char;

(*  Add is used to add devices *)

procedure Add;
var
  DataF : Integer;
  Ccode : string[20];
  KeyN  : string[20];
  Cust  : CustRec;
begin
  with Cust do
  begin
    FillChar(Cust,SizeOf(Cust),0);
    repeat
      InputCust(Cust);
      Ccode := DeviceName;
      FindKey (IFile,DataF,Ccode);
      if OK then
      begin
        GotoXY(6,19);
        Write ('Fehler: Artikel schon vorhanden');
        Beep;
      end
    until not OK;
    AddRec(DatF,DataF,Cust);
    KeyN := KeyFromName(DeviceName);
    AddKey(IFile, DataF,KeyN);
    GotoXY(6,19); ClrEol
  end
end;

(*  Find is used to find, edit and delete customers *)

procedure Find;
var
  D,L,I      : Integer;
  Ch,
  TC         : Char;
  Ccode,
  Pcode,
  DeviceName : string[20];
  KeyN,
  PNm        : string[20];
  Cust       : CustRec;
begin
  if UsedRecs(DatF) > 0 then
  begin
    Ccode := '';
    repeat
      InputStr(Ccode,20,22,5,[^M,^Z],TC);
      if Ccode <> '' then
      begin
        FindKey(IFile,D,Ccode);
        if OK then
        begin
          GetRec(DatF,D,Cust);
          OutCust (Cust);
        end
        else
        begin
          GotoXY(6,19);
          Write('Fehler: Artikel nicht gefunden');Beep;
        end;
      end;
    until OK or (Ccode='');
    GotoXY(6,19);ClrEol;
    if Ccode='' then
    begin
      L := 1;
      DeviceName := '';
      repeat
        case L of
          1 : InputStr(DeviceName,20,22,5,[^I,^M,^Z],TC);
        end;
        if (TC = ^I) or (TC = ^M) then
          L := 1;
      until (TC = ^M) and (L = 1) or (TC = ^Z);
      KeyN := KeyFromName(DeviceName);
      SearchKey(IFile, D,KeyN);
      if not OK then
        PrevKey(IFile,D,KeyN);
      repeat
        GetRec(DatF,D,Cust);
        OutCust(Cust);
        Select('Find : N)ext, P)revious, Q)uit',['N','P','Q'],Ch);
        case Ch of
          'N' : repeat NextKey(IFile, D,KeyN) until OK;
          'P' : repeat PrevKey(IFile, D,KeyN) until OK;
        end;
      until Ch = 'Q';
    end;
    Select('Find : E)dit, D)elete, Q)uit',['E','D','Q'],Ch);
    with Cust do
    case Ch of
      'E' : begin
              Pcode := DeviceName;
              PNm:=KeyFromName(DeviceName);
              repeat
                InputCust(Cust);
                GotoXY(6,19);ClrEol;
                if DeviceName=Pcode then
                  OK:=false
                else
                begin
                  Ccode:=DeviceName;
                  FindKey(IFile,I,Ccode);
                  if OK then
                  begin
                    GotoXY(6,19);
                    Write('Fehler: Artikel schon vorhanden');
                    Beep;
                  end;
                end;
              until not OK;
              PutRec(DatF,D,Cust);
              DeleteKey(IFile,D,Pcode);
              AddKey(IFile,D,DeviceName);
              KeyN:=KeyFromName(DeviceName);
            end;
      'D' : begin
              KeyN := KeyFromName(DeviceName);
              DeleteKey(IFile,D,KeyN);
              DeleteRec(DatF,D);
            end;
    end;
end { of UsedRecs(DatF) > 0 .. }
  else Beep;
end;

begin(* Update*)
  OutForm;
  repeat
    Select('Update : A)dd, F)ind, Q)uit',['A','F','Q'],Ch);
    case Ch of
      'A' : Add;
      'F' : Find;
    end;
    if Ch <> 'Q' then
    begin
      GotoXY(60,2); Write(UsedRecs(DatF) :5);
      ClearForm;
    end;
  until Ch = 'Q';
end;

(*  List is used to list customers *)

procedure List;
label Escape;
var
  D,L,LD   : Integer;
  Ch,CO,CS : Char;
  Ccode    : string[20];
  KeyN     : string[20];
  Name     : string[20];
  Cust     : CustRec;
begin
  Select('Output device : P)rinter, S)creen',['P','S'],CO);
  Select('Sort : S)ort, U)nsorted',['S','U'],CS);
  GotoXY(1,23); Write('Press <Esc> to abort'); ClrEol;
  ClearKey(IFile);
  D := 0;
  LD := FileLen(DatF) - 1;
  L := 3;
  repeat
    if KeyPressed then
    begin
      Read(Kbd,Ch);
      if Ch = #27 then
        goto Escape;
    end;
    case CS of
      'S' : NextKey(IFile,D,KeyN);
      'U' : begin
              OK := false;
              while (D < LD) and not OK do
              begin
                D := D + 1;
                GetRec(DatF,D,Cust);
                OK:=Cust.Nummer=0;
              end;
            end;
    end;
    if OK then
      with Cust do
      begin
        if CS <> 'U' then
          GetRec(DatF,D,Cust);
        Name := DeviceName;
        if CO = 'P' then
        begin
          Write(Lst,Name,'' :20 - Length(Name));
          Writeln(Lst,Preis);
        end
        else
        begin
          if L = 21 then
          begin
            GotoXY(1,23);
            Write('Press <RETURN> to continue');
            Write(' or <Esc> to abort');
            ClrEol;
            repeat
              Read(Kbd,Ch)
            until (Ch = ^M) or (Ch = #27);
            if Ch = #27 then
              goto Escape;
            GotoXY(1,23);
            Write('Press <Esc> to abort'); ClrEol;
            ClearFrame;
            L := 3;
          end;
          GotoXY(17,L + 1); Write(Name);
          GotoXY(53,L + 1); Write(Preis);
          L := L + 1;
        end; { of with Cust do .. }
    end; { of if OK .. }
  until not OK;
  if CO = 'S' then
  begin
    GotoXY(1,23); Write('Press <RETURN>'); ClrEol;
    repeat 
      Read(Kbd,Ch)
    until Ch = ^M;
  end;
  Escape :
end;
 
