teedbtre.pas

第三方控件：PaintGrid.pas 网格型仪表控件源文件 Mymeter.pas 圆型仪表控件源文件 Project1是这两个控件的使用范例。 该

    property OnChanging;
    property OnClickBackground;
    property OnClickConnection;
    property OnClickShape;
    property OnDblClickConnection;
    property OnDblClickShape;
    property OnDeletingShapes;
    property OnDeletedShapes;
    property OnExpandingCollapsing;
    property OnExpandedCollapsed;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMovingShape;
    property OnMouseEnterShape;
    property OnMouseLeaveShape;
    property OnNewConnection;
    property OnNewShape;
    property OnResizingShape;
    property OnSelectConnection;
    property OnSelectShape;
    property OnScroll;
    property OnShowHint;
    property OnStartEditing;
    property OnStopEditing;
    property OnUnSelectConnection;
    property OnUnSelectShape;
    property OnUndoZoom;
    property OnZoom;

    { TPanel properties }
    property Align;
    property BevelInner;
    property BevelOuter default bvNone;
    property BevelWidth;
    property BorderWidth;
    property BorderStyle default bsSingle;
    property Color default clWhite;
    {$IFNDEF CLX}
    property DragCursor;
    {$ENDIF}
    property DragMode;
    property Enabled;
    property ParentColor;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    {$IFNDEF CLX}
    {$IFDEF D4}
    property UseDockManager default True;
    property DockSite;
    {$ENDIF}
    {$ENDIF}
    {$IFDEF D4}
    property Anchors;
    {$IFNDEF CLX}
    property AutoSize;
    {$ENDIF}
    property Constraints;
    {$IFNDEF CLX}
    property DragKind;
    property Locked;
    {$ENDIF}
    {$ENDIF}

    { TPanel events }
    property OnClick;
    {$IFDEF D5}
    property OnContextPopup;
    {$ENDIF}
    property OnDblClick;
    property OnDragDrop;
    property OnDragDropShape;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;

    {$IFDEF K3}
    property OnMouseEnter;
    property OnMouseLeave;
    {$ELSE}
    {$IFDEF D10}
    property OnMouseEnter;
    property OnMouseLeave;
    {$ENDIF}
    {$ENDIF}

    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDrag;
    {$IFDEF D4}
    {$IFNDEF CLX}
    property OnCanResize;
    {$ENDIF}
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    {$IFNDEF TEEOCX}
    property OnConstrainedResize;
    {$IFNDEF CLX}
    property OnDockDrop;
    property OnDockOver;
    property OnEndDock;
    property OnGetSiteInfo;
    property OnStartDock;
    property OnUnDock;
    {$ENDIF}
    {$ENDIF}
    {$ENDIF}
  end;

implementation

uses
  TreeFlow, TreeConst, TeCanvas;

{ TCustomDBTree }
Constructor TCustomDBTree.Create(AOwner:TComponent);
begin
  inherited;
  FLayout:=TDBTreeLayout.Create(Self,TDBLayout);
  IPreviewRecords:=-1;
end;

// Locate an existing node with same "ACode"
Function TCustomDBTree.FindNodeCode(ACode:Integer):TTreeNodeShape;

   // Recursively search a node with "ACode" in Tag property.
   Function FindNodeCodeRoot(ANode:TTreeNodeShape):TTreeNodeShape;
   var t : Integer;
   begin
     if ANode.Tag=ACode then result:=ANode
     else
     begin
       result:=nil;
       for t:=0 to ANode.Childs.Count-1 do
       begin
         result:=FindNodeCodeRoot(ANode.Childs[t]);
         if Assigned(result) then break;
       end;
     end;
   end;

var t : Integer;
begin
  result:=nil;
  if (ACode>0) and (Roots.Count>0) then
    // Traverse all roots and try to find node:
    for t:=0 to Roots.Count-1 do
    begin
      result:=FindNodeCodeRoot(Roots[t]);
      if Assigned(result) then break;
    end;
end;

// When a DataSet is destroyed, try to find a Layout referencing it.
procedure TCustomDBTree.Notification(AComponent: TComponent;
  Operation: TOperation);
var t : Integer;
begin
  inherited;
  if Operation=opRemove then
    for t:=0 to Layout.Count-1 do
    with Layout[t] do
    begin
      if Assigned(DataSet) and (AComponent=DataSet) then
         FDataSet:=nil
    end;
end;

// Main procedure.
// Traverse all datasets and fill nodes.
Procedure TCustomDBTree.Refresh;

  // Call the DataSet EnableControls or DisableControls when appropiate.
  Procedure DoEnableDisable(DoEnable:Boolean);
  var t : Integer;
  begin
    t:=Layout.Count-1;
    repeat
      if Layout[t].IFields.Count>0 then
      begin
        if DoEnable then Layout[t].DataSet.EnableControls
                    else Layout[t].DataSet.DisableControls;
        break;
      end
      else Dec(t);
    Until t=0;
  end;

Var t          : Integer;
    tt         : Integer;
    OldNoOwner : Boolean;
    tmpCanRun  : Boolean;
