文字列から計算させるには？ (ID:149388)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

+ -  ＊/ 四則演算  ￥ 除算  ^ 乗算 , ()あり , ＊/￥^ 優先計算

小数対応なので Extended で値が返ってきます

//Space飛ばす(前方)
procedure SkipSpace(TEXT: String; var Index: Integer);
var
    B: Boolean;
    TEXT_LENGTH: Integer;
begin
    TEXT_LENGTH := Length(TEXT);
    B := True;
    while  (INDEX <= TEXT_LENGTH) and (B = True) do
    begin
      if (TEXT[Index] = ' ') then Inc(INDEX) else B := False;
    end;
end;

//Space飛ばす(後方)
procedure SkipSpace2(TEXT: String; var Index: Integer);
var
    B: Boolean;
    TEXT_LENGTH: Integer;
begin
    TEXT_LENGTH := Length(TEXT);
    B := True;
    while  (INDEX <= TEXT_LENGTH) and (B = True) do
    begin
      if (TEXT[Index] = ' ') then Dec(INDEX) else B := False;
    end;
end;

function GetValue(TEXT: String; var INDEX: Integer; var SELECT_TEXT: String): Boolean;
var
    B: Boolean;
    SAVE_INDEX: Integer;
    TEXT_LENGTH: Integer;
