treeintf.pas

是 delphi6的函数库

    if (Result <> nil) and not Result.InheritsFrom(AMinimumSprigClass) then
      Result := nil;
  end;
end;

procedure RegisterRootSprigType(const AClass: TClass; ASprigClass: TRootSprigClass);
begin
  if InternalRootSprigTypeList = nil then
    InternalRootSprigTypeList := TSprigTypeList.Create;
  InternalRootSprigTypeList.Add(AClass, ASprigClass);
end;

procedure RegisterRootSprigType(const AInterfaces: TGUIDArray; ASprigClass: TRootSprigClass);
begin
  if InternalRootSprigTypeList = nil then
    InternalRootSprigTypeList := TSprigTypeList.Create;
  InternalRootSprigTypeList.Add(AInterfaces, ASprigClass);
end;


function FindBestRootSprigClass(AClass: TClass): TRootSprigClass;
begin
  Result := FindBestRootSprigClass(AClass, TRootSprig);
end;

function FindBestRootSprigClass(AClass: TClass;
  AMinimumSprigClass: TRootSprigClass): TRootSprigClass;
begin
  Result := nil;
  if InternalRootSprigTypeList <> nil then
  begin
    Result := TRootSprigClass(InternalRootSprigTypeList.Match(AClass));
    if (Result <> nil) and not Result.InheritsFrom(AMinimumSprigClass) then
      Result := nil;
  end;
end;

procedure FlushSprigTypes(AGroup: Integer);
begin
  if InternalRootSprigTypeList <> nil then
    InternalRootSprigTypeList.FreeEditorGroup(AGroup);
  if InternalSprigTypeList <> nil then
    InternalSprigTypeList.FreeEditorGroup(AGroup);
end;

{ TInformant }

procedure TInformant.BeforeDestruction;
begin
  FDestroying := True;
  Notification;
  inherited;
end;

procedure TInformant.Changed(AObj: TInformant);
begin
  if AObj.Destroying then
    AObj.Unnotify(Self);
end;

destructor TInformant.Destroy;
begin
  FreeAndNil(FNotifyList);
  inherited;
end;

procedure TInformant.DisableNotify;
begin
  Inc(FDisableNotify);
end;

procedure TInformant.EnableNotify;
begin
  Dec(FDisableNotify);
  if (FDisableNotify = 0) and FNotifyNeeded then
    Notification;
end;

procedure TInformant.Notification;
var
  I: Integer;
begin
  if (FDisableNotify = 0) and (FNotifyList <> nil) then
  begin
    for I := FNotifyList.Count - 1 downto 0 do
      TInformant(FNotifyList[I]).Changed(Self);
    FNotifyNeeded := False;
  end
  else
    FNotifyNeeded := True;
end;

procedure TInformant.Notify(AObj: TInformant);
begin
  if FNotifyList = nil then
    FNotifyList := TList.Create;

  if FNotifyList.IndexOf(AObj) = -1 then
  begin
    FNotifyList.Add(AObj);
    AObj.Notify(Self);
  end;
end;

procedure TInformant.Unnotify(AObj: TInformant);
var
  I: Integer;
begin
  if FNotifyList <> nil then
  begin
    I := FNotifyList.IndexOf(AObj);
    if I <> -1 then
    begin
      FNotifyList.Delete(I);
      AObj.Unnotify(Self);
    end;
    if (FNotifyList <> nil) and
       (FNotifyList.Count = 0) then
      FreeAndNil(FNotifyList);
  end;
end;

{ TSprig }

function TSprig.Add(AItem: TSprig): TSprig;
begin
  // hey is it already in us?
  if (AItem.Parent <> Self) and
     (not AItem.Parents(Self)) then
  begin

    // remove the item from its old parent and clear any tree nodes it may have
    if (AItem.Parent <> nil) and
       (AItem.Parent.FList <> nil) then
    begin
      AItem.ClearTreeNode;
      AItem.Parent.FList.Extract(AItem);
    end;

    // make sure we have a list
    if not Assigned(FList) then
      FList := TObjectList.Create;

    // add it to our list
    FList.Add(AItem);

    // populate its parent
    AItem.FParent := Self;

    // populate the root?
    if AItem.Root = nil then
    begin
      AItem.FRoot := Root;

      // add it to the root's index?
      if Root <> nil then
        Root.AddItem(AItem);
    end;

    // we changed something!
    Root.FRepopulateNeeded := True;

    {AItem.FRoot := Root;
    if (AItem.Root = nil) and
       (Self is TRootSprig) then
      AItem.FRoot := TRootSprig(Self);

    // remove ourselve from the root index
    if AItem.FRoot <> nil then
      AItem.FRoot.FIndex.Add(Self);}
  end;

  // return it
  Result := AItem;
