jvqjantreeview.pas

East make Tray Icon in delphi

      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}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQJanTreeView.pas,v $';
    Revision: '$Revision: 1.8 $';
    Date: '$Date: 2004/11/07 22:53:55 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.