Question

我是Delphi的新手，我想从delphi中的case语句中计算案例数。例如，在这段代码中有3个case语句和一个默认case语句，所以这里的总案例是4.我如何计算这个？

colour := Green;
Case colour of
   Red : ShowMessage('The colour is Red');
 Green : ShowMessage('The colour is Green');
  Blue : ShowMessage('The colour is Blue');
else ShowMessage('The colour is Unknown!');
end;

Answer 1

正如其他人所提到的，您可以使用解析器执行此操作。从头开始编写Object Pascal解析器是一项重大任务，但有许多现有的可用。

这个答案中使用的那个是Jacob Thurman的Delphi Castalia工具解析器 - 见https://github.com/jacobthurman/Castalia-Delphi-Parser

这里有一篇关于它的解释性文章

https://jonlennartaasenden.wordpress.com/2014/09/13/castalia-parser-how-to-use/

TmwSimplePasPar解析器基本上“消耗”要查找的输入流用Object Pascal编写的“句子”。它正在这样做，它打电话一系列的识别方法，它遇到的每个ObjectPascal片段一个在输入流中。使用它的方法是派生这个类的后代并覆盖与手头任务相关的特定识别方法。

使TmwSimplePasPar特别适合您的任务的原因是包含 Case语句，它们的标签和选择器特有的方法。就像你一样请参阅下面的代码覆盖这些方法以收集有关Case的信息输入流中遇到的语句。唯一有必要的地方与被覆盖的TmwSimplePasPar方法相比，更改代码是 CaseStatement一，我在块中处理了一个语句识别else块（如果存在）。

我打电话给我的Parser类TNaiveCaseParser有两个原因，保持原样尽可能简单：

它只会正确处理遇到的第一个Case语句。
它忽略了嵌套Case语句的可能性。为了处理这些，你需要某种堆栈来跟踪“当前”Case语句。

代码：

uses
  [...]CastaliaPasLexTypes, CastaliaSimplePasPar;

type

  TCaseStatement = class
  private
    FSelectors: integer;
    FHasElse: Boolean;
    FLabels: Integer;
    FFound: Boolean;
  public
    property Found : Boolean read FFound write FFound;
    property Labels : Integer read FLabels write FLabels;
    property Selectors : integer read FSelectors write FSelectors;
    property HasElse : Boolean read FHasElse write FHasElse;
  end;

  TNaiveCaseParser = class(TmwSimplePasPar)
  public
    C : TCaseStatement;
    constructor Create;
    destructor Destroy;
    procedure CaseLabel; override;
    procedure CaseSelector; override;
    procedure CaseStatement; override;
  end;

  TForm1 = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    btnParse: TButton;
    procedure btnParseClick(Sender: TObject);
  public
    procedure OnMessage(Sender: TObject; const Typ: TMessageEventType;
      const Msg: string; X, Y: Integer);
    procedure Parse;
  end;

[...}

{ TNaiveCaseParser }

procedure TNaiveCaseParser.CaseLabel;
begin
  inherited;
  C.Labels := C.Labels + 1;
end;

procedure TNaiveCaseParser.CaseSelector;
begin
  inherited;
  C.Selectors := C.Selectors + 1;
end;

procedure TNaiveCaseParser.CaseStatement;
begin
  Expected(ptCase);
  Expression;
  Expected(ptOf);
  CaseSelector;
  while TokenID = ptSemiColon do
  begin
    SEMICOLON;
    case TokenID of
      ptElse, ptEnd: ;
    else
      CaseSelector;
    end;
  end;
  if TokenID = ptElse then
  begin
    NextToken;
    StatementList;
    SEMICOLON;
    //  Added
    C.HasElse := True;
  end;
  Expected(ptEnd);
  //  Added
  C.Found := True;
end;

constructor TNaiveCaseParser.Create;
begin
  inherited Create;
  C := TCaseStatement.Create;
end;

destructor TNaiveCaseParser.Destroy;
begin
  C.Free;
  inherited;
end;

procedure TForm1.OnMessage(Sender: TObject; const Typ: TMessageEventType;
  const Msg: string; X, Y: Integer);
var
  S : String;
begin
  S := Format('r: %d, c: %d %s', [y, x, Msg]);
  ShowMessage(S);
end;

procedure TForm1.btnParseClick(Sender: TObject);
begin
  Parse;
end;

procedure TForm1.Parse;
var
  P : TNaiveCaseParser;
  S : String;
  MS : TMemoryStream;
begin
  P := TNaiveCaseParser.Create;
  P.OnMessage := OnMessage;
  MS := TMemoryStream.Create;

  S := Memo1.Lines.Text;
  MS.Write(Pointer(S)^, Length(S) * SizeOf(Char));
  MS.Position := 0;

  try
    P.InitDefines;
    P.Run('Test.Pas', MS);
    if P.C.Found then begin
      if P.C.HasElse then
        Memo2.Lines.Add(Format('Labels: %d, Selectors: %d, has Else block', [P.C.Labels, P.C.Selectors]))
      else
        Memo2.Lines.Add(Format('Labels: %d, Selectors: %d', [P.C.Labels, P.C.Selectors]));
    end;
  finally
    P.Free;
    MS.Free;
  end;
end;

我用于测试的源代码（在D7中请注意）是

unit Test;
interface
implementation
procedure TestCase;
var
  colour : (Black, Red, Green, Blue);
begin
  colour := Green;
  Case colour of
    Black,
    Red : ShowMessage('The colour is Red or Black');
    Green : ShowMessage('The colour is Green');
    Blue : ShowMessage('The colour is Blue');
    else
      ShowMessage('The colour is Unknown!');
  end;
end;
end.

输出

标签：4，选择器：3，具有其他块

顺便说一句，在我大约一小时前开始编写这个答案的代码之前，我没有使用过Thurman的解析器，我想这会解释一下解析器的设计和质量。

在Delphi中计算switch语句（Case）中的个案数

1 个答案: