jvqjantreeview.pas

East make Tray Icon in delphi

  begin 
     S := N.Text;
    if (Copy(S, 1, 7) = 'http://') or (Copy(S, 1, 7) = 'mailto:') then
      Cursor := crHandPoint
    else
      Cursor := crDefault;
  end
  else
    Cursor := crDefault;
  if Assigned(OnMouseMove) then
    OnMouseMove(Self, Shift, X, Y);
end;

procedure TJvJanTreeView.NodeDuplicate(ATree: TJvJanTreeView;
  FromNode, ToNode: TTreeNode);
var
  I: Integer;
begin
  if FromNode.Count > 0 then
    for I := 1 to FromNode.Count do
    begin
      ATree.Items.AddChild(ToNode, FromNode.Item[I - 1].Text);
      if FromNode.Item[I - 1].Count > 0 then
        NodeDuplicate(ATree, FromNode.Item[I - 1], ToNode.Item[I - 1]);
    end;
end;

procedure TJvJanTreeView.ParserGetVar(Sender: TObject; VarName: string;
  var Value: Extended; var Found: Boolean);
var
  N: TTreeNode;
  Index: Integer;
begin
  Found := False;
  Index := FVarList.IndexOf(VarName);
  if Index <> -1 then
  begin
    N := TTreeNode(FVarList.Objects[Index]);
    if N.Count > 0 then
    try
      Value := StrToFloat(N.Item[0].Text);
      Found := True;
    except
    end;
  end
  else
  if LowerCase(VarName) = 'pi' then
  begin
    Value := Pi;
    Found := True;
  end;
end;

procedure TJvJanTreeView.ParserParseError(Sender: TObject; ParseError: Integer);
begin
  FParseError := True;
end;

procedure TJvJanTreeView.Recalculate;
var
  N, NV: TTreeNode;
  S: string;
  I, P: Integer;
begin
  if Items.Count = 0 then
    Exit;
  ParseVariables;
  for I := 0 to Items.Count - 1 do
  begin
    N := Items[I];
    S := N.Text;
    P := Pos('=', S);
    if P = 0 then
      Continue;
    S := Copy(S, P + 1, Length(S));
    if S = '' then
      Continue;
    FParser.ParseString := S;
    FParseError := False;
    FParser.Parse;
    if not FParseError then
    begin
      if N.Count = 0 then
        Items.AddChild(N, RsNew);
      NV := N.Item[0];
      NV.Text := FloatToStr(FParser.ParseValue);
    end
    else
    begin
      ShowMessageFmt(RsRecalculateErr, [S]);
      Exit;
    end;
  end;
end;

procedure TJvJanTreeView.ParseVariables;
var
  I, P: Integer;
  N: TTreeNode;
  S: string;
begin
  FVarList.Clear;
  if Items.Count = 0 then
    Exit;
  for I := 0 to Items.Count - 1 do
  begin
    N := Items[I];
    S := N.Text;
    P := Pos('=', S);
    if P = 0 then
      Continue;
    S := Copy(S, 1, P - 1);
    if S <> '' then
      FVarList.AddObject(S, TObject(N));
  end;
end;


type
  TCustomViewItemAccessProtected = class(TCustomViewItem);

procedure TJvJanTreeView.DoCustomDrawItem(Sender: TCustomViewControl; Node: TCustomViewItem;
  Canvas: TCanvas; const Rect: TRect; State: TCustomDrawState;
  Stage: TCustomDrawStage; var DefaultDraw: Boolean);


var
  S: string;
  R: TRect;
begin  
  S := TCustomViewItemAccessProtected(Node).Caption; 
  if (cdsSelected in State) or (cdsFocused in State) then
  begin
    DefaultDraw := True;
    Exit;
  end;
  if (Copy(S, 1, 7) = 'http://') or (Copy(S, 1, 7) = 'mailto:') then
    with Canvas do
    begin
      R := Node.DisplayRect;
      Font := Self.Font;
      Font.Style := Font.Style + [fsUnderline];
      Font.Color := clBlue;
      TextRect(R, R.Left, R.Top, S);
      DefaultDraw := False;
    end
  else
  if FColorFormulas and (Pos('=', S) > 0) then
    with Canvas do
    begin
      R := Node.DisplayRect;
      Font := Self.Font;
      Font.Color := FFormuleColor;
      TextRect(R, R.Left, R.Top, S);
      DefaultDraw := False;
    end
  else
    DefaultDraw := True;
