jvqjantreeview.pas

East make Tray Icon in delphi

{******************************************************************************}
{* WARNING:  JEDI VCL To CLX Converter generated unit.                        *}
{*           Manual modifications will be lost on next release.               *}
{******************************************************************************}

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvJanTreeView.PAS, released on 2002-06-15.

The Initial Developer of the Original Code is Jan Verhoeven [jan1 dott verhoeven att wxs dott nl]
Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven.
All Rights Reserved.

Contributor(s): Robert Love [rlove att slcdug dott org].

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvQJanTreeView.pas,v 1.8 2004/11/07 22:53:55 asnepvangers Exp $

unit JvQJanTreeView;

{$I jvcl.inc}

interface

uses
  QWindows, 
  SysUtils, Classes,
  QGraphics, QControls, QForms, QDialogs, QComCtrls, QMenus;

type
  TGetVarEvent = procedure(Sender: TObject; VarName: string;
    var Value: Extended; var Found: Boolean) of object;

  TParseErrorEvent = procedure(Sender: TObject; ParseError: Integer) of object;

const
  ParserStackSize = 15;
  MaxFuncNameLen = 5;
  ExpLimit = 11356;
  SqrLimit = 1E2466;
  MaxExpLen = 4;
  TotalErrors = 7;
  ErrParserStack = 1;
  ErrBadRange = 2;
  ErrExpression = 3;
  ErrOperator = 4;
  ErrOpenParen = 5;
  ErrOpCloseParen = 6;
  ErrInvalidNum = 7;

type
  ErrorRange = 0..TotalErrors;

  TokenTypes = (ttPlus, ttMinus, ttTimes, ttDivide, ttExpo, ttOParen,
    ttCParen, ttNum, ttFunc, ttEol, ttBad, ttErr, ttModu);

  TokenRec = record
    State: Byte;
    case Byte of
      0:
        (Value: Extended);
      2:
        (FuncName: string[MaxFuncNameLen]);
  end;

