treeintf.pas

是 delphi6的函数库

  end;
end;

procedure TSprig.AddType(Index: Integer);
begin
  //
end;

function TSprig.AddTypeCount: Integer;
begin
  Result := 0;
end;

function TSprig.CanAdd: Boolean;
begin
  Result := AddTypeCount > 0;
end;

function TSprig.GetAddType(Index: Integer): string;
begin
  Result := '';
end;

function TSprig.Owner: TSprig;
begin
  Result := nil;
end;

function TSprig.CopyGlyph(ABitmap: TBitmap): Boolean;
begin
  Result := Assigned(CopySprigGlyphFunc) and
            CopySprigGlyphFunc(Self, ABitmap);
end;

{ TRootSprig }

procedure TRootSprig.AddItem(ASprig: TSprig);
begin
  if ASprig.Item <> nil then
    FIndex.Add(ASprig);
end;

function TRootSprig.DeleteStyle: TSprigDeleteStyle;
begin
  Result := dsAbort;
end;

procedure TRootSprig.SelectionSurvey(out ADeleteStyle: TSprigDeleteStyle; out AAllVisible: Boolean);
var
  I: Integer;
  LSprig: TSprig;
  LAbort, LAllCustom, LAllNormal: Boolean;
begin
  AAllVisible := True;
  LAbort := False;
  LAllCustom := True;
  LAllNormal := True;
  for I := 0 to TreeView.SelectionCount - 1 do
  begin
    LSprig := TSprig(TreeView.Selections[I].Data);
    if LSprig <> nil then
    begin

      // calculate if all are visible?
      AAllVisible := AAllVisible and not LSprig.Hidden;

      // calculate delete style
      case LSprig.DeleteStyle of
        dsNormal:
          LAllCustom := False;
        dsIgnore:;
        dsAbort:
          LAbort := True;
        dsCustom:
          LAllNormal := False;
      end;
    end;
  end;

  ADeleteStyle := dsAbort;
  if not LAbort then
    if LAllNormal then
      ADeleteStyle := dsNormal
    else if LAllCustom then
      ADeleteStyle := dsCustom;
end;

function TRootSprig.EditAction(Action: TEditAction): Boolean;

  function DoCustomDelete(out ASprig: TSprig): Boolean;
  var
    I: Integer;
    LSprig: TSprig;
  begin
    Result := False;
    ASprig := nil;
    for I := 0 to TreeView.SelectionCount - 1 do
    begin
      LSprig := TSprig(TreeView.Selections[I].Data);
      if LSprig <> nil then
      begin
        Result := LSprig.CustomDelete or Result;
        if not LSprig.Invalid then
          ASprig := LSprig;
      end;
    end;
  end;

var
  LEditQuery: IDesignEditQuery;
  LDeleteStyle: TSprigDeleteStyle;
  LAllVisible: Boolean;
  LSprig: TSprig;
begin
  Result := False;
  if Supports(Designer, IDesignEditQuery, LEditQuery) then
  begin

    // one we care about?
    if Action in [eaDelete, eaCut, eaCopy] then
    begin
      SelectionSurvey(LDeleteStyle, LAllVisible);

      // delete
      if Action = eaDelete then
        case LDeleteStyle of
          dsNormal:
            begin
              Designer.DeleteSelection(True);
              Result := True;
            end;
          dsCustom:
            begin
              Result := DoCustomDelete(LSprig);
              if Result then
                if (LSprig <> nil) and
                   (LSprig.Item <> nil) then
                  SelectItems([LSprig.Item], True)
                else
                  RuntimeChange;
            end;
        else
          Result := False;
        end

      // cut/copy
      else if (LDeleteStyle = dsNormal) and LAllVisible then
        Result := LEditQuery.EditAction(Action);
    end
    else
      Result := LEditQuery.EditAction(Action);
  end;
end;

function TRootSprig.GetEditState: TEditState;
var
  LEditQuery: IDesignEditQuery;
  LDeleteStyle: TSprigDeleteStyle;
  LAllVisible: Boolean;
