lazarus-ccr/components/jvcllaz/run/JvDB/JvDBTreeView.pas

{-----------------------------------------------------------------------------
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: JvDBTreeView.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Andrei Prygounkov <a dott prygounkov att gmx dott de>
Copyright (c) 1999, 2002 Andrei Prygounkov
All Rights Reserved.

Contributor(s):
Peter Zolja
Marc Geldon

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

component   : JvDBTreeView
description : db-aware TreeView

History:
 (JVCL Library versions) :
  1.20:
    - first release;
  1.61:
    - support for non-bde components,
      by Yakovlev Vacheslav (jwe att belkozin dott com)
  3.3: martinalex, Jan 2007
    - Fix: Add Node, IconField, value set, same value as parent
    - Fix: Add Node, MasterField, unique value ensured
    - Fix: Delete node, delete records for all childs
    - Fix: Drag&drop, move node only for node drop, not for drop of other objects

Known Issues:
  Some russian comments were translated to english; these comments are marked
  with [translated]

Usage:
  - Dataset must have a unique field (e. g., ID) - link it to "MasterField"
  - There must be another field with the ID of the parent node - link it to
    "DetailField"
  - The text to be displayed as node text is taken from field "ItemField"
  - Optionally, there can ba an "IconField" from which the icon index into the
    ImageList is taken.
-----------------------------------------------------------------------------}
// $Id$

unit JvDBTreeView;

{$mode objfpc}{$H+}

interface

uses
  LCLIntf, LCLType, LMessages,
  Messages, CommCtrl,
  Classes, Controls, ExtCtrls, ComCtrls, DB;
//  JvExtComponent;

type
  TJvDBTreeNode = class;
  TJvDBTreeViewDataLink = class;
  TFieldTypes = set of TFieldType;
  TGetDetailValue = function(const AMasterValue: Variant; var DetailValue: Variant): Boolean;

  TJvCustomDBTreeView = class(TCustomTreeView)  //TJvCustomTreeView)
  private
    FDataLink: TJvDBTreeViewDataLink;
    FMasterField: string;
    FDetailField: string;
    FItemField: string;
    FIconField: string;
    FStartMasterValue: Variant;
    FGetDetailValue: TGetDetailValue;
    FUseFilter: Boolean;
    FSelectedIndex: Integer;
    {Update flags}
    FUpdateLock: Byte;
    InTreeUpdate: Boolean;
    InDataScrolled: Boolean;
    InAddChild: Boolean;
    InDelete: Boolean;
    Sel: TTreeNode;
    OldRecCount: Integer;
    FPersistentNode: Boolean;
    { wp: removed
    FMirror: Boolean;
    }
    {**** Drag'n'Drop ****}
    YDragPos: Integer;
    TimerDnD: TTimer;
    procedure InternalDataChanged;
    procedure InternalDataScrolled;
    procedure InternalRecordChanged(Field: TField);
    procedure SetMasterField(Value: string);
    procedure SetDetailField(Value: string);
    procedure SetItemField(Value: string);
    procedure SetIconField(Value: string);
    function GetStartMasterValue: string;
    procedure SetStartMasterValue(Value: string);
    function GetDataSource: TDataSource;
    procedure SetDataSource(Value: TDataSource);
    procedure CMGetDataLink(var Msg: TMessage); message CM_GETDATALINK;
    { wp -- removed
    procedure SetMirror(Value: Boolean);
    }
    {**** Drag'n'Drop ****}
    procedure TimerDnDTimer(Sender: TObject);
  protected
    FMastersStream: TStream;

    procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
      var Accept: Boolean); override;

    procedure CreateWnd; override;
    procedure DestroyWnd; override;
  protected
    procedure Warning(Msg: string);
    procedure HideEditor;
    function ValidDataSet: Boolean;
    procedure CheckDataSet;
    function ValidField(FieldName: string; AllowFieldTypes: TFieldTypes): Boolean;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure Notification(Component: TComponent; Operation: TOperation); override;
    procedure Change(Node: TTreeNode); override;
    { data }
    procedure DataChanged; dynamic;
    procedure DataScrolled; dynamic;
    procedure Change2(Node: TTreeNode); dynamic;
    procedure RecordChanged(Field: TField); dynamic;

    function CanExpand(Node: TTreeNode): Boolean; override;
    procedure Collapse(Node: TTreeNode); override;
    function CreateNode: TTreeNode; override;
    function CanEdit(Node: TTreeNode): Boolean; override;
    { *** FIXME
    procedure Edit(const Item: TTVItem); override;
    }
    procedure MoveTo(Source, Destination: TJvDBTreeNode; Mode: TNodeAttachMode);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DragDrop(Source: TObject; X, Y: Integer); override;
    procedure RefreshChild(ANode: TJvDBTreeNode);
    procedure UpdateTree;
    procedure LinkActive(Value: Boolean); virtual;
    procedure UpdateLock;
    procedure UpdateUnLock(const AUpdateTree: Boolean);
    function UpdateLocked: Boolean;
    function AddChildNode(const Node: TTreeNode; const ASelect: Boolean): TJvDBTreeNode;
    procedure DeleteNode(Node: TTreeNode);
    function DeleteChildren(ParentNode: TTreeNode): Boolean;
    function FindNextNode(const Node: TTreeNode): TTreeNode;
    function FindNode(AMasterValue: Variant): TJvDBTreeNode;
    function SelectNode(AMasterValue: Variant): TTreeNode;

    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DataLink: TJvDBTreeViewDataLink read FDataLink;
    property MasterField: string read FMasterField write SetMasterField;
    // alias for MasterField
    property ParentField: string read FMasterField write SetMasterField;
    property DetailField: string read FDetailField write SetDetailField;
    // alias for DetailField
    property KeyField: string read FDetailField write SetDetailField;

    property ItemField: string read FItemField write SetItemField;
    property IconField: string read FIconField write SetIconField;
    property StartMasterValue: string read GetStartMasterValue write SetStartMasterValue;
    property GetDetailValue: TGetDetailValue read FGetDetailValue write FGetDetailValue;
    property PersistentNode: Boolean read FPersistentNode write FPersistentNode;
    property SelectedIndex: Integer read FSelectedIndex write FSelectedIndex default 1;
    property UseFilter: Boolean read FUseFilter write FUseFilter;
    { wp --- removed
    property Mirror: Boolean read FMirror write SetMirror;
    }
    property Items;
  end;

  TJvDBTreeViewDataLink = class(TDataLink)
  private
    FTreeView: TJvCustomDBTreeView;
  protected
    procedure ActiveChanged; override;
    procedure RecordChanged(Field: TField); override;
    procedure DataSetChanged; override;
    procedure DataSetScrolled(Distance: Integer); override;
  public
    constructor Create(ATreeView: TJvCustomDBTreeView);
  end;

  TJvDBTreeNode = class(TTreeNode)
  private
    FMasterValue: Variant;
  public
    procedure SetMasterValue(AValue: Variant);
    procedure MoveTo(Destination: TTreeNode; Mode: TNodeAttachMode); override;
    property MasterValue: Variant read FMasterValue;
  end;

  {$IFDEF RTL230_UP}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64)]
  {$ENDIF RTL230_UP}
  TJvDBTreeView = class(TJvCustomDBTreeView)
  published
    property DataSource;
    property MasterField;
    property DetailField;
    property IconField;
    property ItemField;
    property StartMasterValue;
    property UseFilter;
    property PersistentNode;
    property SelectedIndex;

    property Align;
    property Anchors;
    property AutoExpand;
    property BackgroundColor;
    property BorderSpacing;
    property BorderStyle;
    property BorderWidth;
    property Color;
    property Constraints;
    property Cursor;
    property DefaultItemHeight;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property ExpandSignColor;
    property ExpandSignSize;
    property ExpandSignType;
    property Font;
    property Height;
    property HelpContext;
    property HelpKeyword;
    property HelpType;
    property HideSelection;
    property Hint;
    property HotTrack;
    property HotTrackColor;
    property Images;
    property Indent;
    property Items;
    property Left;
    property MultiSelect;
    property MultiSelectStyle;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property ReadOnly;
    property RightClickSelect;
    property RowSelect;
    property Scrollbars;
    property SelectionColor;
    property SelectionFontColor;
    property SelectionFontColorUsed;
    property SeparatorColor;
    property ShowButtons;
    property ShowHint;
    property ShowLines;
    property ShowRoot;
    property SortType;
    property StateImages;
    property TabOrder;
    property TabStop;
    property ToolTips;
    property Top;
    property TreeLineColor;
    property TreeLinePenStyle;
    property Visible;
    property Width;

    property OnAddition;
    property OnAdvancedCustomDraw;
    property OnAdvancedCustomDrawItem;
    property OnChange;
    property OnChanging;
    property OnClick;
    property OnCollapsed;
    property OnCollapsing;
    property OnContextPopup;
    property OnCreateNodeClass;
    property OnCustomDraw;
    property OnCustomDrawArrow;
    property OnCustomDrawItem;
    property OnDblClick;
    property OnDeletion;
    property OnDragDrop;
    property OnDragOver;
    property OnEdited;
    property OnEditing;
    property OnEditingEnd;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnExpanded;
    property OnExpanding;
    property OnGetImageIndex;
    property OnGetSelectedIndex;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseMove;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnNodeChanged;
    property OnResize;
    property OnSelectionChanged;
    property OnShowHint;
    property OnStartDrag;
    property OnUTF8KeyPress;
    { wp --- removed
    property Mirror;
    }
  end;

  EJvDBTreeViewError = class(ETreeViewError);


