jvjantreeview.pas

East make Tray Icon in delphi

      MathError := True;
      TokenError := ErrInvalidNum;
      Position := Position + Pred(Check);
    end
    else
    begin
      NextToken := ttNum;
      Position := Position + System.Length(NumString);
      TokenLen := Position - TokenLen;
    end;
    Exit;
  end
  else
  if Ch in IdentifierLetters then
  begin
    if IsFunc('ABS') or IsFunc('ATAN') or IsFunc('COS') or
      IsFunc('EXP') or IsFunc('LN') or IsFunc('ROUND') or
      IsFunc('SIN') or IsFunc('SQRT') or IsFunc('SQR') or IsFunc('TRUNC') then
    begin
      NextToken := ttFunc;
      TokenLen := Position - TokenLen;
      Exit;
    end;
    if IsFunc('MOD') then
    begin
      NextToken := ttModu;
      TokenLen := Position - TokenLen;
      Exit;
    end;
    if IsVar(CurrToken.Value) then
    begin
      NextToken := ttNum;
      TokenLen := Position - TokenLen;
      Exit;
    end
    else
    begin
      NextToken := ttBad;
      TokenLen := 0;
      Exit;
    end;
  end
  else
  begin
    case Ch of
      '+':
        NextToken := ttPlus;
      '-':
        NextToken := ttMinus;
      '*':
        NextToken := ttTimes;
      '/':
        NextToken := ttDivide;
      '^':
        NextToken := ttExpo;
      '(':
        NextToken := ttOParen;
      ')':
        NextToken := ttCParen;
    else
      begin
        NextToken := ttBad;
        TokenLen := 0;
        Exit;
      end;
    end;
    Position := Position + 1;
    TokenLen := Position - TokenLen;
    Exit;
  end;
end;

{ Pops the top Token off of the stack }

procedure TJvMathParser.Pop(var Token: TokenRec);
begin
  Token := Stack[StackTop];
  Dec(StackTop);
end;

{ Pushes a new Token onto the stack }

procedure TJvMathParser.Push(Token: TokenRec);
begin
  if StackTop = ParserStackSize then
    TokenError := ErrParserStack
  else
  begin
    Inc(StackTop);
    Stack[StackTop] := Token;
  end;
end;

{ Parses an input stream }

procedure TJvMathParser.Parse;
var
  FirstToken: TokenRec;
  Accepted: Boolean;