begin
  Result := [];
  if Supports(Designer, IDesignEditQuery, LEditQuery) then
  begin
    Result := LEditQuery.GetEditState;

    Result := Result - [esCanZOrder, esCanAlignGrid, esCanEditOle,
                        esCanTabOrder, esCanCreationOrder, esCanCreateTemplate];

    SelectionSurvey(LDeleteStyle, LAllVisible);
    if LDeleteStyle = dsAbort then
      Result := Result - [esCanDelete];
    if not LAllVisible then
      Result := Result - [esCanCopy, esCanCut, esCanPaste];
  end;
end;

function TRootSprig.SelectedSprig(var ASprig: TSprig): Boolean;
begin
  Result := (TreeView <> nil) and
            (TreeView.SelectionCount = 1) and
            (TreeView.Selections[0].Data <> Self);
  if Result then
    ASprig := TSprig(TreeView.Selections[0].Data);
end;

function TRootSprig.CanMove(AUp: Boolean): Boolean;
var
  LSprig: TSprig;
begin
  Result := SelectedSprig(LSprig) and
            LSprig.CanMove(AUp);
end;

function TRootSprig.Move(AUp: Boolean): Boolean;
var
  LSprig: TSprig;
begin
  Result := SelectedSprig(LSprig) and
            LSprig.Move(AUp);
end;

procedure TRootSprig.AddType(Index: Integer);
var
  LSprig: TSprig;
begin
  if SelectedSprig(LSprig) then
    LSprig.AddType(Index);
end;

function TRootSprig.AddTypeCount: Integer;
var
  LSprig: TSprig;
begin
  Result := 0;
  if SelectedSprig(LSprig) then
    Result := LSprig.AddTypeCount;
end;

function TRootSprig.GetAddType(Index: Integer): String;
var
  LSprig: TSprig;
begin
  Result := '';
  if SelectedSprig(LSprig) then
    Result := LSprig.GetAddType(Index);
end;

function TRootSprig.CanAdd: Boolean;
var
  LSprig: TSprig;
begin
  Result := SelectedSprig(LSprig) and
            LSprig.CanAdd;
end;

constructor TRootSprig.Create(AItem: TPersistent);
begin
  inherited;
  FRoot := Self;
  FIndex := TSprigIndex.Create;
  FNamedItems := TList.Create;
  FPathedItems := TList.Create;
  FRepopulateNeeded := True;
end;

procedure TRootSprig.DesigntimeChange;
{var
  LDesigner: IDesigner;}
begin
{  if GetDesigner(LDesigner) then
    LDesigner.Modified;}
    //!!
end;

destructor TRootSprig.Destroy;
begin
  SprigDesigner := nil;
  inherited;
  FreeAndNil(FIndex);
  FreeAndNil(FNamedItems);
  FreeAndNil(FPathedItems);
end;

procedure TRootSprig.FigureParent;
begin
  // we do nothing
end;

function TRootSprig.FindItem(AItem: TPersistent; Recurse: Boolean): TSprig;
begin
  if AItem = Item then
    Result := Self
  else if not Recurse then
    Result := inherited FindItem(AItem, False)
  else
    Result := FIndex.Find(AItem);
end;

function TRootSprig.FindItemByName(const AName: string; AClass: TClass;
  Recurse: Boolean): TSprig;
  function MatchingItem(ASprig: TSprig): Boolean;
  begin
    Result := AnsiSameText(ASprig.Name, AName) and
              ((AClass = nil) or
               (ASprig.Item is AClass));
  end;
var
  I: Integer;
begin
  if MatchingItem(Self) then
    Result := Self
  else
  begin
    Result := nil;
    for I := 0 to FNamedItems.Count - 1 do
      if MatchingItem(TSprig(FNamedItems[I])) then
      begin
        Result := TSprig(FNamedItems[I]);
        Break;
      end;
    if Result = nil then
    begin
      Result := inherited FindItemByName(AName, AClass, Recurse);
      if Result <> nil then
        FNamedItems.Add(Result);
    end;
  end;
end;

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

procedure TRootSprig.SelectItems(const AItems: array of TPersistent; ARuntimeChange: Boolean);
var
  LDesigner: IDesigner;
  LSelections: IDesignerSelections;
  I: Integer;
begin
  if GetDesigner(LDesigner) then
  begin
    if ARuntimeChange then
      LDesigner.Modified;
    LSelections := CreateSelectionlist;
    for I := Low(AItems) to High(AItems) do
      LSelections.Add(AItems[I]);
    LDesigner.SetSelections(LSelections);
  end;