type
  TJvMathParser = class(TComponent)
  private
    FInput: string;
    FOnGetVar: TGetVarEvent;
    FOnParseError: TParseErrorEvent;
    FPosition: Word;
    FParseError: Boolean;
    FParseValue: Extended;
  protected
    CurrToken: TokenRec;
    MathError: Boolean;
    Stack: array [1..ParserStackSize] of TokenRec;
    StackTop: 0..ParserStackSize;
    TokenError: ErrorRange;
    TokenLen: Word;
    TokenType: TokenTypes;
    function GotoState(Production: Word): Word;
    function IsFunc(S: string): Boolean;
    function IsVar(var Value: Extended): Boolean;
    function NextToken: TokenTypes;
    procedure Push(Token: TokenRec);
    procedure Pop(var Token: TokenRec);
    procedure Reduce(Reduction: Word);
    procedure Shift(State: Word);
  public
    constructor Create(AOwner: TComponent); override;
    procedure Parse;
    property Position: Word read FPosition write FPosition;
    property ParseError: Boolean read FParseError write FParseError;
    property ParseValue: Extended read FParseValue write FParseValue;
  published
    property OnGetVar: TGetVarEvent read FOnGetVar write FOnGetVar;
    property OnParseError: TParseErrorEvent read FOnParseError write FOnParseError;
    property ParseString: string read FInput write FInput;
  end;

  TTreeKeyMappings = class(TPersistent)
  private
    FAddNode: TShortCut;
    FInsertNode: TShortCut;
    FAddChildNode: TShortCut;
    FDeleteNode: TShortCut;
    FDuplicateNode: TShortCut;
    FEditNode: TShortCut;
    FSaveTree: TShortCut;
    FLoadTree: TShortCut;
    FCloseTree: TShortCut;
    FSaveTreeAs: TShortCut;
    FFindNode: TShortCut;
    procedure SetAddNode(const Value: TShortCut);
    procedure SetInsertNode(const Value: TShortCut);
    procedure SetDeleteNode(const Value: TShortCut);
    procedure SetAddChildNode(const Value: TShortCut);
    procedure SetDuplicateNode(const Value: TShortCut);
    procedure SetEditNode(const Value: TShortCut);
    procedure SetLoadTree(const Value: TShortCut);
    procedure SetSaveTree(const Value: TShortCut);
    procedure SetCloseTree(const Value: TShortCut);
    procedure SetSaveTreeAs(const Value: TShortCut);
    procedure SetFindNode(const Value: TShortCut);
  published
    property AddNode: TShortCut read FAddNode write SetAddNode;
    property DeleteNode: TShortCut read FDeleteNode write SetDeleteNode;
    property InsertNode: TShortCut read FInsertNode write SetInsertNode;
    property AddChildNode: TShortCut read FAddChildNode write SetAddChildNode;
    property DuplicateNode: TShortCut read FDuplicateNode write SetDuplicateNode;
    property EditNode: TShortCut read FEditNode write SetEditNode;
    property FindNode: TShortCut read FFindNode write SetFindNode;
    property LoadTree: TShortCut read FLoadTree write SetLoadTree;
    property SaveTree: TShortCut read FSaveTree write SetSaveTree;
    property SaveTreeAs: TShortCut read FSaveTreeAs write SetSaveTreeAs;
    property CloseTree: TShortCut read FCloseTree write SetCloseTree;
  end;

  TJvJanTreeView = class(TTreeView)
  private
    FParser: TJvMathParser;
    FParseError: Boolean;
    FKeyMappings: TTreeKeyMappings;
    FKeyMappingsEnabled: Boolean;
    FVarList: TStringList;
    FColorFormulas: Boolean;
    FFormuleColor: TColor;
    FDefaultExt: string;
    FFileName: TFileName;
    FSearchText: string;
    procedure ParseVariables;
    procedure NodeDuplicate(ATree: TJvJanTreeView; FromNode, ToNode: TTreeNode);
    procedure SetKeyMappings(const Value: TTreeKeyMappings);
    procedure SetKeyMappingsEnabled(const Value: Boolean);
    procedure SetupKeyMappings;
    procedure ParserGetVar(Sender: TObject; VarName: string; var Value: Extended; var Found: Boolean);
    procedure ParserParseError(Sender: TObject; ParseError: Integer);  
    procedure DoCustomDrawItem(Sender: TCustomViewControl; Node: TCustomViewItem;
       Canvas: TCanvas; const Rect: TRect; State: TCustomDrawState;
       Stage: TCustomDrawStage; var DefaultDraw: Boolean); 
    procedure SetColorFormulas(const Value: Boolean);
    procedure SetFormuleColor(const Value: TColor);
    procedure SetDefaultExt(const Value: string);
    procedure SetFileName(const Value: TFileName);
  protected
    procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure DblClick; override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DuplicateNode;
    procedure DragDrop(Source: TObject; X, Y: Integer); override;
    procedure DoAddNode;
    procedure DoAddChildNode;
    procedure DoDeleteNode;
    procedure DoInsertNode;
    procedure DoEditNode;
    procedure DoFindNode;
    procedure DoLoadTree;
    procedure DoSaveTree;
    procedure DoSaveTreeAs;
    procedure DoCloseTree;
    procedure Recalculate;
  published
    property KeyMappings: TTreeKeyMappings read FKeyMappings write SetKeyMappings;
    property KeyMappingsEnabled: Boolean read FKeyMappingsEnabled write SetKeyMappingsEnabled default True;
    property ColorFormulas: Boolean read FColorFormulas write SetColorFormulas default True;
    property FormuleColor: TColor read FFormuleColor write SetFormuleColor;
    property FileName: TFileName read FFileName write SetFileName;
    property DefaultExt: string read FDefaultExt write SetDefaultExt;
  end;

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  JvQConsts, JvQResources, JvQTypes;

//=== { TJvJanTreeView } =====================================================

