括号匹配（delphi）－转

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;