implementation

uses
  Variants, SysUtils, Dialogs, ImgList,
  JvResources;

// (rom) moved to implementation and removed type
// (rom) never rely on assignable consts
const
  DnDScrollArea = 15;
  DnDInterval = 200;
  DefaultValidMasterFields = [ftSmallInt, ftInteger, ftAutoInc, ftWord, ftFloat, ftString, ftWideString, ftBCD, ftFMTBCD];
  DefaultValidDetailFields = DefaultValidMasterFields;
  DefaultValidItemFields = [ftString, ftWideString, ftMemo, ftFmtMemo, ftSmallInt, ftInteger, ftAutoInc,
    ftWord, ftBoolean, ftFloat, ftCurrency, ftDate, ftTime, ftDateTime, ftBCD, ftFMTBCD
  {$IFDEF COMPILER10_UP}
  , ftFixedWideChar, ftWideMemo, ftOraTimeStamp
  {$ENDIF COMPILER10_UP}
  {$IFDEF COMPILER12_UP}
  ,ftLongWord, ftShortint, ftByte, ftExtended
  {$ENDIF COMPILER12_UP}];
  DefaultValidIconFields = [ftSmallInt, ftAutoInc, ftInteger, ftWord, ftBCD, ftFMTBCD
  {$IFDEF COMPILER12_UP}
  ,ftLongWord, ftShortint
  {$ENDIF COMPILER12_UP}];

function Var2Type(V: Variant; const VarType: Integer): Variant;
begin
  if V = Null then
  begin
    case VarType of
      varString, varOleStr:
        Result := '';
      varInteger, varSmallint, varByte:
        Result := 0;
      varBoolean:
        Result := False;
      varSingle, varDouble, varCurrency, varDate:
        Result := 0.0;
    else
      Result := VarAsType(V, VarType);
    end;
  end
  else
    Result := VarAsType(V, VarType);
end;

{ --- wp -- removed
procedure MirrorControl(Control: TWinControl; RightToLeft: Boolean);
var
  OldLong: Longword;
begin
  OldLong := GetWindowLong(Control.Handle, GWL_EXSTYLE);
  if RightToLeft then
  begin
    Control.BiDiMode := bdLeftToRight;
    SetWindowLong(Control.Handle, GWL_EXSTYLE, OldLong or $00400000);
  end
  else
    SetWindowLong(Control.Handle, GWL_EXSTYLE, OldLong and not $00400000);
  Control.Repaint;
end;                }