begin
  Position := 1;
  StackTop := 0;
  TokenError := 0;
  MathError := False;
  ParseError := False;
  Accepted := False;
  FirstToken.State := 0;
  FirstToken.Value := 0;
  Push(FirstToken);
  TokenType := NextToken;
  repeat
    case Stack[StackTop].State of
      0, 9, 12..16, 20, 40:
        begin
          if TokenType = ttNum then
            Shift(10)
          else
          if TokenType = ttFunc then
            Shift(11)
          else
          if TokenType = ttMinus then
            Shift(5)
          else
          if TokenType = ttOParen then
            Shift(9)
          else
          if TokenType = ttErr then
          begin
            MathError := True;
            Accepted := True;
          end
          else
          begin
            TokenError := ErrExpression;
            Position := Position - TokenLen;
          end;
        end;
      1:
        begin
          if TokenType = ttEol then
            Accepted := True
          else
          if TokenType = ttPlus then
            Shift(12)
          else
          if TokenType = ttMinus then
            Shift(13)
          else
          begin
            TokenError := ErrOperator;
            Position := Position - TokenLen;
          end;
        end;
      2:
        begin
          if TokenType = ttTimes then
            Shift(14)
          else
          if TokenType = ttDivide then
            Shift(15)
          else
            Reduce(3);
        end;
      3:
        begin
          if TokenType = ttModu then
            Shift(40)
          else
            Reduce(6);
        end;
      4:
        begin
          if TokenType = ttExpo then
            Shift(16)
          else
            Reduce(8);
        end;
      5:
        begin
          if TokenType = ttNum then
            Shift(10)
          else
          if TokenType = ttFunc then
            Shift(11)
          else
          if TokenType = ttOParen then
            Shift(9)
          else
          begin
            TokenError := ErrExpression;
            Position := Position - TokenLen;
          end;
        end;
      6:
        Reduce(10);
      7:
        Reduce(13);
      8:
        Reduce(12);
      10:
        Reduce(15);
      11:
        if TokenType = ttOParen then
          Shift(20)
        else
        begin
          TokenError := ErrOpenParen;
          Position := Position - TokenLen;
        end;
      17:
        Reduce(9);
      18:
        raise EJVCLException.CreateRes(@RsEBadTokenState);
      19:
        if TokenType = ttPlus then
          Shift(12)
        else
        if TokenType = ttMinus then
          Shift(13)
        else
        if TokenType = ttCParen then
          Shift(27)
        else
        begin
          TokenError := ErrOpCloseParen;
          Position := Position - TokenLen;
        end;
      21:
        if TokenType = ttTimes then
          Shift(14)
        else
        if TokenType = ttDivide then
          Shift(15)
        else
          Reduce(1);
      22:
        if TokenType = ttTimes then
          Shift(14)
        else
        if TokenType = ttDivide then
          Shift(15)
        else
          Reduce(2);
      23:
        Reduce(4);
      24:
        Reduce(5);
      25:
        Reduce(7);
      26:
        Reduce(11);
      27:
        Reduce(14);
      28:
        if TokenType = ttPlus then
          Shift(12)
        else
        if TokenType = ttMinus then
          Shift(13)
        else
        if TokenType = ttCParen then
          Shift(29)
        else
        begin
          TokenError := ErrOpCloseParen;
          Position := Position - TokenLen;
        end;
      29:
        Reduce(16);
      80:
        Reduce(100);
    end;
  until Accepted or (TokenError <> 0);
  if TokenError <> 0 then
  begin
    if TokenError = ErrBadRange then
       Position := Position - TokenLen;
    if Assigned(FOnParseError) then
      FOnParseError(Self, TokenError);
  end;
  if MathError or (TokenError <> 0) then
  begin
    ParseError := True;
    ParseValue := 0;
    Exit;
  end;
  ParseError := False;
  ParseValue := Stack[StackTop].Value;
end;

{ Completes a reduction }

procedure TJvMathParser.Reduce(Reduction: Word);
var
  Token1, Token2: TokenRec;