end;

function TSprig.AnyProblems: Boolean;
var
  LProp: PPropInfo;
begin
  Result := False;
  if ParentProperty <> '' then
  begin
    LProp := GetPropInfo(Item, ParentProperty, [tkClass]);
    Result := (LProp = nil) or
              (GetObjectProp(Item, LProp, TPersistent) = nil);
  end;
end;

function TSprig.Caption: string;
begin
  Result := CaptionFor(Name);
  if IncludeIndexInCaption then
    Result := Format('%d - %s', [ItemIndex, Result]); // DO NOT LOCALIZE
end;

procedure TSprig.ClearTreeNode(ARecurse, AFreeNode: Boolean);
var
  I: Integer;
  LNode: TTreeNode;
begin
  EnsureUpdate;

  // first do our children
  if ARecurse then
    for I := Count - 1 downto 0 do
      Items[I].ClearTreeNode(True);

  // now do ourself
  if TreeNode <> nil then
  begin
    LNode := TreeNode;
    FTreeNode := nil;
    LNode.Data := nil;
    if AFreeNode and not (csDestroying in LNode.TreeView.ComponentState) then
      LNode.Delete;
  end;
end;

procedure TSprig.ClearTreeNode;
begin
  ClearTreeNode(True, True);
end;

procedure TSprig.ClearUnneededSprigs;
var
  I: Integer;
begin
  for I := Count - 1 downto 0 do
    with Items[I] do
    begin
      ClearUnneededSprigs;
      if (Transient and (Count = 0)) or
         Invalid then
        Free;
    end;
end;

function TSprig.Count: Integer;
begin
  Result := 0;
  if Assigned(FList) then
    Result := FList.Count;
end;

constructor TSprig.Create(AItem: TPersistent);
const
  CImageIndex: array [Boolean] of TImageIndex = (CFakeSprigImage, CPersistentSprigImage);
begin
  inherited Create;
  FItem := AItem;
  FHiddenTested := Item = nil;
  FHidden := Item = nil;
  ImageIndex := CImageIndex[Item <> nil];
end;

destructor TSprig.Destroy;
begin
  // just in case it hasn't happen already
  Invalidate;

  // we know nothing!
  FItem := nil;

  // remove ourselves from the tree
  ClearTreeNode(False);

  // remove ourselves from the parent
  if (Parent <> nil) and (Parent.FList <> nil) then
    Parent.FList.Extract(Self);
  FParent := nil;

  // wipe out the lists
  if FList <> nil then
  begin
    while FList.Count > 0 do
      FList.Last.Free;
    FreeAndNil(FList);
  end;

  // remove ourselves
  inherited;
end;

function TSprig.DragClass: TClass;
begin
  if Item <> nil then
    Result := Item.ClassType
  else
    Result := ClassType;
end;

function TSprig.DragDrop(AItem: TSprig): Boolean;
begin
  Result := False;
  if Assigned(AItem) then
    Result := AItem.DragDropTo(Self);
end;

function TSprig.DragDropTo(AParent: TSprig): Boolean;
var
  LProp: PPropInfo;
begin
  Result := False;
  if (ParentProperty <> '') and
     (AParent <> Parent) then
  begin
    LProp := GetPropInfo(Item, ParentProperty, [tkClass]);
    if LProp <> nil then
    begin
      if AParent is TRootSprig then
        SetObjectProp(Item, LProp, nil)
      else
        SetObjectProp(Item, LProp, AParent.Item);
      Result := True;
    end;
  end;
end;

function TSprig.DragOver(AItem: TSprig): Boolean;
begin
  Result := False;
  if AItem <> nil then
    Result := AItem.DragOverTo(Self);
end;

function TSprig.DragOverTo(AParent: TSprig): Boolean;
var
  LProp: PPropInfo;