//=== { TJvDBTreeViewDataLink } ==============================================

constructor TJvDBTreeViewDataLink.Create(ATreeView: TJvCustomDBTreeView);
begin
  inherited Create;
  FTreeView := ATreeView;
end;

procedure TJvDBTreeViewDataLink.ActiveChanged;
begin
  FTreeView.LinkActive(Active);
end;

procedure TJvDBTreeViewDataLink.RecordChanged(Field: TField);
begin
  FTreeView.InternalRecordChanged(Field);
end;

procedure TJvDBTreeViewDataLink.DataSetChanged;
begin
  FTreeView.InternalDataChanged;
end;

procedure TJvDBTreeViewDataLink.DataSetScrolled(Distance: Integer);
begin
  FTreeView.InternalDataScrolled;
end;

//=== { TJvDBTreeNode } ======================================================

procedure TJvDBTreeNode.MoveTo(Destination: TTreeNode; Mode: TNodeAttachMode);
var
  PersistNode: Boolean;
  TV: TJvCustomDBTreeView;
begin
  if Destination <> nil then
  begin
    // If we are trying to move ourselves in the same parent and we are
    // already the last child, there is no point in moving us.
    // It's even dangerous as it triggers Mantis 3934
    if not ((Parent = Destination) and (Self = Destination.GetLastChild) and (Mode = naAddChild)) then
    begin
      TV := TreeView as TJvCustomDBTreeView;
      PersistNode := TV.FPersistentNode;
      TV.MoveTo(Self as TJvDBTreeNode, Destination as TJvDBTreeNode, Mode);
      TV.FPersistentNode := True;
      if (Destination <> nil) and Destination.HasChildren and (Destination.Count = 0) then
        Free
      else
        inherited MoveTo(Destination, Mode);
      TV.FPersistentNode := PersistNode;
    end;
  end;
end;

procedure TJvDBTreeNode.SetMasterValue(AValue: Variant);
begin
  FMasterValue := AValue;
end;

//=== { TJvCustomDBTreeView } ================================================

constructor TJvCustomDBTreeView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataLink := TJvDBTreeViewDataLink.Create(Self);
  TimerDnD := TTimer.Create(Self);
  TimerDnD.Enabled := False;
  TimerDnD.Interval := DnDInterval;
  TimerDnD.OnTimer := @TimerDnDTimer;
  FStartMasterValue := Null;
  FSelectedIndex := 1;
  FMastersStream := nil;
end;

destructor TJvCustomDBTreeView.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  TimerDnD.Free;
  FMastersStream.Free;
  inherited Destroy;
end;

procedure TJvCustomDBTreeView.CheckDataSet;
begin
  if not ValidDataSet then
    raise EJvDBTreeViewError.CreateRes(@RsEDataSetNotActive);
end;

