Словарь с графической оболочкой — Pascal(Паскаль)

uses crt, graph;

const
  N = 10000;
  h = 5;

type
  slovo = record
    rus: string;
    perevod: string;
  end;

  Data = array [1 .. N] of ^slovo;

var
  a: Data;
  f: text;
  gd, gm: integer;
  DataCount, poz: integer;
  FileName, DCount, naity: string;
  simv, vybor: char;
  MaxRus: integer;
  poisk, y, y2: integer;

function rus(mes: string): string;
var
  i: integer;
BEGIN
  for i := 1 to Length(mes) do
    case mes[i] of
      'а' .. 'п':
        mes[i] := Chr(Ord(mes[i]) - 64);
      'р' .. 'я':
        mes[i] := Chr(Ord(mes[i]) - 16);
    end;
  rus := mes;
END;

function Prepare(path: string): boolean;
begin
  Prepare := true;
  assign(f, path);
{$I-}
  reset(f);
{$I+}
  if IOResult <> 0 then
  begin
    rewrite(f);
    Prepare := false;
  end;
  close(f);
end;

function Fill(var max_length: integer): integer;
var
  tmp, max_str: string;
  k: integer;
begin
  k := 0;
  reset(f);
  while not eof(f) do
  begin
    readln(f, tmp);
    if Length(tmp) > 0 then
    begin
      inc(k);
      new(a[k]);
      a[k]^.rus := copy(tmp, 1, pos(' ', tmp) - 1);
      if k > 1 then
      begin
        if Length(max_str) < Length((a[k]^.rus)) then
        begin
          max_str := a[k]^.rus;
          max_length := Length(a[k]^.rus);
        end;
      end
      else
      begin
        max_str := a[1]^.rus;
        max_length := Length(a[1]^.rus);
      end;
      a[k]^.perevod := copy(tmp, pos(' ', tmp) + 1,
        Length(tmp) - pos(' ', tmp));
    end;
  end;
  close(f);
  Fill := k;
end;

procedure Clear;
var
  k: integer;
begin
  for k := 1 to DataCount do
    Dispose(a[k]);
end;

procedure LexSort(count: integer; var item: Data);
{ leksikograficheskoe uporiadochivanie }
  procedure QuickSort(l, r: integer; var it: Data);
  var
    i, j: integer;
    x: string;
    y: slovo;
  begin
    i := l;
    j := r;
    x := it[(l + r) div 2]^.rus;
    repeat
      while it[i]^.rus < x do
        inc(i);
      while x < it[j]^.rus do
        dec(j);
      if i <= j then
      begin
        y := it[i]^;
        it[i]^ := it[j]^;
        it[j]^ := y;
        inc(i);
        dec(j);
      end;
    until i > j;
    if l < j then
      QuickSort(l, j, it);
    if l < r then
      QuickSort(i, r, it);
  end;

begin
  QuickSort(1, count, item);
end;

function BynarSearch(Search: string): integer;
{ dvoichnyi poisk }
var
  left, right, middle: integer;
  first, last: integer;
begin
  left := 1;
  right := DataCount;
  repeat
    middle := left + (right - left) div 2;
    if a[middle]^.rus > Search then
      right := middle
    else
      left := middle;
  until right - left <= 1;
  if Search = a[left]^.rus then
    BynarSearch := left
  else if Search = a[right]^.rus then
    BynarSearch := right
  else
    BynarSearch := 0;
end;

procedure PaintWindow;
begin
  SetFillStyle(1, White);
  Bar(8, 28, 622, 452);
  SetColor(LightBlue);
  Rectangle(8, 28, 622, 452);
  Line(311, 28, 311, 452);
end;

procedure TheEnd;
begin
  Clear;
  Halt;
end;

procedure Wait(x_, y_: integer);
begin
  repeat
    Delay(30000);
    SetFillStyle(1, LightRed);
    Bar(x_, y_, x_ + 5, y_ + 2);
    Delay(30000);
    SetFillStyle(1, White);
    Bar(x_, y_, x_ + 5, y_ + 2);
  until keypressed;
end;

function InTextXY(x_, y_: integer; kol_simv: byte; msg: string): string;
var
  tmp: string;
  ch: char;
  fl: boolean;