begin
  if Layout.Count=0 then exit;
  
  for t:=0 to Layout.Count-1 do Layout[t].Prepare;

  if Layout[0].IFields.Count>0 then
  begin
    { default tree options }
    GlobalFormat.Border.Visible:=False;
    GlobalFormat.Transparent:=True;

    OldNoOwner:=NoOwnerShapes;
    NoOwnerShapes:=True;

    // disable controls for the last layout dataset
    DoEnableDisable(False);
    try
      Self.Clear;
      Layout[0].Run(nil);

      for t:=1 to Layout.Count-1 do
      if Assigned(Layout[t].DataSet) then
      begin
        tmpCanRun:=True;

        for tt:=t-1 downto 0 do
        if (Layout[tt].IFields.Count>0) then
        begin
          Layout[tt].IDetails:={$IFDEF CLR}TObjectList{$ELSE}TList{$ENDIF}.Create;
          try
            Layout[tt].DataSet.GetDetailDataSets(Layout[tt].IDetails);

            if (Layout[tt].IDetails.IndexOf(Layout[t].DataSet)<>-1) then
            begin
              tmpCanRun:=False;
              break;
            end;
          finally
            Layout[tt].IDetails.Free;
          end;
        end;

        if tmpCanRun then
           Layout[t].Run(nil);
      end;

    finally
      NoOwnerShapes:=OldNoOwner;
      DoEnableDisable(True);
      if (csDesigning in ComponentState) and
         (Roots.Count>0) and
         (Roots[0].Count>0) then
            Roots[0].Expanded:=True;
    end;
  end;
end;

// Set the DataSet property.
Procedure TCustomDBTree.CheckDataSet(Var ADataSet:TDataSet; Const Value:TDataSet);
begin
  if ADataSet<>Value then
  begin
    {$IFDEF D5}
    if Assigned(ADataSet) then ADataSet.RemoveFreeNotification(Self);
    {$ENDIF}
    ADataSet:=Value;
    if Assigned(ADataSet) then ADataSet.FreeNotification(Self);
  end;
end;

procedure TCustomDBTree.SetDataSet(const Value: TDataSet);
begin
  if Layout.Count=0 then Layout.Add;
  Layout[0].DataSet:=Value;
end;

procedure TCustomDBTree.SetDetail(const Value: TDataSet);
begin
  if Detail<>Value then
  begin
    CreateDetail;
    Layout[1].DataSet:=Value;
  end;
end;

procedure TCustomDBTree.SetLayout(const Value: TDBTreeLayout);
begin
  FLayout.Assign(Value);
end;

destructor TCustomDBTree.Destroy;
begin
  FLayout.Free;
  inherited;
end;

function TCustomDBTree.GetDataSet: TDataSet;
begin  // return default DataSet
  if FLayout.Count=0 then result:=nil
                     else result:=FLayout[0].FDataSet;
end;

function TCustomDBTree.GetMultiLineText: Boolean;
begin
  if Layout.Count=0 then result:=False
                    else result:=Layout[0].DisplayMode=ldMultiLine;
end;

procedure TCustomDBTree.SetMultiLineText(const Value: Boolean);
begin
  if MultiLineText<>Value then
  begin
    if Layout.Count=0 then Layout.Add;
    if Value then Layout[0].DisplayMode:=ldMultiLine
             else Layout[0].DisplayMode:=ldSingle;
  end;
end;

function TCustomDBTree.GetTextFields: String;
begin
  if Layout.Count=0 then result:=''
                    else result:=Layout[0].Fields;
end;

procedure TCustomDBTree.SetTextFields(const Value: String);
begin
  if TextFields<>Value then
  begin
    if Layout.Count=0 then Layout.Add;
    Layout[0].Fields:=Value;
  end;
end;

function TCustomDBTree.GetCodeField: String;
begin  // compatibility with version 1
  if Layout.Count=0 then result:=''
                    else result:=Layout[0].FCodeField;
end;

function TCustomDBTree.GetDetail: TDataSet;
begin
  if Layout.Count<2 then result:=nil
                    else result:=Layout[1].DataSet
end;

function TCustomDBTree.GetDetailFields: String;
begin
  if Layout.Count<2 then result:=''
                    else result:=Layout[1].FFields
end;

function TCustomDBTree.GetParentField: String;
begin
  if Layout.Count=0 then result:=''
                    else result:=Layout[0].FParentField
end;

procedure TCustomDBTree.SetCodeField(const Value: String);
begin
  if CodeField<>Value then
  begin
    CreateParentLayout;
    Layout[0].FCodeField:=Value;
  end;
end;

Procedure TCustomDBTree.CreateDetail;
begin
  if Layout.Count=0 then Layout.Add;
  if Layout.Count<2 then Layout.Add;
end;

procedure TCustomDBTree.SetDetailFields(const Value: String);
begin
  if DetailFields<>Value then
  begin
    CreateDetail;
    Layout[1].FFields:=Value;
  end;
end;

Procedure TCustomDBTree.CreateParentLayout;
begin
  if Layout.Count=0 then Layout.Add;
end;

procedure TCustomDBTree.SetParentField(const Value: String);
begin