expertcad/SRC/SCSNormBase/U_SCSInterfPath.pas

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.