begin
  tmp := '';
  InTextXY := 'Slovar.txt';
  fl := false;
  Wait(x_, y_ + TextHeight(' ') - 4);
  repeat
    ch := readkey;
    if fl = true then
    begin
      Bar(x_, y_, x_ + TextWidth(msg) + TextWidth(' '), y_ + TextHeight(msg));
      fl := false;
    end;
    if ch = #27 then
      TheEnd;
    if ch <> #13 then
      if (ch <> #8) and (Length(tmp) <= kol_simv) then
        tmp := tmp + ch
      else if Length(tmp) > 0 then
        delete(tmp, Length(tmp), 1);
    if Length(tmp) <= kol_simv then
    begin
      Bar(x_, y_, x_ + TextWidth(tmp) + TextWidth(' '), y_ + TextHeight(tmp));
      OutTextXY(x_, y_, tmp);
    end;
    if (ch = #13) and ((Length(tmp) = 0) or (tmp = ' ')) then
    begin
      Bar(x_, y_, x_ + TextWidth(tmp) + TextWidth(' '), y_ + TextHeight(tmp));
      SetColor(LightRed);
      OutTextXY(x_, y_, msg);
      SetColor(LightBlue);
      fl := true;
    end;
  until (ch = #13) and (Length(tmp) > 0) and (tmp <> ' ');
  InTextXY := tmp;
end;

procedure Add(x_, y_: integer; kol_simv: byte; msg: string);
var
  tmp: string;
begin
  x_ := x_ + TextWidth(' ');
  Bar(x_, y_, x_ + TextWidth(' ') * kol_simv, y_ + TextHeight(' '));
  tmp := InTextXY(x_ + 8, y_, kol_simv, msg);
  inc(DataCount);
  new(a[DataCount]);
  a[DataCount]^.rus := naity;
  a[DataCount]^.perevod := tmp;
  append(f);
  writeln(f, a[DataCount]^.rus, ' ', a[DataCount]^.perevod);
  close(f);
  if Length(naity) > MaxRus then
    MaxRus := Length(naity);
  Bar(312, y_, x_ + TextWidth(' ') * kol_simv, y_ + TextHeight(' '));
  SetColor(Blue);
  OutTextXY(316, y_, ': ' + tmp);
end;

function ChooseSlovar: string;
var
  tmp: string;
begin
  SetFillStyle(1, Yellow);
  Bar(150, 146, 472, 160);
  Rectangle(150, 146, 472, 160);
  SetColor(LightBlue);
  OutTextXY(254, 150, 'VYBOR SLOVARIA');
  SetFillStyle(1, White);
  Bar(150, 160, 472, 190);
  Rectangle(150, 160, 472, 190);
  FileName := InTextXY(172, 170, 35, 'Vvedite imia faila-slovaria!');
  OutTextXY(171, 10, '|  File://' + FileName);
end;

begin
  DataCount := 0;
  gd := detect;
  initgraph(gd, gm, '');
  if graphresult <> grok then
  begin
    writeln('Oshibka pri zapuske graficheskogo rezhima!');
    readln;
    Halt;
  end
  else
  begin
    SetBkColor(LightCyan);
    HighVideo;
    ClearDevice;
    SetFillStyle(1, Yellow);
    Bar(8, 5, 622, 21);
    SetColor(LightBlue);
    OutTextXY(14, 10, 'PROGRAMMA "SLOV@R"');
    Rectangle(8, 5, 622, 21);
    SetColor(Blue);
    OutTextXY(280, 460, 'ESC-EXIT');
    SetColor(LightBlue);
    ChooseSlovar;
    PaintWindow;

    repeat
      poisk := 0;
      repeat
        if Prepare(FileName) then
        begin
          DataCount := Fill(MaxRus);
          LexSort(DataCount, a);
        end;

        SetFillStyle(1, Yellow);
        Bar(510, 9, 620, 17);
        SetColor(LightBlue);
        if DataCount > 0 then
        begin
          Str(DataCount, DCount);
          OutTextXY(510, 10, DCount + ' slov');
        end
        else
          OutTextXY(510, 10, 'slovar pust');

        y := h * 2 * poisk;
        OutTextXY(12, 36 + y, '> ');

        naity := InTextXY(28, 36 + y, 35, 'Vvedite slovo!');

        if Length(naity) <= MaxRus then
        begin
          poz := 0;
          if DataCount > 0 then
            poz := BynarSearch(naity);
          if poz > 0 then
          begin
            SetColor(Blue);
            OutTextXY(316, 36 + y, ': ' + a[poz]^.perevod);
          end
          else
          begin
            SetColor(Red);
            OutTextXY(316, 36 + y, ': Net v slovare. Dobavit? [y/n]');
            Wait(572, 40 + y);
            vybor := upcase(readkey);
            if vybor = 'Y' then
              Add(316, 36 + y, 35, 'Vvedite perevod slova!')
            else
            begin
              Bar(316, 36 + y, 316 + TextWidth(' ') * 35,
                36 + y + TextHeight(' '));
              OutTextXY(316, 36 + y, ': Net v slovare.');
            end;
          end;
        end
        else
        begin
          SetColor(Red);
          OutTextXY(316, 36 + y, ': Net v slovare. Dobavit? [y/n]');
          Wait(572, 40 + y);
          vybor := upcase(readkey);
          if vybor = 'Y' then
            Add(316, 36 + y, 35, 'Vvedite perevod slova')
          else
          begin
            Bar(316, 36 + y, 316 + TextWidth(' ') * 35,
              36 + y + TextHeight(' '));
            OutTextXY(316, 36 + y, ': Net v slovare.');
          end;
        end;
        inc(poisk);
        if poisk = 41 then
          readkey;
      until poisk = 41;
      poisk := 0;
      PaintWindow;
    until h = 11;
  end;
  TheEnd;

end.