begin
    TEXT_LENGTH := Length(TEXT);
    if (INDEX <= TEXT_LENGTH)  then
    begin
      SAVE_INDEX := Index;
      if (TEXT[INDEX] = '-') or (TEXT[INDEX] = '+') then Inc(INDEX);
      if TEXT[INDEX] = '$' then Inc(INDEX);
      B := True;
      while  (INDEX <= TEXT_LENGTH) and (B = True) do
      begin
        if CharInSet(TEXT[INDEX],[' ','+','-','*','/','\','^']) = True then
        begin
          B := False;
        end
        else
        begin
          Inc(INDEX);
        end;
      end;
      SELECT_TEXT := Copy(TEXT,SAVE_INDEX,INDEX-SAVE_INDEX);
      RESULT  := True;
    end
    else
    begin
      RESULT := False;
    end;
end;

function GetValue2(TEXT: String; var INDEX: Integer; var SELECT_TEXT: String): Boolean;
var
    B: Boolean;
    SAVE_INDEX: Integer;
    INDEX2: Integer;
begin
    if (0 <= INDEX )  then
    begin
      SAVE_INDEX := Index;
      B := True;
      while  (0 < INDEX) and (B = True) do
      begin
        if TEXT[INDEX] = ' ' then
        begin
          B := False;
        end
        else
        if CharInSet(TEXT[INDEX],['+','-']) = True then
        begin
          INDEX2 := INDEX - 1;
          SkipSpace2(TEXT,INDEX2);

if CharInSet(TEXT[INDEX2],['+','-','*','/','\','^']) = True then
          begin
            INDEX := INDEX2 + 1;
          end;
          B := False;
        end
        else
        if CharInSet(TEXT[INDEX],['*','/','\','^']) = True then
        begin
          B := False;
        end
        else
        begin
          Dec(INDEX);
        end;
      end;
      SELECT_TEXT := Copy(TEXT,INDEX+1,SAVE_INDEX-INDEX);
      RESULT  := True;

Inc(INDEX);
    end
    else
    begin
      RESULT := False;
    end;
end;

function SelTextToFloat(SELECT_TEXT: String; var Value: Extended): Boolean;
begin
    RESULT := True;
    try
      if Pos('.',SELECT_TEXT) = 0 then
      begin
        VALUE := Extended(StrToInt(SELECT_TEXT));
      end
      else
      begin
        VALUE := StrToFloat(SELECT_TEXT);
      end;
    except
    　//数値エラー
      RESULT := False;
    end;
end;

function LastPos(SubStr,TEXT: String): Integer;
var
    Offset: Integer;
begin
    RESULT := 0;

Offset := 1;
    while Offset <> 0 do
    begin
      Offset := Pos(SubStr,TEXT,Offset);
      if Offset <> 0 then
      begin
        RESULT := Offset;
        Inc(Offset);
      end;
    end;
end;

function Replace(TEXT: String; I1,I2: Integer; NewText: String): String;
var
    S1,S2: String;
begin
    S1 := Copy(TEXT,1,I1-1);
    S2 := Copy(TEXT,I2);
    RESULT := S1 + NewText + S2;
end;

//べき乗
function Power(X: Extended; Y: Integer): Extended;
var
    I: Integer;
begin
    RESULT := 0;
    for I:=1 to Y do
    begin
      RESULT := RESULT + X;
    end;
end;

procedure XXX(Index: Integer; TEXT: String; Operation: Char; var ARESULT: Extended; var ERROR: Integer);
var
    TEXT_LENGTH: Integer;
    SELECT_TEXT: String;
    C: Char;
    VALUE: Extended;
begin
    if ERROR = 0 then
    begin
      TEXT_LENGTH := Length(TEXT);

SkipSpace(TEXT,INDEX); //SKIP SPACE 数値前のスペース

//数値取得
      if GetValue(TEXT,INDEX,SELECT_TEXT) = true then
      begin
        if SelTextToFloat(SELECT_TEXT,VALUE) = True then
        begin

//-------------------------
          // 四則演算 + - * / \
          //-------------------------
          case Operation of
            '+':ARESULT := ARESULT + VALUE;
            '-':ARESULT := ARESULT - VALUE;
            '/':ARESULT := ARESULT / VALUE;
            '*':ARESULT := ARESULT * VALUE;
            '\':ARESULT := Extended(Trunc(ARESULT) mod Trunc(VALUE));
            '^':ARESULT := Extended(Power(ARESULT,Trunc(VALUE)));
            else
            ARESULT := VALUE;
          end;

SkipSpace(TEXT,INDEX); //SKIP SPACE 数値と四則演算の間のスペース

if INDEX <= TEXT_LENGTH  then
          begin
            C := TEXT[Index];
            if (C = '+') or (C= '-') or (C='*') or (C='/') or (C = '\') or (C = '^') then
            begin
              Inc(INDEX); //Operation の次の位置から
              XXX(INDEX,TEXT,C,ARESULT,ERROR);
            end
            else
            begin
            　//四則演算が + - * / \ ^ 以外
              ERROR := 2;
            end;
          end
          else
          begin
            //テキスト最後
            ERROR := 0;
          end;
        end
        else
        begin
          //ERROR <> 0
        end;

end
      else
      begin
        //数値が無い
        ERROR := 3;
      end;
   end
   else
   begin
     //ERROR <> 0
   end;
end;

// * と / を計算
function YYY(TEXT: String; var ERROR: Integer): String;
var
    C: Char;
    INDEX,INDEX1,INDEX2,INDEX3,INDEX4: Integer;
    SAVE_INDEX,SAVE_INDEX1,SAVE_INDEX2: Integer;
    SELECT_TEXT1,SELECT_TEXT2: String;
    E1,E2: Extended;
    S1,S2: String;
begin
    RESULT := TEXT;

while (Pos('*',TEXT) <> 0) and (ERROR = 0) do
    begin

INDEX1 := Pos('*',TEXT);
      INDEX2 := Pos('/',TEXT);
      INDEX3 := Pos('^',TEXT);
      INDEX4 := Pos('\',TEXT);

if (INDEX1 or INDEX2 or INDEX3 or INDEX4) <> 0 then
      begin

C := Char(0);
        if (INDEX2 or INDEX3 or INDEX4) < INDEX1 then
        begin
          INDEX := INDEX1;
          C := '*';
        end;
        if (INDEX1 or INDEX3 or INDEX4) < INDEX2 then
        begin
          INDEX := INDEX2;
          C := '/';
        end;
        if (INDEX1 or INDEX2 or INDEX4) < INDEX3 then
        begin
          INDEX := INDEX3;
          C := '^';
        end;
        if (INDEX1 or INDEX2 or INDEX3) < INDEX4 then
        begin
          INDEX := INDEX4;
          C := '\';
        end;

SAVE_INDEX := INDEX;

//* - の前の値
        Dec(INDEX);
        SkipSpace2(TEXT,INDEX);
        GetValue2(TEXT,INDEX,SELECT_TEXT1);
        SAVE_INDEX1 := INDEX;

//* - の後ろの値
        INDEX := SAVE_INDEX;
        Inc(INDEX);
        SkipSpace(TEXT,INDEX);
        GetValue(TEXT,INDEX,SELECT_TEXT2);
        SAVE_INDEX2 := INDEX;

S1 := Copy(TEXT,1,SAVE_INDEX1-1);
        S2 := Copy(TEXT,SAVE_INDEX2);

if C = '^' then
        begin
          if SelTextToFloat(SELECT_TEXT1,E1) = True then
          begin
            try
              TEXT := S1 + FloatToStr(Power(E2,StrToInt(SELECT_TEXT2))) + S2;
            except
              ERROR := 99;
            end;
          end
          else
          begin
            ERROR := 99;
          end;
        end
        else
        begin
          if SelTextToFloat(SELECT_TEXT1,E1) = True then
          begin
            if SelTextToFloat(SELECT_TEXT2,E2) = True then
            begin
              if C = '*' then TEXT := S1 + FloatToStr(E1 * E2) + S2;
              if C = '/' then TEXT := S1 + FloatToStr(E2 / E2) + S2;
              if C = '\' then TEXT := S1 + FloatToStr(Trunc(E1) mod Trunc(E2)) + S2;
            end
            else
            begin
              ERROR := 99;
            end;
          end
          else
          begin
            ERROR := 99;
          end;
        end;

end;
    end;

RESULT := TEXT;
end;

function ZZZ(TEXT: String; var ERROR: Integer): Extended;
var
    Index1,Index2: Integer;
    SELECT_TEXT: String;
    ARESULT: Extended;
begin

if ERROR = 0 then
    begin

while (Pos('(',TEXT) <> 0) and (ERROR = 0) do
      begin
        Index1 := LastPos('(',TEXT);
        if Index1 <> 0 then
        begin
          Index2 := Pos(')',TEXT,Index1) + 1;
          if Index2 <> 0 then
          begin
            SELECT_TEXT := Copy(TEXT,Index1+1,Index2 - Index1-2);  // () 内のテキスト
            //* / ^ \ を先行計算
            SELECT_TEXT := YYY(SELECT_TEXT,ERROR);
            //() 内を計算させる
            ARESULT := 0;
            ERROR   := 0;
            XXX(1,SELECT_TEXT,Char(0),ARESULT,ERROR);
            //() 内を置き換える
            TEXT := Replace(TEXT,Index1,Index2,FloatToStr(ARESULT));
          end
          else
          begin
            //)が無い
            ERROR := 5;
          end;
        end;
      end;

// () の無くなったテキストを計算
      if ERROR = 0 then
      begin
        RESULT := 0;
        //* / ^ \ を先行計算
        TEXT := YYY(TEXT,ERROR);
        XXX(1,TEXT,Char(0),RESULT,ERROR);
      end;

end;

//MEMO1 に式
//MEMO2 に結果
procedure TForm1.Button1Click(Sender: TObject);
var
    RESULT: Extended;
    ERROR: Integer;
    I: Integer;
begin
    Memo2.Clear;
    for I:=0 to Memo1.Lines.Count -1 do
    begin
      ERROR := 0;
      RESULT := ZZZ (Memo1.Lines[I],ERROR);
      if ERROR = 0 then
      begin
        Memo2.Lines.Add(FloatToStr(RESULT));
      end
      else
      begin
        Memo2.Lines.Add('ERROR:' + IntToStr(ERROR));
      end;
    end;
end;

←解決時は質問者本人がここをチェックしてください。

戻る