end;

procedure TJvJanTreeView.SetColorFormulas(const Value: Boolean);
begin
  FColorFormulas := Value;
end;

procedure TJvJanTreeView.SetFormuleColor(const Value: TColor);
begin
  FFormuleColor := Value;
end;

procedure TTreeKeyMappings.SetLoadTree(const Value: TShortCut);
begin
  FLoadTree := Value;
end;

procedure TTreeKeyMappings.SetSaveTree(const Value: TShortCut);
begin
  FSaveTree := Value;
end;

procedure TJvJanTreeView.DoLoadTree;
var
  Dlg: TOpenDialog;
  S: string;
begin
  Dlg := TOpenDialog.Create(Self);
  try
    Dlg.DefaultExt := FDefaultExt;
    S := FDefaultExt;
    if S = '' then
      S := '*';
    Dlg.Filter := RsTreeViewFiles + '|*.' + S;
    if Dlg.Execute then
    begin
      LoadFromFile(Dlg.FileName);
      FFileName := Dlg.FileName;
      Recalculate;
    end;
  finally
    Dlg.Free;
  end;
end;

procedure TJvJanTreeView.DoSaveTreeAs;
var
  Dlg: TSaveDialog;
  S: string;
begin
  Dlg := TSaveDialog.Create(Self);
  try
    Dlg.DefaultExt := FDefaultExt;
    S := FDefaultExt;
    if S = '' then
      S := '*';
    Dlg.Filter := RsTreeViewFiles + '|*.' + S;
    if Dlg.Execute then
    begin
      SaveToFile(Dlg.FileName);
      FFileName := Dlg.FileName;
    end;
  finally
    Dlg.Free;
  end;
end;

procedure TJvJanTreeView.SetDefaultExt(const Value: string);
begin
  FDefaultExt := Value;
end;

procedure TJvJanTreeView.SetFileName(const Value: TFileName);
begin
  FFileName := Value;
end;