begin
  Result := False;
  if ParentProperty <> '' then
  begin
    LProp := GetPropInfo(Item, ParentProperty, [tkClass]);
    if LProp <> nil then
      Result := (AParent is TRootSprig) or
                (AParent.Item is GetTypeData(LProp^.PropType^)^.ClassType);
  end;
end;

function TSprig.Find(AItem: TPersistent; Recurse: Boolean): TSprig;
begin
  Result := FindItem(AItem, Recurse);
end;

function TSprig.FindItem(AItem: TPersistent; Recurse: Boolean): TSprig;
var
  I: Integer;
  LItem: TSprig;
begin
  Result := nil;
  if AItem <> nil then
    if AItem = Item then
      Result := Self
    else
      for I := 0 to Count - 1 do
      begin
        LItem := Items[I];
        if LItem.Item = AItem then
        begin
          Result := LItem;
          Break;
        end
        else if Recurse then
        begin
          Result := LItem.FindItem(AItem, True);
          if Result <> nil then
            Break;
        end;
      end;
end;

function TSprig.Find(const AName: string; Recurse: Boolean): TSprig;
begin
  Result := FindItemByName(AName, nil, Recurse);
end;

function TSprig.Find(const AName: string; AClass: TClass; Recurse: Boolean): TSprig;
begin
  Result := FindItemByName(AName, AClass, Recurse);
end;

function TSprig.FindItemByName(const AName: string; AClass: TClass; Recurse: Boolean): TSprig;
var
  I: Integer;
  LItem: TSprig;
begin
  Result := nil;
  if AName <> '' then

    // if class is nil then just check name
    if AClass = nil then
    begin
      if AnsiSameText(Name, AName) then
        Result := Self
      else
        for I := 0 to Count - 1 do
        begin
          LItem := Items[I];
          if AnsiSameText(LItem.Name, AName) then
          begin
            Result := LItem;
            Break;
          end
          else if Recurse then
          begin
            Result := LItem.FindItemByName(AName, nil, True);
            if Result <> nil then
              Break;
          end;
        end;
    end

    // use both name and class then
    else
    begin
      if (Item is AClass) and
         AnsiSameText(Name, AName) then
        Result := Self
      else
        for I := 0 to Count - 1 do
        begin
          LItem := Items[I];
          if (LItem.Item is AClass) and
             AnsiSameText(LItem.Name, AName) then
          begin
            Result := LItem;
            Break;
          end
          else if Recurse then
          begin
            Result := LItem.FindItemByName(AName, AClass, True);
            if Result <> nil then
              Break;
          end;
        end;
    end;

end;

function TSprig.FindPath(const APath: string; Recurse: Boolean): TSprig;
begin
  Result := FindItemByPath(APath, Recurse);
end;

function TSprig.FindItemByPath(const APath: string; Recurse: Boolean = True): TSprig;
var
  I: Integer;
  LItem: TSprig;
begin
  Result := nil;
  if APath <> '' then
    if AnsiSameText(Path, APath) then
      Result := Self
    else
      for I := 0 to Count - 1 do
      begin
        LItem := Items[I];
        if AnsiSameText(LItem.Path, APath) then
        begin
          Result := LItem;
          Break;
        end
        else if Recurse then
        begin
          Result := LItem.FindPath(APath, True);
          if Result <> nil then
            Break;
        end;
      end;
end;

procedure TSprig.ForEach(ABefore, AAfter: TSprigAction);
var
  I: Integer;
begin
  if not Invalid then
  begin
    if Assigned(ABefore) then
      ABefore(Self);
    for I := Count - 1 downto 0 do
     Items[I].ForEach(ABefore, AAfter);
    if Assigned(AAfter) then
      AAfter(Self);
  end;
end;

function TSprig.GetItem(Index: Integer): TSprig;
begin
  Result := nil;
  if Assigned(FList) then
    Result := TSprig(FList[Index]);
end;

function TSprig.Hint: string;
begin
  Result := '';
end;

function TSprig.Index: Integer;
begin
  Result := -1;
  if Parent <> nil then
    Result := Parent.IndexOf(Self);
end;

function TSprig.IndexOf(AItem: TSprig): Integer;
begin
  Result := -1;
  if Assigned(FList) then
    Result := FList.IndexOf(AItem);
end;

function TSprig.UniqueName: string;
begin
  Result := '';
  if Item <> nil then