end;

function TRootSprig.PaletteOver(ASprigClass: TSprigClass; AClass: TClass): Boolean;
begin
  Result := True;
end;

procedure TRootSprig.RemoveItem(ASprig: TSprig);
begin
  if ASprig.Item <> nil then
    FIndex.Remove(ASprig);
  FNamedItems.Remove(ASprig);
  FPathedItems.Remove(ASprig);
end;

procedure TRootSprig.ValidateParent(AItem: TSprig);
var
  LParent: TSprig;
begin
  if not AItem.Invalid then
  begin

    // figure out the parent
    LParent := AItem.Parent;
    AItem.FigureParent;
    FParentChanges := FParentChanges or (LParent <> AItem.Parent);

    // figure out the children
    AItem.FigureChildren;
  end;
end;

function TRootSprig.Repopulate: Boolean;
var
  LToDo: TList;

  procedure ValidateSprigs(ASprig: TSprig);
  var
    I: Integer;
  begin
    // only if the sprig is valid
    if not ASprig.Invalid then
    begin
      // expando?
      StoreExpandState(ASprig);

      // remove it from the todo list?
      if ASprig.Item <> nil then
        LToDo.Remove(ASprig.Item);
    end;

    // now validate the children
    for I := ASprig.Count - 1 downto 0 do
      ValidateSprigs(ASprig[I]);

    // now the sprig itself
    if ASprig.Invalid then
      ASprig.Free;
  end;

  procedure RemoveInvalidSprigs(ASprig: TSprig);
  var
    I: Integer;
  begin
    for I := ASprig.Count - 1 downto 0 do
      RemoveInvalidSprigs(ASprig);
    if ASprig.Invalid then
      ASprig.Free;
  end;
var
  I: Integer;
  LSprigClass: TSprigClass;
  LSprig: TSprig;
  LItem: TComponent;
begin
  // assume no additions
  Result := False;
  if FRepopulateNeeded then
  begin
    BeginUpdate;
    FRepopulating := True;
    LToDo := TList.Create;
    try

      // For each component, add to the ToDo list
      with TComponent(Item) do
        for I := 0 to ComponentCount - 1 do
        begin
          LItem := Components[I];
          if not (csTransient in LItem.ComponentStyle) and
             (csDesigning in LItem.ComponentState) and
             not (csDestroying in LItem.ComponentState) then
            LToDo.Add(Components[I]);
        end;

      // clear the invalid items
      ValidateSprigs(Self);

      // For each item in the ToDo list
      for I := 0 to LToDo.Count - 1 do
      begin

        // Find best sprig class
        LSprigClass := FindBestSprigClass(TComponent(LToDo[I]).ClassType, TComponentSprig);

        // Create the sprig at the root
        if LSprigClass <> nil then
        begin
          LSprig := LSprigClass.Create(TComponent(LToDo[I]));
          TComponentSprig(LSprig).FOwner := Self;

          // made some additions
          Add(LSprig);
          Result := True;
        end;
      end;

      // For each sprig until there are no more parent changes
      repeat
        FParentChanges := False;
        ForEach(ValidateParent);
      until not FParentChanges;

      // prune the tree of sprigs (transient or any remaining invalid ones
      ClearUnneededSprigs;

      // make sure we are expanded
      FExpanded := True;

    finally
      // clean up
      LToDo.Free;
      FRepopulateNeeded := False;
      FRepopulating := False;
      EndUpdate;
    end;
  end;
end;

procedure TRootSprig.RuntimeChange;
var
  LDesigner: IDesigner;
begin
  if GetDesigner(LDesigner) then
    LDesigner.Modified;
end;

procedure TRootSprig.PreRefreshTreeView(AItem: TSprig);
begin
  with AItem do
  begin
    TreeNodeFor(TreeView);
    VisualRefresh;
  end;
end;

procedure TRootSprig.PostRefreshTreeView(AItem: TSprig);
begin
  with AItem do
  begin
    SortItems;
    RestoreExpandState(AItem);
  end;
end;

procedure TRootSprig.RestoreExpandState(AItem: TSprig);
{var
  I: Integer;}