Проверить, правильно ли в заданном тексте расставлены круглые скобки

uses crt;
var st:string;
k,i:integer;f:boolean;
 
begin
 clrscr;
 write('ВВод ');
 readln(st);
 k:=0;
 f:=true;
 for i:=1 to length(st) do
 begin
 if k<0 then
 begin
  f:=false;
  break;
 end 
else
 case st[i] of
 '(': inc(k);
 ')': dec(k);
 end;
 end;
 if f and k=0 then writeln('Скобки расставлены верно') 
else writeln('Скобки расставлены неверно');
 readln;
end.

var
  s: string;
  i,count: integer;
begin
  ReadLn(s);
  count := 0;
  for i := 1 to Length(s) do
  begin
    if (s[i] = '(') and (count >= 0) then
      Inc(count);
    if s[i] = ')' then
      Dec(count);
  end;
  if count = 0 then
    WriteLn('Yes')
  else
    WriteLn('No');
  ReadLn
end.

program Project1;
 
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
  repeat
    Writeln('Введите строку:');
    Readln(S);
    case ParsePh(S) of
      -1 : Writeln('Ошибка! Переполнение стека.');
      0  : Writeln('Скобки не согласованы.');
      1  : Writeln('Скобки согласованы.');
    end;
    Writeln('Повторить - Enter, выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.