begin
  case Reduction of
    1:
      begin
        Pop(Token1);
        Pop(Token2);
        Pop(Token2);
        CurrToken.Value := Token1.Value + Token2.Value;
      end;
    2:
      begin
        Pop(Token1);
        Pop(Token2);
        Pop(Token2);
        CurrToken.Value := Token2.Value - Token1.Value;
      end;
    4:
      begin
        Pop(Token1);
        Pop(Token2);
        Pop(Token2);
        CurrToken.Value := Token1.Value * Token2.Value;
      end;
    5:
      begin
        Pop(Token1);
        Pop(Token2);
        Pop(Token2);
        if Token1.Value = 0 then
          MathError := True
        else
          CurrToken.Value := Token2.Value / Token1.Value;
      end;
    { MOD operator }
    100:
      begin
        Pop(Token1);
        Pop(Token2);
        Pop(Token2);
        if Token1.Value = 0 then
          MathError := True
        else
          CurrToken.Value := Round(Token2.Value) mod Round(Token1.Value);
      end;
    7:
      begin
        Pop(Token1);
        Pop(Token2);
        Pop(Token2);
        if Token2.Value <= 0 then
          MathError := True
        else
        if (Token1.Value * Ln(Token2.Value) < -ExpLimit) or
          (Token1.Value * Ln(Token2.Value) > ExpLimit) then
          MathError := True
        else
          CurrToken.Value := Exp(Token1.Value * Ln(Token2.Value));
      end;
    9:
      begin
        Pop(Token1);
        Pop(Token2);
        CurrToken.Value := -Token1.Value;
      end;
    11:
      raise EJVCLException.CreateRes(@RsEInvalidReduction);
    13:
      raise EJVCLException.CreateRes(@RsEInvalidReduction);
    14:
      begin
        Pop(Token1);
        Pop(CurrToken);
        Pop(Token1);
      end;
    16:
      begin
        Pop(Token1);
        Pop(CurrToken);
        Pop(Token1);
        Pop(Token1);
        if Token1.FuncName = 'ABS' then
          CurrToken.Value := Abs(CurrToken.Value)
        else
        if Token1.FuncName = 'ATAN' then
          CurrToken.Value := ArcTan(CurrToken.Value)
        else
        if Token1.FuncName = 'COS' then
        begin
          if (CurrToken.Value < -9E18) or (CurrToken.Value > 9E18) then
            MathError := True
          else
            CurrToken.Value := Cos(CurrToken.Value)
        end
        else
        if Token1.FuncName = 'EXP' then
        begin
          if (CurrToken.Value < -ExpLimit) or (CurrToken.Value > ExpLimit) then
            MathError := True
          else
            CurrToken.Value := Exp(CurrToken.Value);
        end
        else
        if Token1.FuncName = 'LN' then
        begin
          if CurrToken.Value <= 0 then
            MathError := True
          else
            CurrToken.Value := Ln(CurrToken.Value);
        end
        else
        if Token1.FuncName = 'ROUND' then
        begin
          if (CurrToken.Value < -1E9) or (CurrToken.Value > 1E9) then
            MathError := True
          else
            CurrToken.Value := Round(CurrToken.Value);
        end
        else
        if Token1.FuncName = 'SIN' then
        begin
          if (CurrToken.Value < -9E18) or (CurrToken.Value > 9E18) then
            MathError := True
          else
            CurrToken.Value := Sin(CurrToken.Value)
        end
        else
        if Token1.FuncName = 'SQRT' then
        begin
          if CurrToken.Value < 0 then
            MathError := True
          else
            CurrToken.Value := Sqrt(CurrToken.Value);
        end
        else
        if Token1.FuncName = 'SQR' then
        begin
          if (CurrToken.Value < -SqrLimit) or (CurrToken.Value > SqrLimit) then
            MathError := True
          else
            CurrToken.Value := Sqr(CurrToken.Value);
        end
        else
        if Token1.FuncName = 'TRUNC' then
        begin
          if (CurrToken.Value < -1E9) or (CurrToken.Value > 1E9) then
            MathError := True
          else
            CurrToken.Value := Trunc(CurrToken.Value);
        end;
      end;
    3, 6, 8, 10, 12, 15:
      Pop(CurrToken);
  end;
  CurrToken.State := GotoState(Reduction);
  Push(CurrToken);
end;

{ Shifts a Token onto the stack }

procedure TJvMathParser.Shift(State: Word);
begin
  CurrToken.State := State;
  Push(CurrToken);
  TokenType := NextToken;
end;

//=== { TTreeKeyMappings } ===================================================

procedure TTreeKeyMappings.SetAddNode(const Value: TShortCut);
begin
  FAddNode := Value;
end;

procedure TTreeKeyMappings.SetDeleteNode(const Value: TShortCut);
begin
  FDeleteNode := Value;
end;

procedure TTreeKeyMappings.SetInsertNode(const Value: TShortCut);
begin
  FInsertNode := Value;
end;

procedure TTreeKeyMappings.SetAddChildNode(const Value: TShortCut);
begin
  FAddChildNode := Value;
end;

procedure TTreeKeyMappings.SetDuplicateNode(const Value: TShortCut);
begin
  FDuplicateNode := Value;
end;

procedure TTreeKeyMappings.SetEditNode(const Value: TShortCut);
begin
  FEditNode := Value;
end;

procedure TJvJanTreeView.KeyPress(var Key: Char);
begin
  if Key = Cr then
    Recalculate;
  if Assigned(OnKeyPress) then
    OnKeyPress(Self, Key);
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.