constructor TJvJanTreeView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  DragMode := dmAutomatic;
  FDefaultExt := 'txt';
  FKeyMappings := TTreeKeyMappings.Create;
  SetupKeyMappings;
  FColorFormulas := True;
  FKeyMappingsEnabled := True;
  FParser := TJvMathParser.Create(Self);
  FParser.OnGetVar := ParserGetVar;
  FParser.OnParseError := ParserParseError;
  FVarList := TStringList.Create;
  OnCustomDrawItem := DoCustomDrawItem;
end;

destructor TJvJanTreeView.Destroy;
begin
  FParser.Free;
  FKeyMappings.Free;
  FVarList.Free;
  inherited Destroy;
end;

procedure TJvJanTreeView.SetupKeyMappings;
begin
  with FKeyMappings do
  begin
    AddChildNode := TextToShortCut('Ctrl+Ins');
    AddNode := TextToShortCut('Ctrl+Shift+Ins');
    InsertNode := TextToShortCut('Shift+Ins');
    DeleteNode := TextToShortCut('Shift+Del');
    DuplicateNode := TextToShortCut('Ctrl+D');
    EditNode := TextToShortCut('F2');
    FindNode := TextToShortCut('Ctrl+F');
    LoadTree := TextToShortCut('Ctrl+O');
    SaveTree := TextToShortCut('Ctrl+S');
    CloseTree := TextToShortCut('Ctrl+Alt+C');
    SaveTreeAs := TextToShortCut('Ctrl+Alt+S');
  end;
end;

procedure TJvJanTreeView.DblClick;
var
  N: TTreeNode;
  S: string;
begin
  if Selected <> nil then
  begin
    N := Selected;
    S := N.Text;
    if (Copy(S, 1, 7) = 'http://') or (Copy(S, 1, 7) = 'mailto:') then
      ShellExecute(Handle, 'open', PChar(S), nil, nil, SW_SHOWNORMAL);
  end;
  if Assigned(OnDblClick) then
    OnDblClick(Self);
end;

procedure TJvJanTreeView.DoAddChildNode;
var
  N: TTreeNode;
begin
  if Selected <> nil then
  begin
    N := Selected;
    N := Items.AddChild(N, RsNewNode);
    Selected := N;
  end;
end;

procedure TJvJanTreeView.DoAddNode;
var
  N: TTreeNode;
begin
  Items.BeginUpdate;
  N := Items.Add(Selected, RsNewNode);
  Items.EndUpdate;
  Selected := N;
end;

procedure TJvJanTreeView.DoDeleteNode;
begin
  if Selected <> nil then
    Items.Delete(Selected);
end;

procedure TJvJanTreeView.DoEditNode;
var
  N: TTreeNode;
begin
  if Selected <> nil then
  begin
    N := Selected;
    N.EditText;
  end;
end;

procedure TJvJanTreeView.DoInsertNode;
var
  N: TTreeNode;
begin
  if Selected <> nil then
  begin
    N := Selected;
    Items.BeginUpdate;
    N := Items.Insert(N, RsNewNode);
    Items.EndUpdate;
    Selected := N;
  end;
end;

procedure TJvJanTreeView.DragDrop(Source: TObject; X, Y: Integer);
var 
  N: TTreeNode;
begin
  inherited DragDrop(Source, X, Y); 
    N := Self.GetNodeAt(X, Y); 
  if N <> nil then
  begin 
    if Source = Self then
    begin
      if Selected = nil then
        Exit;
      Selected.MoveTo(N, naInsert);
    end;
  end;
  if Assigned(OnDragDrop) then
    OnDragDrop(Self, Source, X, Y);
end;

