Проверка правильности расстановок скобок

program Project1;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils, Windows;
 
const
  //Глубина стека. Т. е. максимальное количество элементов,
  //которое может поместиться в стек.
  N = 100;
  //Множество открывающих скобок.
  D1 = ['(', '[', '{'];
  //Множество закрывающих скобок.
  D2 = [')', ']', '}'];
 
type
  //Тип, описывающий стек.
  TStack = record
    //Указатель вершины стека. Это индекс последнего добавленного элемента.
    Pnt : Integer;
    //Контейнер данных стека.
    Data : array[1..N] of Char;
  end;
 
//Добавить в стек элемент.
function StackPush(var aStack : TStack; const aCh : Char) : Boolean;
begin
  StackPush := False;
  with aStack do begin
    if Pnt < High(Data) then begin
      //Индекс добавляемого элемента.
      Inc(Pnt);
      //Добавляем элемент в массив (т. е. в стек).
      Data[Pnt] := aCh;
      StackPush := True;
    end;
  end;
end;
 
//Взять из стека элемент.
function StackPop(var aStack : TStack; var aCh : Char) : Boolean;
begin
  StackPop := False;
  with aStack do begin
    if Pnt >= Low(Data) then begin
      aCh := Data[Pnt];
      Dec(Pnt);
      StackPop := True;
    end;
  end;
end;
 
//Для закрывающей скобки возвращает соответствующую открывающую скобку.
function GetOpen(const aCh : Char) : Char;
begin
  GetOpen := #0;
  case aCh of
    ')' : GetOpen := '(';
    ']' : GetOpen := '[';
    '}' : GetOpen := '{';
  else
    //Ошибка.
    Writeln('function GetOpen. Ошибка! Незарегистрированное значение.');
  end;
end;
 
//Исследование строки на предмет согласованности скобок.
function ParsePh(const aStr : String) : Integer;
var
  Stack : TStack;
  i, Res : Integer;
  Ch : Char;
begin
  //Инициализируем стек.
  Stack.Pnt := 0;
 
  Res := 1;
  for i := 1 to Length(aStr) do begin
    if aStr[i] in D1 then begin
      //Нашли открывающую скобку - добавляем её в стек.
      if not StackPush(Stack, aStr[i]) then begin
        Res := -1;
        Break;
      end;
    end else if aStr[i] in D2 then begin;
      //Нашли закрывающу скобку - берём элемент из вершины стека.
      if StackPop(Stack, Ch) then begin
        //Стек не пуст.
        if Ch <> GetOpen(aStr[i]) then begin
          //Взятая из вершины стека скобка не соответствует текущей закрывающей скобке.
          //Согласованность нарушена.
          Res := 0;
          Break;
        end;
      end else begin
        //Стек пуст. Значит нет соответствия для текущей закрывающей скобки.
        //Согласованность нарушена.
        Res := 0;
        Break;
      end;
    end;
  end;
 
  if Res = 1 then begin
    //Если стек не пуст - скобки не согласованы. Иначе - согласованы.
    if StackPop(Stack, Ch) then
      ParsePh := 0
    else
      ParsePh := 1
    ;
  end else
    ParsePh := Res
  ;
end;
 
var
  S : String;
begin
  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);
  
  repeat
    Writeln('Введите строку:');
    Readln(S);
    case ParsePh(S) of
      -1 : Writeln('Ошибка! Переполнение стека.');
      0  : Writeln('Скобки не согласованы.');
      1  : Writeln('Скобки согласованы.');
    end;
    Writeln('Повторить - Enter, выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
const
  //Глубина стека. Т. е. максимальное количество элементов,
  //которое может поместиться в стек.
  N = 100;
  //Множество открывающих скобок.
  D1 = ['(', '[', '{'];
  //Множество закрывающих скобок.
  D2 = [')', ']', '}'];
 
type
  //Тип, описывающий стек.
  TStack = record
    //Указатель вершины стека. Это индекс последнего добавленного элемента.
    Pnt : Integer;
    //Контейнер данных стека.
    Data : array[1..N] of Char;
  end;
 
//Добавить в стек элемент.
function StackPush(var aStack : TStack; const aCh : Char) : Boolean;
begin
  StackPush := False;
  with aStack do begin
    if Pnt < High(Data) then begin
      //Индекс добавляемого элемента.
      Inc(Pnt);
      //Добавляем элемент в массив (т. е. в стек).
      Data[Pnt] := aCh;
      StackPush := True;
    end;
  end;
end;
 
//Взять из стека элемент.
function StackPop(var aStack : TStack; var aCh : Char) : Boolean;
begin
  StackPop := False;
  with aStack do begin
    if Pnt >= Low(Data) then begin
      aCh := Data[Pnt];
      Dec(Pnt);
      StackPop := True;
    end;
  end;
end;
 
//Для закрывающей скобки возвращает соответствующую открывающую скобку.
function GetOpen(const aCh : Char) : Char;
begin
  GetOpen := #0;
  case aCh of
    ')' : GetOpen := '(';
    ']' : GetOpen := '[';
    '}' : GetOpen := '{';
  else
    //Ошибка.
    Writeln('function GetOpen. Ошибка! Незарегистрированное значение.');
  end;
end;
 
//Исследование строки на предмет согласованности скобок.
function ParsePh(const aStr : String) : Integer;
var
  Stack : TStack;
  i, Res : Integer;
  Ch : Char;
begin
  //Инициализируем стек.
  Stack.Pnt := 0;
 
  Res := 1;
  for i := 1 to Length(aStr) do begin
    if aStr[i] in D1 then begin
      //Нашли открывающую скобку - добавляем её в стек.
      if not StackPush(Stack, aStr[i]) then begin
        Res := -1;
        Break;
      end;
    end else if aStr[i] in D2 then begin;
      //Нашли закрывающу скобку - берём элемент из вершины стека.
      if StackPop(Stack, Ch) then begin
        //Стек не пуст.
        if Ch <> GetOpen(aStr[i]) then begin
          //Взятая из вершины стека скобка не соответствует текущей закрывающей скобке.
          //Согласованность нарушена.
          Res := 0;
          Break;
        end;
      end else begin
        //Стек пуст. Значит нет соответствия для текущей закрывающей скобки.
        //Согласованность нарушена.
        Res := 0;
        Break;
      end;
    end;
  end;
 
  if Res = 1 then begin
    //Если стек не пуст - скобки не согласованы. Иначе - согласованы.
    if StackPop(Stack, Ch) then
      ParsePh := 0
    else
      ParsePh := 1
    ;
  end else
    ParsePh := Res
  ;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  S : String;
begin
  S := Memo1.Text; //Или: S := Edit1.Text;
  
  case ParsePh(S) of
    -1 : ShowMessage('Ошибка! Переполнение стека.');
    0  : ShowMessage('Скобки не согласованы.');
    1  : ShowMessage('Скобки согласованы.');
  end;
end;
 
end.