type TCharStack = class(TStack) private function GetTop: Char; public function Pop: Char; function Push(Item: Char): Char; property Top: Char read GetTop; end; const FindSet = ['(',')']; implementation {$R *.dfm} { TCharStack } function TCharStack.GetTop: Char; begin Result := Char(Peek); end; function TCharStack.Pop: Char; begin Result := Char(inherited Pop); end; function TCharStack.Push(Item: Char): Char; begin Result := Char(inherited Push(Pointer(Item))); end; function FindFirstOf(const Str: String; const CharSet: TSysCharSet; StartPos: Integer = 1): Integer; begin Result := StartPos; while (Result <= Length(Str)) and not (Str[Result] in CharSet) do Inc(Result); if Result > Length(Str) then Result := 0; end; function Check(Line: string): Boolean; var Stack: TCharStack; Pos: Integer; begin Result := False; Stack := TCharStack.Create; try Pos := FindFirstOf(Line, FindSet); while(Pos <> 0) do begin case Line[Pos] of '(': Stack.Push(Line[Pos]); ')': if (Stack.Count = 0) or (Stack.top <> '(') then begin ShowMessage('右括号匹配不成功: ' + Copy(Line, 1, Pos)); Exit; //Halt; end else Stack.Pop(); end; Pos := FindFirstOf(Line, FindSet, Pos +1); end; if Stack.Count > 0 then ShowMessage('左括号匹配不成功!') else Result := True finally Stack.Free; end; end;