こんにちは。
　いつも FDELPHI に助けてもらっている見習いﾌﾟﾛｸﾞﾗﾏ（４６歳）です。
　ご恩返しにと思い、昨年２Ｗででっちあげた計算ルーチンをアップします。

　高速化・高機能化・高精度化などいくつも課題がありますが、みなさんの
参考になれば幸いです。

-----------------------------------------------------------------------------
unit Calcp;

// 式の解釈と演算を行う逆ポーランド式計算ルーチン
// 式及び答えは文字列とする
// 注意：有効桁は１６進４桁に限定しているがもちろん変更可

// 使い方の例
{
var Ans, Exp: String;
begin
  WorkList   := TStringList.Create;
  TokenList  := TStringList.Create;
  SymbolList := TStringList.Create;

  SymbolList.Add('x:0001'); // xは 1（16進数表記）
  SymbolList.Add('y:000F'); // yは15（16進数表記）

  Exp := '(x+y)*(x-y)+$10'; // 式
  Ans := IntToStr(HexToInt(Calc(Exp))); // 答えを10進文字列に変換
  ShowMessage(Ans);

  WorkList.Free;
  TokenList.Free;
  SymbolList.Free;
end;
}

// 数値    ：10進数、先頭が＄なら16進数
//           演算の答えは16進数の文字列である
// シンボル：シンボルリストに定義すれば使用可能
// 演算子  ：算術 ＋、−、＊、／、MOD
//           論理 AND、OR、XOR
//           ｼﾌﾄ  SHR、SHL
//           単項 ＋、−、NOT、
//                HIGH、LOW（それぞれ2ﾊﾞｲﾄの上位下位ﾊﾞｲﾄ）
//           他   （、）
// 優先順位は考慮していないので、括弧を活用して明示すること

// Factor・Term・Expression ルーチンは
// 中田育男著オーム社「コンパイラ」の同名ルーチン（C言語）を
// 参考にしました

// Push・Pop・Calculation ルーチンは
// SBORLAND ﾗｲﾌﾞﾗﾘ2-59 EasyCalc（Oh!NO!さん）を参考にしました

interface

uses Classes, Dialogs, SysUtils;

const
  InValidValue = 99999;
  calcFault    = '演算不能';
  UnDefined    = '未定義';

function  Calc(s: String): String;
function  HexToInt(s: String): Integer;
procedure Expression;

var
  Index     : Integer;
  StackPtr  : Integer;
  NewSelect : Boolean;
  token     : String;
  IntStack  : array[0..99] of String;
  WorkList  : TStringList;
  TokenList : TStringList;
  SymbolList: TStringList;
// SymbolTextの内容は
// 名前文字列：16進4桁文字列
// の並びとしてください
// ':'が名前と数値文字列との区分文字となります

implementation

// 16進数文字列→整数
function HexToInt(s: String): Integer;
begin
  Result := StrToInt('$'+s);
end;

// 文字列は数値か
function IsNumber(s: String): Boolean;
begin
  if StrToIntDef(s, InValidValue) <> InValidValue then Result := True
  else                                                 Result := False;
end;

// 文字列をスタックへ積む
procedure Push(s: String);
begin
  IntStack[StackPtr] := s;
  Inc(StackPtr);
end;

// スタックから文字列を取り出す
function Pop: String;
begin
  Dec(StackPtr);
  Result := IntStack[StackPtr];
end;

// シンボル定義リストから文字列（シンボル）に一致するものを探して
// 16進数値文字列を返す
function GetVal(s: String): String;
var i: Integer; str: String;
begin
  Result := UnDefined;

  for i := 0 to SymbolList.Count-1 do
  begin
    str := AnsiUpperCase(SymbolList[i]);

    if s = Copy(str, 1, AnsiPos(':', str)-1) then
    begin
      Result := Copy(str, AnsiPos(':', str)+1, 4);
      Break;
    end;
  end;
end;

// トークンリストから次のトークンを取り出す
function NextToken: String;
begin
  Result := '';

  if Index < TokenList.Count then
  begin
    Result := TokenList[Index];
    Inc(Index);
  end;
end;

// 式の因子のコンパイル
procedure Factor;
begin
  if (token <> '+')   and (token <> '-')   and (token <> '*')   and
     (token <> '/')   and (token <> '(')   and (token <> ')')   and
     (token <> 'MOD') and (token <> 'SHR') and (token <> 'SHL') and
     (token <> 'AND') and (token <> 'OR')  and (token <> 'XOR') and
     (not IsNumber(token)) then // シンボル
  begin
    WorkList.Add(GetVal(token));
    token := NextToken;
  end
  else
  begin
    if IsNumber(token) then
    begin     // 定数
      WorkList.Add(IntToHex(StrToInt(token), 4));
      token := NextToken;
    end
    else
      if token = '(' then
      begin   // 「(」「因子」「)」
        token := NextToken;
        Expression;
        if token = ')' then token := NextToken;
      end;
  end;
end;

// 式の項のコンパイル
procedure Term;
var k: String;
begin
  Factor;

  k := token;
  while (k = '*')   or (k = '/')   or
        (k = 'MOD') or (k = 'SHR') or (k = 'SHL') or
        (k = 'AND') or (k = 'OR')  or (k = 'XOR') do
  begin
    token := NextToken;
    Factor;
    if k = '*'   then WorkList.Add('MUL_')
    else
    if k = '/'   then WorkList.Add('DIV_')
    else
    if k = 'MOD' then WorkList.Add('MOD_')
    else
    if k = 'SHR' then WorkList.Add('SHR_')
    else
    if k = 'SHL' then WorkList.Add('SHL_')
    else
    if k = 'AND' then WorkList.Add('AND_')
    else
    if k = 'OR'  then WorkList.Add('OR__')
    else
    if k = 'XOR' then WorkList.Add('XOR_');

    k := token;
  end;
end;


Original document by TAK8            氏 ID:(QYR01421)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。