procedure TJvCustomDBTreeView.Warning(Msg: string);
begin
  MessageDlg('TJvCustomDBTreeView.Warning()' + #13#10 + Name + ': ' + Msg, mtWarning, [mbOk], 0);
end;

function TJvCustomDBTreeView.ValidField(FieldName: string; AllowFieldTypes: TFieldTypes): Boolean;
var
  AField: TField;
begin
  Result := (csLoading in ComponentState) or (Length(FieldName) = 0) or
    (FDataLink.DataSet = nil) or not FDataLink.DataSet.Active;
  if not Result and (Length(FieldName) > 0) then
  begin
    AField := FDataLink.DataSet.FindField(FieldName); { no exceptions }
    Result := (AField <> nil) and (AField.DataType in AllowFieldTypes);
  end;
end;

procedure TJvCustomDBTreeView.SetMasterField(Value: string);
begin
  if ValidField(Value, DefaultValidMasterFields) then
  begin
    FMasterField := Value;
    RefreshChild(nil);
  end
  else
    Warning(RsMasterFieldError);
end;

procedure TJvCustomDBTreeView.SetDetailField(Value: string);
begin
  if ValidField(Value, DefaultValidDetailFields) then
  begin
    FDetailField := Value;
    RefreshChild(nil);
  end
  else
    Warning(RsDetailFieldError);
end;

procedure TJvCustomDBTreeView.SetItemField(Value: string);
begin
  if ValidField(Value, DefaultValidItemFields) then
  begin
    FItemField := Value;
    RefreshChild(nil);
  end
  else
    Warning(RsItemFieldError);
end;

procedure TJvCustomDBTreeView.SetIconField(Value: string);
begin
  if ValidField(Value, DefaultValidIconFields) then
  begin
    FIconField := Value;
    RefreshChild(nil);
  end
  else
    Warning(RsIconFieldError);
end;

function TJvCustomDBTreeView.GetStartMasterValue: string;
begin
  if FStartMasterValue = Null then
    Result := ''
  else
    Result := FStartMasterValue;
end;

procedure TJvCustomDBTreeView.SetStartMasterValue(Value: string);
begin
  if Length(Value) > 0 then
    FStartMasterValue := Value
  else
    FStartMasterValue := Null;
end;

function TJvCustomDBTreeView.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TJvCustomDBTreeView.SetDataSource(Value: TDataSource);
begin
  if Value = FDataLink.DataSource then
    Exit;
  Items.Clear;
  if FDataLink.DataSource <> nil then
    FDataLink.DataSource.RemoveFreeNotification(Self);
  FDataLink.DataSource := Value;
  if Value <> nil then
    Value.FreeNotification(Self);
end;

procedure TJvCustomDBTreeView.CMGetDataLink(var Msg: TMessage);
begin
  Msg.Result := LRESULT(FDataLink);
end;

procedure TJvCustomDBTreeView.Notification(Component: TComponent; Operation: TOperation);
begin
  inherited Notification(Component, Operation);
  if (FDataLink <> nil) and (Component = DataSource) and (Operation = opRemove) then
    DataSource := nil;
end;

function TJvCustomDBTreeView.CreateNode: TTreeNode;
begin
  Result := TJvDBTreeNode.Create(Items);
end;

procedure TJvCustomDBTreeView.HideEditor;
begin
  if Selected <> nil then
    Selected.EndEdit(True);
end;

function TJvCustomDBTreeView.ValidDataSet: Boolean;
begin
  Result := Assigned(FDataLink) and FDataLink.Active and Assigned(FDataLink.DataSet) and FDataLink.DataSet.Active;
end;

procedure TJvCustomDBTreeView.LinkActive(Value: Boolean);

  function AllFieldsValid: Boolean;
  begin
    Result := False;
    if ValidDataSet then
    begin
      if (FMasterField = '') or (FDataLink.DataSet.FindField(FMasterField) = nil) then
      begin
        Warning(RsMasterFieldEmpty);
        Exit;
      end;
      if (FDetailField = '') or (FDataLink.DataSet.FindField(FDetailField) = nil) then
      begin
        Warning(RsDetailFieldEmpty);
        Exit;
      end;
      if (FItemField = '') or (FDataLink.DataSet.FindField(FItemField) = nil) then
      begin
        Warning(RsItemFieldEmpty);
        Exit;
      end;
     { if (FDataLink.DataSet.FindField(FMasterField).DataType <> FDataLink.DataSet.FindField(FDetailField).DataType) then
       begin
        Warning(RsMasterDetailFieldError);
        Exit;
      end; }
      if (FDataLink.DataSet.FindField(FItemField).DataType in
        [ftBytes, ftVarBytes, ftBlob, ftGraphic, ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary]) then
      begin
        Warning(RsItemFieldError);
        Exit;
      end;
      if (FIconField <> '') and not (FDataLink.DataSet.FindField(FIconField).DataType in
        [ftSmallInt, ftInteger, ftWord]) then
      begin
        Warning(RsIconFieldError);
        Exit;
      end;
    end;
    Result := True;
  end;
begin
  if not Value then
    HideEditor;
  if not AllFieldsValid then
    Exit;
  //if ( csDesigning in ComponentState ) then Exit;
  if ValidDataSet then
  begin
    RefreshChild(nil);
    OldRecCount := FDataLink.DataSet.RecordCount;
  end
  else
    if FUpdateLock = 0 then
      Items.Clear;
end;

procedure TJvCustomDBTreeView.UpdateLock;
begin
  Inc(FUpdateLock);
end;

procedure TJvCustomDBTreeView.UpdateUnLock(const AUpdateTree: Boolean);
begin
  if FUpdateLock > 0 then
    Dec(FUpdateLock);
  if (FUpdateLock = 0) then
    if AUpdateTree then
      UpdateTree
    else
      OldRecCount := FDataLink.DataSet.RecordCount;
end;

function TJvCustomDBTreeView.UpdateLocked: Boolean;
begin
  Result := FUpdateLock > 0;
end;

procedure TJvCustomDBTreeView.RefreshChild(ANode: TJvDBTreeNode);
var
  ParentValue: Variant;
  BK: TBookmark;
  OldFilter: string;
  OldFiltered: Boolean;
  PV: string;
  I: Integer;

  cNode: TTreeNode;
  fbnString: string;
  flt: String;
begin
//  CheckDataSet;
  if not ValidDataSet or UpdateLocked then
    Exit;
  Inc(FUpdateLock);
  with FDataLink.DataSet do
  begin
    BK := GetBookmark;
    try
      DisableControls;
      if ANode <> nil then
      begin
        ANode.DeleteChildren;
        ParentValue := ANode.FMasterValue;
      end
      else
      begin
        Items.Clear;
        ParentValue := FStartMasterValue;
      end;
      OldFiltered := False;
      OldFilter := '';
      if FUseFilter then
      begin
        if ParentValue = Null then
          PV := 'Null'
        else
//          PV := '''' + Var2Type(ParentValue, varString) + '''';
          PV := Var2Type(ParentValue, varString);
        OldFilter := Filter;
        OldFiltered := Filtered;
        if Filtered and (OldFilter <> '') then
          flt := '(' + OldFilter + ') and '
        else
          flt := '';
        flt := flt + '(' + FDetailField + '=' + PV + ')';
        Filter := flt;
        Filtered := True;
      end;
      try
        First;
        while not Eof do
        begin
          fbnString := FieldByName(FDetailField).AsString; // avoid overhead
          if FUseFilter or
            (((ParentValue = Null) and
            ((fbnString = '') or
            (Copy(Trim(fbnString), 1, 1) = '-'))) or
            (FieldByName(FDetailField).Value = ParentValue)) then
          begin
            with Items.AddChild(ANode, FieldByName(FItemField).Text) as TJvDBTreeNode do
            begin
              FMasterValue := FieldValues[FMasterField];
              if FIconField <> '' then
              begin
                I := Var2Type(FieldValues[FIconField], varInteger);
                ImageIndex := I;
                SelectedIndex := ImageIndex + FSelectedIndex;
              end;
            end;
          end;
          Next;
        end;
      finally
        if FUseFilter then
        begin
          Filtered := OldFiltered;
          Filter := OldFilter;
        end;
      end;
      if ANode = nil then
        begin
          cNode := Items.GetFirstNode;
          while Assigned(cNode) do
            with TJvDBTreeNode(cNode) do
            begin
              HasChildren := Lookup(FDetailField, FMasterValue, FDetailField) <> Null;
              cNode := cNode.GetNext;
            end;
          {
          // Peter Zolja - inefficient code, faster code above
          for I := 0 to Items.Count - 1 do
            with Items[I] as TJvDBTreeNode do
              HasChildren := Lookup(FDetailField, FMasterValue, FDetailField) <> Null
          }
        end
      else
        begin
          cNode := ANode.getFirstChild;
          while Assigned(cNode) do
            with TJvDBTreeNode(cNode) do
            begin
              HasChildren := Lookup(FDetailField, FMasterValue, FDetailField) <> Null;
              cNode := cNode.GetNext;
            end;
          {
          // Peter Zolja - inefficient code, faster code above
          for I := 0 to ANode.Count - 1 do
            with ANode[I] as TJvDBTreeNode do
              HasChildren := Lookup(FDetailField, FMasterValue, FDetailField) <> Null
          }
        end;
      if ANode <> nil then
        OldRecCount := RecordCount;
    finally
      try
        GotoBookmark(BK);
        FreeBookmark(BK);
        EnableControls;
      finally
        Dec(FUpdateLock);
      end;
    end;
  end;
end;

function TJvCustomDBTreeView.CanExpand(Node: TTreeNode): Boolean;
begin
  Result := inherited CanExpand(Node);
  if Result and (Node.Count = 0) then
    RefreshChild(Node as TJvDBTreeNode);
end;

procedure TJvCustomDBTreeView.Collapse(Node: TTreeNode);
var
  HasChildren: Boolean;
begin
  inherited Collapse(Node);
  if not FPersistentNode then
  begin
    HasChildren := Node.HasChildren;
    Node.DeleteChildren;
    Node.HasChildren := HasChildren;
  end;
end;

function TJvCustomDBTreeView.FindNode(AMasterValue: Variant): TJvDBTreeNode;
var
  I: Integer;
begin
  for I := 0 to Items.Count - 1 do
  begin
    Result := Items[I] as TJvDBTreeNode;
    if Result.FMasterValue = AMasterValue then
      Exit;
  end;
  Result := nil;
end;

function TJvCustomDBTreeView.SelectNode(AMasterValue: Variant): TTreeNode;
var
  V: Variant;
  Node: TJvDBTreeNode;
  Parents: Variant; {varArray}
  I: Integer;

  function DoGetDetailValue(const AMasterValue: Variant; var DetailValue: Variant): Boolean;
  var
    V: Variant;
  begin
    if Assigned(FGetDetailValue) then
    begin
      Result := FGetDetailValue(AMasterValue, DetailValue);
      if DetailValue = FStartMasterValue then
        raise EJvDBTreeViewError.CreateRes(@RsEErrorValueForDetailValue);
    end
    else
    begin
      V := FDataLink.DataSet.Lookup(FMasterField, AMasterValue, FMasterField + ';' + FDetailField);
      Result := ((VarType(V) and varArray) = varArray) and (V[1] <> Null);
      if Result then
      begin
        DetailValue := V[1];
        if DetailValue = FStartMasterValue then
          raise EJvDBTreeViewError.CreateRes(@RsEInternalError);
      end;
    end;
  end;

begin
  Result := FindNode(AMasterValue);
  if Result = nil then
  try
     // Inc(FUpdateLock);
    Parents := VarArrayCreate([0, 0], varVariant);
    V := AMasterValue;
    I := 0;
    repeat
      if not DoGetDetailValue(V, V) then
        Exit;
      Node := FindNode(V);
      if Node <> nil then
      begin
        { To open all branches from that found to the necessary [translated] }
        //..
        Node.Expand(False);
        while I > 0 do
        begin
          FindNode(Parents[I]).Expand(False);
          Dec(I);
        end;
        Result := FindNode(AMasterValue);
      end
      else
      begin
        { To add in the array of parents [translated] }
        Inc(I);
        VarArrayRedim(Parents, I);
        Parents[I] := V;
      end;
    until Node <> nil;
  finally
     // Dec(FUpdateLock);
  end;
  if Result <> nil then
    Result.Selected := True;
end;

procedure TJvCustomDBTreeView.UpdateTree;
var
  I: Integer;
  BK: TBookmark;
  AllChecked: Boolean;

  procedure AddRecord;
  var
    Node, ParentNode: TJvDBTreeNode;
    idx: Integer;
  begin
    { If the current record is absent from the tree, but it must be in it, then
      add [translated] }
    Node := FindNode(FDataLink.DataSet[FMasterField]);
    if Node = nil then
    begin
      ParentNode := FindNode(FDataLink.DataSet[FDetailField]);
      if (((ParentNode <> nil) and (not ParentNode.HasChildren or (ParentNode.Count <> 0))) or
        (FDataLink.DataSet[FDetailField] = FStartMasterValue)) then
      begin
        if FDataLink.DataSet[FDetailField] = FStartMasterValue then
          Node := nil
        else
        begin
          Node := FindNode(FDataLink.DataSet[FDetailField]);
          if (Node = nil) or (Node.HasChildren and (Node.Count = 0)) then
            Exit;
        end;
        with FDataLink.DataSet, Items.AddChild(Node, FDataLink.DataSet.FieldByName(FItemField).Text) as TJvDBTreeNode do
        begin
          FMasterValue := FieldValues[FMasterField];
          if FIconField <> '' then
          begin
            idx := Var2Type(FieldValues[FIconField], varInteger);
            ImageIndex := idx;
            SelectedIndex := ImageIndex + FSelectedIndex;
          end;
          HasChildren := Lookup(FDetailField, FMasterValue, FDetailField) <> Null
        end;
      end;
    end;
  end;

begin
  CheckDataSet;
  if UpdateLocked or (InTreeUpdate) then
    Exit;
  InTreeUpdate := True;
  Items.BeginUpdate;
  try
    with FDataLink.DataSet do
    begin
      BK := GetBookmark;
      DisableControls;
      try
        {*** To delete from a tree the remote/removed records [translated] }
        repeat
          AllChecked := True;
          for I := 0 to Items.Count - 1 do
            if not Locate(FMasterField, (Items[I] as TJvDBTreeNode).FMasterValue, []) then
            begin
              Items[I].Free;
              AllChecked := False;
              Break;
            end
            else
              Items[I].HasChildren := Lookup(FDetailField, (Items[I] as TJvDBTreeNode).FMasterValue, FDetailField) <>
                Null;
        until AllChecked;
       {###}
        {*** To add new [translated]}
        First;
        while not Eof do
        begin
          AddRecord;
          Next;
        end;
       {###}
      finally
        GotoBookmark(BK);
        FreeBookmark(BK);
        EnableControls;
      end;
      OldRecCount := RecordCount;
    end;
  finally
    Items.EndUpdate;
    InTreeUpdate := False;
  end;
end;

procedure TJvCustomDBTreeView.InternalDataChanged;
begin
  if not HandleAllocated or UpdateLocked or InDataScrolled then
    Exit;
//  InDataScrolled := True;
  try
    DataChanged;
  finally
//    InDataScrolled := False;
  end;
end;

procedure TJvCustomDBTreeView.DataChanged;
var
  RecCount: Integer;
begin
  case FDataLink.DataSet.State of
    dsBrowse:
      begin
        RecCount := FDataLink.DataSet.RecordCount;
        if (RecCount = -1) or (RecCount <> OldRecCount) then
          UpdateTree;
        OldRecCount := RecCount;
      end;
    dsInsert:
      OldRecCount := -1; { TQuery don't change RecordCount value after insert new record }
  end;
  Selected := FindNode(FDataLink.DataSet[FMasterField]);
end;

procedure TJvCustomDBTreeView.InternalDataScrolled;
begin
  if not HandleAllocated or UpdateLocked then
    Exit;
  InDataScrolled := True;
  try
    DataScrolled;
  finally
    InDataScrolled := False;
  end;
end;

procedure TJvCustomDBTreeView.DataScrolled;
begin
  Selected := FindNode(FDataLink.DataSet[FMasterField]);
end;

procedure TJvCustomDBTreeView.Change(Node: TTreeNode);
var
  OldState: TDataSetState;
begin
  if ValidDataSet and Assigned(Node) and not InDataScrolled and
    (FUpdateLock = 0) and
    (FDataLink.DataSet.State in [dsBrowse, dsEdit, dsInsert]) then
  begin
    OldState := FDataLink.DataSet.State;
    Inc(FUpdateLock);
    try
      Change2(Node);
    finally
      Dec(FUpdateLock);
    end;
    case OldState of
      dsEdit:
        FDataLink.DataSet.Edit;
      dsInsert:
        FDataLink.DataSet.Insert;
    end;
  end;
  inherited Change(Node);
end;

procedure TJvCustomDBTreeView.Change2(Node: TTreeNode);
begin
  if Node <> nil then
  begin
    if VarIsEmpty((Node as TJvDBTreeNode).FMasterValue) then
      Exit;
    FDataLink.DataSet.Locate(FMasterField, TJvDBTreeNode(Node).FMasterValue, []);
    if TJvDBTreeNode(Node).FMasterValue = Null then
      TJvDBTreeNode(Node).SetMasterValue(FDataLink.DataSet.FieldByName(MasterField).AsVariant);
  end;
end;

procedure TJvCustomDBTreeView.InternalRecordChanged(Field: TField);
begin
  if not (HandleAllocated and ValidDataSet) then
    Exit;
  if (Selected <> nil) and (FUpdateLock = 0) and
    (FDataLink.DataSet.State = dsEdit) then
  begin
    Inc(FUpdateLock);
    try
      RecordChanged(Field);
    finally
      Dec(FUpdateLock);
    end;
  end;
end;

procedure TJvCustomDBTreeView.RecordChanged(Field: TField);
var
  Node: TJvDBTreeNode;
  idx: Integer;
begin
  Selected.Text := FDataLink.DataSet.FieldByName(FItemField).Text;
  with Selected as TJvDBTreeNode do
    if FIconField <> '' then
    begin
      idx := Var2Type(FDataLink.DataSet[FIconField], varInteger);
      ImageIndex := idx;
      SelectedIndex := ImageIndex + FSelectedIndex;
    end;
 {*** ParentNode changed ?}
  if ((Selected.Parent <> nil) and
    (FDataLink.DataSet[FDetailField] <> (Selected.Parent as TJvDBTreeNode).FMasterValue)) or
    ((Selected.Parent = nil) and
    (FDataLink.DataSet[FDetailField] <> FStartMasterValue)) then
  begin
    Node := FindNode(FDataLink.DataSet[FDetailField]);
    if (FDataLink.DataSet[FDetailField] = FStartMasterValue) or (Node <> nil) then
      (Selected as TJvDBTreeNode).MoveTo(Node, naAddChild)
    else
      Selected.Free;
  end;
  {###}
  {*** MasterValue changed ?}
  if (FDataLink.DataSet[FMasterField] <> (Selected as TJvDBTreeNode).FMasterValue) then
  begin
    with (Selected as TJvDBTreeNode) do
    begin
      FMasterValue := FDataLink.DataSet[FMasterField];
      if FIconField <> '' then
      begin
        idx := Var2Type(FDataLink.DataSet[FIconField], varInteger);
        ImageIndex := idx;
        SelectedIndex := ImageIndex + FSelectedIndex;
      end;
    end;
    {what have I do with Children ?}
    {if you know, place your code here...}
  end;
  {###}
end;

function TJvCustomDBTreeView.CanEdit(Node: TTreeNode): Boolean;
begin
  Result := inherited CanEdit(Node);
  if FDataLink.DataSet <> nil then
    Result := Result and not FDataLink.ReadOnly and not ReadOnly;
end;

{ wp -- removed
procedure TJvCustomDBTreeView.Edit(const Item: TTVItem);
begin
  CheckDataSet;
  inherited Edit(Item);
  if Assigned(Selected) then
  begin
    Inc(FUpdateLock);
    try
      if Item.pszText <> nil then
      begin
        if FDataLink.Edit then
          FDataLink.DataSet.FieldByName(FItemField).Text := Item.pszText;
        try
          FDataLink.DataSet.Post;
          Change2(Self.Selected); {?}
        except
          on E: Exception do
          begin
            DataLink.DataSet.Cancel;
            if InAddChild then
            begin
              Self.Selected.Free;
              if Sel <> nil then
                Selected := Sel;
            end;
            raise;
          end;
        end;
      end
      else
      begin
        FDataLink.DataSet.Cancel;
        if InAddChild then
        begin
          Self.Selected.Free;
          if Sel <> nil then
            Selected := Sel;
        end;
      end;
    finally
      InAddChild := False;
      Dec(FUpdateLock);
    end;
  end;
end;
}

function TJvCustomDBTreeView.AddChildNode(const Node: TTreeNode; const ASelect: Boolean): TJvDBTreeNode;
var
  MV, MField: Variant;
  M: string;
  iIndex: Integer;
begin
  iIndex := 1;
  CheckDataSet;
  if Assigned(Node) then
  begin
    MV := (Node as TJvDBTreeNode).FMasterValue;
    MField := FDataLink.DataSet.RecordCount + 1;
    repeat
      MField := MField + 1;
    until FDataLink.DataSet.Lookup(FMasterField, MField, FMasterField) = Null;
  end
  else
  begin
    MV := FStartMasterValue;
    MField := FStartMasterValue + 1;
  end;
  if Assigned(Node) and Node.HasChildren and (Node.Count = 0) then
    RefreshChild(Node as TJvDBTreeNode);
  Inc(FUpdateLock);
  InAddChild := True;
  try
    OldRecCount := FDataLink.DataSet.RecordCount + 1;
    if FIconField <> '' then
    begin
      iIndex := Var2Type(FDataLink.DataSet[FIconField], varInteger);
    end;

    FDataLink.DataSet.Append;
    FDataLink.DataSet[FDetailField] := MV;
    FDataLink.DataSet[FMasterField] := MField;
    if FDataLink.DataSet.FieldValues[FItemField] = Null then
      M := ''
    else
      M := FDataLink.DataSet.FieldByName(FItemField).Text;
    Result := Items.AddChild(Node, M) as TJvDBTreeNode;
    with Result do
    begin
      FMasterValue := FDataLink.DataSet.FieldValues[FMasterField];
      if FIconField <> '' then
      begin
        ImageIndex := iIndex;
        SelectedIndex := ImageIndex + FSelectedIndex;
        FDataLink.DataSet[FIconField] := ImageIndex;
      end;
    end;
    Result.Selected := ASelect;
    { This line is very necessary, well it(he) does not understand from the first [translated]}
    Result.Selected := ASelect;
  finally
    Dec(FUpdateLock);
  end;
end;

procedure TJvCustomDBTreeView.DeleteNode(Node: TTreeNode);
var
  NewSel: TTreeNode;
  NewMV: Variant;
  MV: Integer;
begin
  MV := 0;
  CheckDataSet;
  Inc(FUpdateLock);
  InDelete := True;
  try
    NewSel := FindNextNode(Selected);

    if NewSel = nil then
    begin
      NewSel := Items.GetFirstNode;
      if NewSel = Selected then
        NewSel := nil;
    end;

    if NewSel <> nil then
    begin
      NewMV := TJvDBTreeNode(NewSel).FMasterValue;
      MV := NewMV;
    end;

    DeleteChildren(Node);
    // Selected.Free;  // removes selected node, why?

    NewSel := FindNode(MV);
    if NewSel <> nil then
    begin
      NewSel.Selected := True;
      Change2(NewSel);
    end;

  finally
    InDelete := False;
    Dec(FUpdateLock);
  end;
end;

function TJvCustomDBTreeView.DeleteChildren(ParentNode: TTreeNode): Boolean;
var
  ChildNode: TTreeNode;
begin
  CheckDataSet;
  Inc(FUpdateLock);
  InDelete := True;
  try
    with ParentNode as TJvDBTreeNode do
    begin
      while ParentNode.HasChildren do
      begin
        ChildNode := ParentNode.GetNext;
        // (rom) make it compile, but no idea if it is correct
        Self.DeleteChildren(ChildNode);
      end;

      if FDataLink.DataSet.Locate(FMasterField, TJvDBTreeNode(ParentNode).FMasterValue, []) then
      begin
        FDataLink.DataSet.Delete;
      end;
      ParentNode.Delete;
    end;

  finally
    InDelete := False;
    Dec(FUpdateLock);
    Result := true;
  end;
end;

function TJvCustomDBTreeView.FindNextNode(const Node: TTreeNode): TTreeNode;
begin
  if Node <> nil then
  begin
    if Node.Parent <> nil then
      if Node.Parent.Count > 1 then
        if Node.Index = Node.Parent.Count - 1 then
          Result := Node.Parent[Node.Index - 1]
        else
          Result := Node.Parent[Node.Index + 1]
      else
        Result := Node.Parent
    else
      if Items.Count > 1 then
        if Node.Index = Items.Count - 1 then
          Result := Items[Node.Index - 1]
        else
          Result := Items[Node.Index + 1]
      else
        Result := nil;
  end
  else
    Result := nil;
end;

procedure TJvCustomDBTreeView.MoveTo(Source, Destination: TJvDBTreeNode; Mode: TNodeAttachMode);
var
  MV, V: Variant;
begin
  CheckDataSet;
  if FUpdateLock = 0 then
  begin
    Inc(FUpdateLock);
    try
      MV := Source.FMasterValue;
      if FDataLink.DataSet.Locate(FMasterField, MV, []) and FDataLink.Edit then
      begin
        case Mode of
          naAdd:
            if Destination.Parent <> nil then
              V := (Destination.Parent as TJvDBTreeNode).FMasterValue
            else
              V := FStartMasterValue;
          naAddChild:
            V := Destination.FMasterValue;
        else
          raise EJvDBTreeViewError.CreateRes(@RsEMoveToModeError);
        end;
        FDataLink.DataSet[FDetailField] := V;
      end;
    finally
      Dec(FUpdateLock);
    end;
  end;
end;

{******************* Drag'n'Drop ********************}

procedure TJvCustomDBTreeView.TimerDnDTimer(Sender: TObject);
begin
  if YDragPos < DnDScrollArea then
    Perform(WM_VSCROLL, SB_LINEUP, 0)
  else
    if YDragPos > ClientHeight - DnDScrollArea then
      Perform(WM_VSCROLL, SB_LINEDOWN, 0);
end;

procedure TJvCustomDBTreeView.DragOver(Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var
  Node: TTreeNode;
  HT: THitTests;
begin
  inherited DragOver(Source, X, Y, State, Accept);

  if ValidDataSet and (DragMode = dmAutomatic) and not FDataLink.ReadOnly and
     not ReadOnly then
  begin
    HT := GetHitTestInfoAt(X, Y);
    Node := GetNodeAt(X, Y);

    { Mantis #4815: Do not allow drag over if the user callback said no; see TControl.DragOver impl. }
    if not Assigned(OnDragOver) then
      Accept := True;

    Accept := Accept and
      (Source = Self) and Assigned(Selected) and
      (Node <> Selected) and Assigned(Node) and
      not Node.HasAsParent(Selected) and
      (HT - [htOnLabel, htOnItem, htOnIcon, htNowhere, htOnIndent, htOnButton] <> HT);
    YDragPos := Y;
    TimerDnD.Enabled := ((Y < DnDScrollArea) or (Y > ClientHeight - DnDScrollArea));
  end;
end;

procedure TJvCustomDBTreeView.DragDrop(Source: TObject; X, Y: Integer);
var
  AnItem: TTreeNode;
  AttachMode: TNodeAttachMode;
  HT: THitTests;
begin
  TimerDnD.Enabled := False;
  inherited DragDrop(Source, X, Y);
  if Source is TJvCustomDBTreeView then
  begin
    AnItem := GetNodeAt(X, Y);
    if ValidDataSet and (DragMode = dmAutomatic) and Assigned(Selected) and Assigned(AnItem) then
    begin
      HT := GetHitTestInfoAt(X, Y);
      if (HT - [htOnItem, htOnLabel, htOnIcon, htNowhere, htOnIndent, htOnButton] <> HT) then
      begin
        if (HT - [htOnItem, htOnLabel, htOnIcon] <> HT) then
          AttachMode := naAddChild
        else
          AttachMode := naAdd;
        (Selected as TJvDBTreeNode).MoveTo(AnItem, AttachMode);
      end;
    end;
  end;
{
var
  AnItem: TTreeNode;
  AttachMode: TNodeAttachMode;
  HT: THitTests;
begin
  if TreeView1.Selected = nil then
    Exit;
  HT := TreeView1.GetHitTestInfoAt(X, Y);
  AnItem := TreeView1.GetNodeAt(X, Y);
  if (HT - [htOnItem, htOnIcon, htNowhere, htOnIndent] <> HT) then
  begin
    if (htOnItem in HT) or (htOnIcon in HT) then
      AttachMode := naAddChild
    else
    if htNowhere in HT then
      AttachMode := naAdd
    else
    if htOnIndent in HT then
      AttachMode := naInsert;
    TreeView1.Selected.MoveTo(AnItem, AttachMode);
  end;
end;
 }
end;

{################### Drag'n'Drop ####################}

procedure TJvCustomDBTreeView.KeyDown(var Key: Word; Shift: TShiftState);

  procedure DeleteSelected;
  var
    M: string;
  begin
    if Selected.HasChildren then
      M := RsDeleteNode2
    else
      M := RsDeleteNode;
    if MessageDlg(Format(M, [Selected.Text]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
      DeleteNode(Selected);
  end;

begin
  inherited KeyDown(Key, Shift);
  if not ValidDataSet or (FDataLink.ReadOnly) or ReadOnly then
    Exit;
  case Key of
    VK_DELETE:
      if ([ssCtrl] = Shift) and Assigned(Selected) then
        DeleteSelected;
    VK_INSERT:
      if not IsEditing then
      begin
        Sel := Selected;
        if not Assigned(Selected) or ([ssAlt] = Shift) then
          //AddChild
          AddChildNode(Selected, True).EditText
        else
          //Add
          AddChildNode(Selected.Parent, True).EditText;
      end;
    VK_F2:
      if Selected <> nil then
        Selected.EditText;
  end;
end;

{ wp --- removed
procedure TJvCustomDBTreeView.SetMirror(Value: Boolean);
begin
  if Value and SysLocale.MiddleEast and not (csDesigning in ComponentState) then
    MirrorControl(Self, Value);
  FMirror := Value;
end;
}

// Note about the code in CreateWnd/DestroyWnd: When docking/undocking a form
// containing a DBTreeView, or even when showing/hiding such a form, the tree
// is emptied then refilled. But this makes it lose all it's master values
// The initial solution was to close then reopen the dataset, but this is
// ungraceful and was replaced by the code below, proposed in issue 3256.
procedure TJvCustomDBTreeView.CreateWnd;
var
  Node: TTreeNode;
  temp: string;
  strLength: Integer;
  HasChildren: Byte;
begin
  inherited CreateWnd;
  // tree is restored. Now we must restore information about Master Values
  if Assigned(FMastersStream) and (Items.Count > 0) then
  begin
    Node := Items.GetFirstNode;
    FMastersStream.Position := 0;
    while Assigned(Node) do
    begin
      FMastersStream.Read(strLength, SizeOf(strLength));
      SetLength(temp, strLength);
      if strLength > 0 then
        FMastersStream.Read(temp[1], strLength * SizeOf(Char)); // internally used stream
      TJvDBTreeNode(Node).SetMasterValue(temp);
      FMastersStream.Read(HasChildren, SizeOf(HasChildren));
      Node.HasChildren := HasChildren <> 0;
      Node := Node.GetNext;
    end;
    // nil is required, for the destructor not to try to destroy an already
    // destroyed object;
    FreeAndNil(FMastersStream);
  end;
end;

procedure TJvCustomDBTreeView.DestroyWnd;
var
  Node: TTreeNode;
  temp: string;
  strLength: Integer;
  HasChildren: Byte;
begin
  if Items.Count > 0 then
  begin
    // save master values into stream
    FMastersStream := TMemoryStream.Create;
    Node := Items.GetFirstNode;
    while Assigned(Node) do
    begin
      // save MasterValue as string
      temp := VarToStr(TJvDBTreeNode(Node).MasterValue);
      strLength := Length(temp);
      FMastersStream.Write(strLength, SizeOf(strLength));
      if strLength > 0 then
        FMastersStream.Write(temp[1], strLength * SizeOf(Char)); // internally used stream
      HasChildren := Byte(Node.HasChildren);
      FMastersStream.Write(HasChildren, SizeOf(HasChildren));
      Node := Node.GetNext;
    end;
  end;
  inherited DestroyWnd;
end;


end.