unit U_SCSInterfPath; interface uses Windows, SysUtils, Controls, Variants, Contnrs, pFIBDataSet, FIBQuery, pFIBQuery, pFIBProps, SQLMemMain, Forms, U_SCSClasses, U_BaseCommon; const cnTSCSInterface = 'TSCSInterface'; type //TSCSInterface = class; TInterfPath = class (TObject) protected FInterf: TObject; //TSCSInterface; FConnPosition: TObject; FCompon: TObject; FPathSide: TInterfPath; // Такой же объект, но с интерфейсом другой стороны FPaths: TObjectList; // Интерфейсы подклюенные к этому участку пути FParentPath: TInterfPath; // Участок пути из которого создан этот FFromPos, FToPos: Integer; // Позиции подключения интерфейсов FComponents: TSCSObjectList; FChildReferences: TObjectList; FAllChildPaths: TObjectList; public property Interf: TObject read FInterf write FInterf; property ConnPosition: TObject read FConnPosition write FConnPosition; property Compon: TObject read FCompon write FCompon; property PathSide: TInterfPath read FPathSide write FPathSide; property Paths: TObjectList read FPaths write FPaths; property ParentPath: TInterfPath read FParentPath write FParentPath; property FromPos: Integer read FFromPos write FFromPos; property ToPos: Integer read FToPos write FToPos; property Components: TSCSObjectList read FComponents write FComponents; property AllChildPaths: TObjectList read FAllChildPaths write FAllChildPaths; property ChildReferences: TObjectList read FChildReferences write FChildReferences; constructor Create(AInterf, AConnPosition: TObject; AFromPos, AToPos: Integer); destructor Destroy; override; procedure AddPath(APath: TInterfPath); function CheckInterfInPaths(AInterf: TObject): Boolean; function CheckComponInPaths(ACompon: TObject): Boolean; function GetPathFromRoot: TObjectList; function GetPathByInterfFromAll(AInterf: TObject; AFromPos: Integer=0; AToPos: Integer=0): TInterfPath; end; implementation uses U_SCSComponent, U_Main, Unit_DM_SCS; { TSCSInterface } { TInterfPath } constructor TInterfPath.Create(AInterf, AConnPosition: TObject; AFromPos, AToPos: Integer); begin FInterf := AInterf; FConnPosition := AConnPosition; FCompon := nil; if FInterf <> nil then FCompon := TSCSInterface(FInterf).ComponentOwner; FPathSide := nil; FPaths := TObjectList.Create(true); FParentPath := nil; FFromPos := AFromPos; FToPos := AToPos; FComponents := nil; FChildReferences := nil; FAllChildPaths := nil; end; destructor TInterfPath.Destroy; begin FreeAndNil(FPaths); if FComponents <> nil then FreeAndNil(FComponents); if FChildReferences <> nil then FreeAndNil(FChildReferences); if FAllChildPaths <> nil then FreeAndNil(FAllChildPaths); inherited; end; procedure TInterfPath.AddPath(APath: TInterfPath); begin APath.ParentPath := Self; Self.Paths.Add(APath); end; function TInterfPath.CheckInterfInPaths(AInterf: TObject): Boolean; var i: integer; CurrInterfPath: TInterfPath; begin Result := false; CurrInterfPath := Self; while CurrInterfPath <> nil do begin if (CurrInterfPath.FInterf = AInterf) or (Assigned(CurrInterfPath.FPathSide) and (CurrInterfPath.FPathSide.FInterf = AInterf)) then begin Result := true; Break; //// BREAK //// end; CurrInterfPath := CurrInterfPath.FParentPath; end; end; function TInterfPath.CheckComponInPaths(ACompon: TObject): Boolean; var i: integer; CurrInterfPath: TInterfPath; begin Result := false; CurrInterfPath := Self; while CurrInterfPath <> nil do begin if CurrInterfPath.FCompon = ACompon then begin Result := true; Break; //// BREAK //// end; CurrInterfPath := CurrInterfPath.FParentPath; end; end; function TInterfPath.GetPathFromRoot: TObjectList; var i: integer; CurrInterfPath: TInterfPath; begin Result := TObjectList.Create(false); CurrInterfPath := Self; while CurrInterfPath <> nil do begin Result.Insert(0, CurrInterfPath); CurrInterfPath := CurrInterfPath.FParentPath; end; end; function TInterfPath.GetPathByInterfFromAll(AInterf: TObject; AFromPos: Integer=0; AToPos: Integer=0): TInterfPath; var i, j: Integer; CanRes: Boolean; Path: TInterfPath; FromPos, ToPos: Integer; LastSize, CurrSize: Integer; LastFromPos: Integer; //FindedInterf: Boolean; //LastDiapasonDelta: Integer; begin Result := nil; if (FAllChildPaths <> nil) and (AInterf <> nil) then begin LastSize := 0; LastFromPos := 0; for i := 0 to FAllChildPaths.Count - 1 do begin Path := TInterfPath(FAllChildPaths[i]); {FindedInterf := Path.FInterf = AInterf; if Not FindedInterf then for j := 0 to Path.FPaths.Count - 1 do begin if TInterfPath(Path.FPaths[j]).FInterf = AInterf then begin FindedInterf := true; end; end;} if (Path.FInterf = AInterf) {or (Path.FInterf = TSCSInterface(AInterf).ParallelInterface)} then begin CanRes := false; if (AFromPos <> 0) and (AToPos <> 0) then begin // Входит ли эта позиция в диапазон AFromPos AToPos GetPosIntersectRange(Path.FromPos, Path.ToPos, AFromPos, AToPos, FromPos, ToPos); if (FromPos <> 0) and (ToPos <> 0) then CanRes := true; end else CanRes := true; if CanRes then begin //CurrSize := Path.ToPos - (Path.FromPos-1); //// Ищем сегмент с большем количеством жил //if (LastSize = 0) or (CurrSize > LastSize) then //begin // Result := Path; // LastSize := CurrSize; //end; // Ищем сегмент с минимальной позицией if (LastFromPos = 0) or (Path.FromPos < LastFromPos) then begin Result := Path; LastFromPos := Path.FromPos; end; //Result := Path; //Break; //// BREAK //// end; end; end; end; end; end.