jvdbtreeview.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
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

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

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)

Known Issues:
  Some russian comments were translated to english; these comments are marked
  with [translated]
-----------------------------------------------------------------------------}
// $Id: JvDBTreeView.pas,v 1.35 2005/02/17 10:20:21 marquardt Exp $

unit JvDBTreeView;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows,
  {$IFDEF VCL}
  Messages, CommCtrl,
  {$ENDIF VCL}
  Classes, Controls, ExtCtrls, ComCtrls, DB,
  JvComponent;

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

  TJvCustomDBTreeView = class(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;
    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;
    procedure SetMirror(Value: Boolean);
    {**** Drag'n'Drop ****}
    procedure TimerDnDTimer(Sender: TObject);
  protected
    procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
      var Accept: Boolean); 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;
    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 Select: Boolean): TJvDBTreeNode;
    procedure DeleteNode(Node: TTreeNode);
    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;
    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;

  TJvDBTreeView = class(TJvCustomDBTreeView)
  published
    property DataSource;
    property MasterField;
    property DetailField;
    property IconField;
    property ItemField;
    property StartMasterValue;
    property UseFilter;
    property PersistentNode;
    property SelectedIndex;
    property BorderStyle;
    property DragCursor;
    property ShowButtons;
    property ShowLines;
    property ShowRoot;
    property ReadOnly;
    property RightClickSelect;
    property DragMode;
    property HideSelection;
    property Indent;
    property OnEditing;
    property OnEdited;
    property OnExpanding;
    property OnExpanded;
    property OnCollapsing;
    property OnCompare;
    property OnCollapsed;
    property OnChanging;
    property OnChange;
    property OnDeletion;
    property OnGetImageIndex;
    property OnGetSelectedIndex;
    property Align;
    property Enabled;
    property Font;
    property Color;
    property ParentColor default False;
    property SortType;
    property TabOrder;
    property TabStop default True;
    property Visible;
    property OnClick;
    property OnEnter;
    property OnExit;
    property OnDragDrop;
    property OnDragOver;
    property OnStartDrag;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnDblClick;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property PopupMenu;
    property ParentFont;
    property ParentShowHint;
    property ShowHint;
    property Images;
    property StateImages;
    property Anchors;
    property AutoExpand;
    property BiDiMode;
    property BorderWidth;
    property ChangeDelay;
    property Constraints;
    property DragKind;
    property HotTrack;
    property ParentBiDiMode;
    property RowSelect;
    property ToolTips;
    property OnCustomDraw;
    property OnCustomDrawItem;
    property OnEndDock;
    property OnStartDock;
    property Mirror;
  end;

  EJvDBTreeViewError = class(ETreeViewError);

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvDBTreeView.pas,v $';
    Revision: '$Revision: 1.35 $';
    Date: '$Date: 2005/02/17 10:20:21 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  {$IFDEF HAS_UNIT_VARIANTS}
  Variants,
  {$ENDIF HAS_UNIT_VARIANTS}
  SysUtils, Dialogs, 
  JvResources;

// (rom) moved to implementation and removed type
// (rom) never rely on assignable consts
const
  DnDScrollArea = 15;
  DnDInterval = 200;
  DefaultValidMasterFields = [ftSmallInt, ftInteger, ftAutoInc, ftWord, ftString, ftWideString];
  DefaultValidDetailFields = DefaultValidMasterFields;
  DefaultValidItemFields = [ftString, ftWideString, ftMemo, ftSmallInt, ftInteger, ftAutoInc,
    ftWord, ftBoolean, ftFloat, ftCurrency, ftDate, ftTime, ftDateTime];
  DefaultValidIconFields = [ftSmallInt, ftAutoInc, ftInteger, ftWord];

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;

procedure MirrorControl(Control: TWinControl; RightToLeft: Boolean);
{$IFDEF VCL}
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;
{$ENDIF VCL}
{$IFDEF VisualCLX}
begin
  Control.Repaint; // asn: remove?
end;
{$ENDIF VisualCLX}

//=== { 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: TJvDBTreeView;
begin
  TV := (TreeView as TJvDBTreeView);
  PersistNode := TV.FPersistentNode;
  TV.MoveTo(Self as TJvDBTreeNode, Destination as TJvDBTreeNode, Mode);
  TV.FPersistentNode := True;
  if Destination.HasChildren and (Destination.Count = 0) then
    Free
  else
    inherited MoveTo(Destination, Mode);
  TV.FPersistentNode := PersistNode;
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;
end;

destructor TJvCustomDBTreeView.Destroy;
begin
  FDataLink.Free;
  TimerDnD.Free;
  inherited Destroy;
end;

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

procedure TJvCustomDBTreeView.Warning(Msg: string);
begin
  MessageDlg(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;