procedure TJvJanTreeView.DoCloseTree;
begin
  if MessageDlg(RsSaveCurrentTree, mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  begin
    if FFileName <> '' then
      SaveToFile(FFileName)
    else
      DoSaveTreeAs;
  end;
  Items.BeginUpdate;
  Items.Clear;
  Items.EndUpdate;
  FFileName := '';
end;

procedure TTreeKeyMappings.SetCloseTree(const Value: TShortCut);
begin
  FCloseTree := Value;
end;

procedure TTreeKeyMappings.SetSaveTreeAs(const Value: TShortCut);
begin
  FSaveTreeAs := Value;
end;

procedure TJvJanTreeView.DoSaveTree;
begin
  if FFileName <> '' then
    SaveToFile(FFileName)
  else
    DoSaveTreeAs;
end;

procedure TTreeKeyMappings.SetFindNode(const Value: TShortCut);
begin
  FFindNode := Value;
end;

procedure TJvJanTreeView.DoFindNode;
var
  N: TTreeNode;
  I, FR: Integer;
  S: string;
begin
  N := Selected;
  if N = nil then
    Exit;
  S := InputBox(RsSearch, RsSearchFor, FSearchText);
  if S = '' then
    Exit;
  FSearchText := S;
  S := LowerCase(S);
  FR := N.AbsoluteIndex;
  if FR < Items.Count - 1 then
    for I := FR + 1 to Items.Count - 1 do
      if Pos(S, LowerCase(Items[I].Text)) > 0 then
      begin
        Selected := Items[I];
        Exit;
      end;
  ShowMessage(Format(RsNoMoresFound, [S]));
end;

//=== { TJvMathParser } ======================================================

constructor TJvMathParser.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  { defaults }
  FInput := '';
end;

{ Finds the new state based on the just-completed production and the
  top state. }

function TJvMathParser.GotoState(Production: Word): Word;
var
  State: Word;
begin
  Result := 0; // removes warning
  State := Stack[StackTop].State;
  if Production <= 3 then
    case State of
      0:
        GotoState := 1;
      9:
        GotoState := 19;
      20:
        GotoState := 28;
    end
  else
  if Production <= 6 then
    case State of
      0, 9, 20:
        GotoState := 2;
      12:
        GotoState := 21;
      13:
        GotoState := 22;
    end
  else
  if (Production <= 8) or (Production = 100) then
    case State of
      0, 9, 12, 13, 20:
        GotoState := 3;
      14:
        GotoState := 23;
      15:
        GotoState := 24;
      16:
        GotoState := 25;
      40:
        GotoState := 80;
    end
  else
  if Production <= 10 then
    case State of
      0, 9, 12..16, 20, 40:
        GotoState := 4;
    end
  else
  if Production <= 12 then
    case State of
      0, 9, 12..16, 20, 40:
        GotoState := 6;
      5:
        GotoState := 17;
    end
  else
    case State of
      0, 5, 9, 12..16, 20, 40:
        GotoState := 8;
    end;
end;

{ Checks to see if the parser is about to read a function }

function TJvMathParser.IsFunc(S: string): Boolean;
var
  P, SLen: Word;
  FuncName: string;
begin
  P := Position;
  FuncName := '';
  while (P <= Length(FInput)) and (FInput[P] in IdentifierSymbols) do
  begin
    FuncName := FuncName + FInput[P];
    Inc(P);
  end;
  if UpperCase(FuncName) = S then
  begin
    SLen := Length(S);
    CurrToken.FuncName := UpperCase(Copy(FInput, Position, SLen));
    Position := Position + SLen;
    IsFunc := True;
  end
  else
    IsFunc := False;
end;

function TJvMathParser.IsVar(var Value: Extended): Boolean;
var
  VarName: string;
  VarFound: Boolean;
begin
  VarFound := False;
  VarName := '';
  while (Position <= Length(FInput)) and (FInput[Position] in IdentifierSymbols) do
  begin
    VarName := VarName + FInput[Position];
    Position := Position + 1;
  end;
  if Assigned(FOnGetVar) then
    FOnGetVar(Self, VarName, Value, VarFound);
  IsVar := VarFound;
end;

{ Gets the next Token from the Input stream }

function TJvMathParser.NextToken: TokenTypes;
var
  NumString: string[80];
  TLen, NumLen: Word;
  Check: Integer;
  Ch: Char;
  Decimal: Boolean;
begin
  NextToken := ttBad;
  while (Position <= Length(FInput)) and (FInput[Position] = ' ') do
    Position := Position + 1;
  TokenLen := Position;
  if Position > Length(FInput) then
  begin
    NextToken := ttEol;
    TokenLen := 0;
    Exit;
  end;
  Ch := UpCase(FInput[Position]);
  if Ch in ['!'] then
  begin
    NextToken := ttErr;
    TokenLen := 0;
    Exit;
  end;
  if Ch in ['0'..'9', '.'] then
  begin
    NumString := '';
    TLen := Position;
    Decimal := False;
    while (TLen <= Length(FInput)) and
      ((FInput[TLen] in DigitSymbols) or
      ((FInput[TLen] = '.') and (not Decimal))) do
    begin
      NumString := NumString + FInput[TLen];
      if Ch = '.' then
        Decimal := True;
      Inc(TLen);
    end;
    if (TLen = 2) and (Ch = '.') then
    begin
      NextToken := ttBad;
      TokenLen := 0;
      Exit;
    end;
    if (TLen <= Length(FInput)) and (UpCase(FInput[TLen]) = 'E') then
    begin
      NumString := NumString + 'E';
      Inc(TLen);
      if FInput[TLen] in ['+', '-'] then
      begin
        NumString := NumString + FInput[TLen];
        Inc(TLen);
      end;
      NumLen := 1;
      while (TLen <= Length(FInput)) and (FInput[TLen] in DigitSymbols) and
        (NumLen <= MaxExpLen) do
      begin
        NumString := NumString + FInput[TLen];
        Inc(NumLen);
        Inc(TLen);
      end;
    end;
    if NumString[1] = '.' then
      NumString := '0' + NumString;
    Val(NumString, CurrToken.Value, Check);
    if Check <> 0 then
    begin
      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