procedure TJvJanTreeView.DragOver(Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  inherited DragOver(Source, X, Y, State, Accept);
  Accept := (Source = Self);
  if Assigned(OnDragOver) then
    OnDragOver(Self, Source, X, Y, State, Accept);
end;

procedure TJvJanTreeView.DuplicateNode;
var
  Node, NewNode: TTreeNode;
begin
  if Selected <> nil then
  begin
    Node := Selected;
    NewNode := Items.Add(Node, Node.Text);
    NodeDuplicate(Self, Node, NewNode);
  end;
end;

procedure TJvJanTreeView.KeyUp(var Key: Word; Shift: TShiftState);
var
  MKey: Word;
  MShift: TShiftState;

  function MLoadTree: Boolean;
  begin
    ShortCutToKey(KeyMappings.LoadTree, MKey, MShift);
    Result := ((MKey = Key) and (MShift = Shift));
  end;

  function MSaveTree: Boolean;
  begin
    ShortCutToKey(KeyMappings.SaveTree, MKey, MShift);
    Result := ((MKey = Key) and (MShift = Shift));
  end;

  function MSaveTreeAs: Boolean;
  begin
    ShortCutToKey(KeyMappings.SaveTreeAs, MKey, MShift);
    Result := ((MKey = Key) and (MShift = Shift));
  end;

  function MCloseTree: Boolean;
  begin
    ShortCutToKey(KeyMappings.CloseTree, MKey, MShift);
    Result := ((MKey = Key) and (MShift = Shift));
  end;

  function MAddNode: Boolean;
  begin
    ShortCutToKey(KeyMappings.AddNode, MKey, MShift);
    Result := ((MKey = Key) and (MShift = Shift));
  end;

  function MDeleteNode: Boolean;
  begin
    ShortCutToKey(KeyMappings.DeleteNode, MKey, MShift);
    Result := ((MKey = Key) and (MShift = Shift));
  end;

  function MInsertNode: Boolean;
  begin
    ShortCutToKey(KeyMappings.InsertNode, MKey, MShift);
    Result := ((MKey = Key) and (MShift = Shift));
  end;

  function MAddChildNode: Boolean;
  begin
    ShortCutToKey(KeyMappings.AddChildNode, MKey, MShift);
    Result := ((MKey = Key) and (MShift = Shift));
  end;

  function MDuplicateNode: Boolean;
  begin
    ShortCutToKey(KeyMappings.DuplicateNode, MKey, MShift);
    Result := ((MKey = Key) and (MShift = Shift));
  end;

  function MEditNode: Boolean;
  begin
    ShortCutToKey(KeyMappings.EditNode, MKey, MShift);
    Result := ((MKey = Key) and (MShift = Shift));
  end;

  function MFindNode: Boolean;
  begin
    ShortCutToKey(KeyMappings.FindNode, MKey, MShift);
    Result := ((MKey = Key) and (MShift = Shift));
  end;

begin
  inherited KeyUp(Key, Shift);
  if KeyMappingsEnabled then
  begin
    if MAddNode then
      DoAddNode
    else
    if MDeleteNode then
      DoDeleteNode
    else
    if MInsertNode then
      DoInsertNode
    else
    if MAddChildNode then
      DoAddChildNode
    else
    if MDuplicateNode then
      DuplicateNode
    else
    if MEditNode then
      DoEditNode
    else
    if MFindNode then
      DoFindNode
    else
    if MLoadTree then
      DoLoadTree
    else
    if MSaveTree then
      DoSaveTree
    else
    if MSaveTreeAs then
      DoSaveTreeAs
    else
    if MCloseTree then
      DoCloseTree;
  end;
  if Assigned(OnKeyDown) then
    OnKeyDown(Self, Key, Shift);
end;

procedure TJvJanTreeView.SetKeyMappings(const Value: TTreeKeyMappings);
begin
  FKeyMappings := Value;
end;

procedure TJvJanTreeView.SetKeyMappingsEnabled(const Value: Boolean);
begin
  FKeyMappingsEnabled := Value;
end;

procedure TJvJanTreeView.MouseMove(Shift: TShiftState; X, Y: Integer);
var

  N: TTreeNode;
  S: string;
begin

    N := GetNodeAt(X, Y); 
  if N <> nil then