urtfddiagram.pas

一个UML建模工具

procedure TRtfdDiagram.SetPackage(const Value: TAbstractPackage);
begin
  if Assigned(FPackage) and HasChanged then
    StoreDiagram;
  if Assigned(FPackage) and (FPackage is TUnitPackage) then
    FPackage.RemoveListener(IAfterUnitPackageListener(Self));
  inherited SetPackage(Value);
  if Assigned(FPackage) and (FPackage is TUnitPackage) then
    FPackage.AddListener(IAfterUnitPackageListener(Self));
  if Assigned(Frame.ScrollBox) and (not Config.IsTerminating) then
  begin
    Frame.ScrollBox.HorzScrollBar.Position := 0;
    Frame.ScrollBox.VertScrollBar.Position := 0;
  end;
end;


procedure TRtfdDiagram.UnitPackageAfterAddChild(Sender, NewChild: TModelEntity);
begin
  ErrorHandler.Trace(Format('%s : %s : %s', ['UnitPackageAfterAddChild', ClassName, Sender.Name]));
  if (NewChild is TClass) or (NewChild is TInterface) then
  begin
    AddBox(NewChild);
    ResolveAssociations;
  end;
end;

procedure TRtfdDiagram.UnitPackageAfterChange(Sender: TModelEntity);
begin
  ErrorHandler.Trace(Format('%s : %s : %s', ['UnitPackageAfterChange', ClassName, Sender.Name]));
end;

procedure TRtfdDiagram.UnitPackageAfterEntityChange(Sender: TModelEntity);
begin
  ErrorHandler.Trace(Format('%s : %s : %s', ['UnitPackageAfterEntityChange', ClassName, Sender.Name]));
end;

procedure TRtfdDiagram.UnitPackageAfterRemove(Sender: TModelEntity);
begin
  ErrorHandler.Trace(Format('%s : %s : %s', ['UnitPackageAfterRemove', ClassName, Sender.Name]));
end;

procedure TRtfdDiagram.OpenSelectedPackage;
var
  C: TControl;
begin
  //Anropas av frame action
  C := Panel.GetFirstSelected;
  if Assigned(C) and (C is TRtfdUnitPackage) then
  begin
    Package := (C as TRtfdUnitPackage).P;
    InitFromModel;
    CurrentEntity := Package;
  end;
end;


function TRtfdDiagram.HasChanged: boolean;
begin
  Result := FHasChanged or Panel.IsModified;
end;

procedure TRtfdDiagram.StoreDiagram;
var
  Ini : TCustomIniFile;
  I,OldMode : integer;
  Box : TRtfdBox;
  S : string;
  DoSave : boolean;
begin
  DoSave:=False;
  case Config.DiSave of
    dsAsk : DoSave := MessageDlg('Save changed layout?',mtConfirmation, [mbYes,mbNo] , 0)=mrYes;
    dsNever : ;
    dsAlways : DoSave := True;
  end;
  if DoSave then
  begin
    Ini := GetStorage(True);
    if Assigned(Ini) then
      try
        //Boxes
        for I := 0 to BoxNames.Count - 1 do
        begin
          Box := BoxNames.Objects[I] as TRtfdBox;
          S := 'Box: ' + Package.FullName + ' - ' + Box.Entity.FullName;
          Ini.EraseSection(S);
          Ini.WriteInteger(S,'X', Box.Left);
          Ini.WriteInteger(S,'Y', Box.Top);
          if not Box.Visible then
            Ini.WriteBool(S,'Visible', Box.Visible);
          //Ini.WriteInteger(S,'W', Box.Width);
          //Ini.WriteInteger(S,'H', Box.Height);
        end;

        //Diagram stuff
        S := 'Diagram: ' + Package.FullName;
        Ini.EraseSection(S);
        Ini.WriteInteger(S,'OffsetX',Frame.ScrollBox.VertScrollBar.Position);
        Ini.WriteInteger(S,'OffsetY',Frame.ScrollBox.HorzScrollBar.Position);
        Ini.WriteInteger(S,'Visibility', Integer(VisibilityFilter)  );
        Ini.WriteBool(S,'ShowAssoc', ShowAssoc);

        //Commit
        {$IFDEF Win32}
        OldMode:=SetErrorMode(SEM_FAILCRITICALERRORS);
        {$ENDIF}
        try
          try
            Ini.UpdateFile;
          except
            ErrorHandler.Trace('Could not write layout to disk');
          end;
        finally
          {$IFDEF Win32}
          SetErrorMode(OldMode);
          {$ENDIF}
        end;

      finally
        Ini.Free;
      end;
  end;
end;

function TRtfdDiagram.FetchDiagram : integer;
var
  Ini : TCustomIniFile;
  I,NextX,NextY : integer;
  Box : TRtfdBox;
  S : string;
begin
  Result := 0;
  NextX := 50;
  NextY := 50;
  Ini := GetStorage(False);
  if Assigned(Ini) then
    try
      //Boxar
      for I := 0 to BoxNames.Count - 1 do
      begin
        Box := BoxNames.Objects[I] as TRtfdBox;
        S := 'Box: ' + Package.FullName + ' - ' + Box.Entity.FullName;
        if Ini.SectionExists(S) then
        begin
          Inc(Result);
          Box.Left := Ini.ReadInteger(S,'X',Box.Left);
          Box.Top := Ini.ReadInteger(S,'Y',Box.Top);
          Box.Visible := Ini.ReadBool(S,'Visible', True);
          if (not Box.Visible) and (not FHasHidden) then
            FHasHidden := True;
        end
        else
        begin
          //Boxes not in file will get a default postion in upper left corner
          Box.BoundsRect := Rect(NextX, NextY, NextX + Box.Width, NextY + Box.Height);
          Inc(NextX,25);
          Inc(NextY,25);
        end;
      end;

      //Diagram stuff
      S := 'Diagram: ' + Package.FullName;
      if Ini.SectionExists(S) then
      begin
        Frame.ScrollBox.VertScrollBar.Position := Ini.ReadInteger(S,'OffsetX',Frame.ScrollBox.VertScrollBar.Position);
        Frame.ScrollBox.HorzScrollBar.Position := Ini.ReadInteger(S,'OffsetY',Frame.ScrollBox.HorzScrollBar.Position);;
        VisibilityFilter := TVisibility(Ini.ReadInteger(S,'Visibility', Integer( Low(TVisibility) ) ));
        ShowAssoc := Ini.ReadBool(S,'ShowAssoc', ShowAssoc);
      end;

    finally
      Ini.Free;
    end;
end;


procedure TRtfdDiagram.DoLayout;
var
  Layout : TEssLayout;
begin
  if BoxNames.Count>0 then
  begin
    Panel.Hide;
    Layout := TEssLayout.CreateLayout( Panel );
    try
      Layout.Execute;
    finally
      Panel.Show;
      Layout.Free
    end;
    Panel.IsModified := True;
    Panel.RecalcSize;
    Panel.Refresh;
  end;
end;


function TRtfdDiagram.GetBox(const S: string): TRtfdBox;
var
  I : integer;
begin
  I := BoxNames.IndexOf( S );
  if I=-1 then
    Result := nil
  else
    Result := BoxNames.Objects[I] as TRtfdBox;
end;



procedure TRtfdDiagram.SetVisibilityFilter(const Value: TVisibility);
var
  I : integer;
begin
  if Value<>VisibilityFilter then
  begin
    Panel.Hide;
    for I := 0 to BoxNames.Count - 1 do
      (BoxNames.Objects[I] as TRtfdBox).MinVisibility := Value;
    Panel.RecalcSize;
    Panel.Show;
    FHasChanged := True;
    inherited;
  end;
end;


procedure TRtfdDiagram.GetDiagramSize(var W, H: integer);
begin
  W := Panel.Width;
  H := Panel.Height;
end;

//Returns list with str = 'x1,y1,x2,y2', obj = modelentity
function TRtfdDiagram.GetClickAreas: TStringList;
var
  I : integer;
  Box : TRtfdBox;
  S : string;
begin
  Result := TStringList.Create;
  for I := 0 to BoxNames.Count-1 do
  begin
    Box := BoxNames.Objects[I] as TRtfdBox;
    S := IntToStr(Box.Left) + ',' + IntToStr(Box.Top) + ',' +
      IntToStr(Box.Left + Box.Width) + ',' + IntToStr(Box.Top + Box.Height);
    Result.AddObject(S,Box.Entity);
  end;
end;


procedure TRtfdDiagram.HideSelectedDiagramElements;
var
  C: TControl;
  L : TObjectList;
  I : integer;
begin
  //Called from frame action
  L := Panel.GetSelectedControls;
  try
    if L.Count>0 then
    begin
      for I := 0 to L.Count-1 do
      begin
        C := L[I] as TControl;
        if (C is TRtfdBox) and Assigned(GetBox( (C as TRtfdBox).Entity.FullName )) then
        begin
          C.Visible := False;
          FHasHidden := True;
          FHasChanged := True;
        end;
      end;
      Panel.ClearSelection;
      Panel.RecalcSize;
      Panel.Refresh;
    end;
  finally
    L.Free;
  end;
end;

function TRtfdDiagram.HasHiddenElements: boolean;
begin
  Result := FHasHidden;
end;

procedure TRtfdDiagram.UnHideAllElements;
var
  I : integer;
  Box : TRtfdBox;
begin
  for I := 0 to BoxNames.Count - 1 do
  begin
    Box := BoxNames.Objects[I] as TRtfdBox;
    if not Box.Visible then
      Box.Visible := True;
  end;
  Panel.RecalcSize;
  Panel.Refresh;
  FHasHidden := False;
  FHasChanged := True;
end;

procedure TRtfdDiagram.DrawZoom(Canvas: TCanvas; W,H : integer);
var
  I,ZoomW,ZoomH : integer;
  Box : TRtfdBox;
  ScaleX,ScaleY,Scale : double;
  R : TRect;
begin
  if Panel.Width=0 then
    Exit;
  ScaleX := W / Panel.Width;
  ScaleY := H / Panel.Height;
  Scale := Min(ScaleX,ScaleY);
  //Clear whole area
  Canvas.Brush.Color := clBtnFace;
  Canvas.FillRect( Rect(0,0,W,H) );
  //Fill area for zoomcanvas
  Canvas.Brush.Color := clWhite;
  Canvas.Pen.Color := clBlack;
  ZoomW := Round(Panel.Width * Scale);
  ZoomH := Round(Panel.Height * Scale);
  Canvas.Rectangle( Rect(0,0, ZoomW,ZoomH ) );
  if not Config.IsLimitedColors then
    Canvas.Brush.Color := $EAF4F8
  else
    Canvas.Brush.Color := clWhite;
  //Draw boxes
  for I := 0 to BoxNames.Count-1 do
  begin
    Box := TRtfdBox(BoxNames.Objects[I]);
    if not Box.Visible then
      Continue;
    R := Box.BoundsRect;
    R.Left := Round(R.Left * Scale);
    R.Top := Round(R.Top * Scale);
    R.Right := Round(R.Right * Scale);
    R.Bottom := Round(R.Bottom * Scale);
    Canvas.Rectangle(R);
  end;
  //Draw zoomfocus-box
  ZoomFocusW := Round(Frame.ScrollBox.Width * Scale);
  ZoomFocusH := Round(Frame.ScrollBox.Height * Scale);
  R.Left := Round(Frame.ScrollBox.HorzScrollBar.Position * Scale);
  R.Top := Round(Frame.ScrollBox.VertScrollBar.Position * Scale);
  R.Right := R.Left + ZoomFocusW;
  R.Bottom := R.Top + ZoomFocusH;
  if not ((R.Left=0) and (R.Right>=ZoomW) and (R.Top=0) and (R.Bottom>=ZoomH)) then
  begin
    Canvas.Pen.Mode := pmXor;
    Canvas.Rectangle(R);
    Canvas.Pen.Mode := pmCopy;
  end;
end;


procedure TRtfdDiagram.SetZoomedScroll(ScrollX, ScrollY, W, H: integer);
var
  ScaleX,ScaleY,Scale : double;
begin
  ScaleX := Panel.Width / W;
  ScaleY := Panel.Height / H ;
  Scale := Max(ScaleX,ScaleY);

  //Modify coords to put mousearrow in center of zoomfocus-box
  Dec(ScrollX,ZoomFocusW div 2);
  Dec(ScrollY,ZoomFocusH div 2);

  Frame.ScrollBox.HorzScrollBar.Position := Min(Frame.ScrollBox.HorzScrollBar.Range-Frame.ScrollBox.Width,Round(ScrollX * Scale));
  Frame.ScrollBox.VertScrollBar.Position := Min(Frame.ScrollBox.VertScrollBar.Range-Frame.ScrollBox.Height,Round(ScrollY * Scale));
end;

procedure TRtfdDiagram.OnNeedZoomUpdate(Sender: TObject);
begin
  DoOnUpdateZoom;
end;

procedure TRtfdDiagram.CurrentEntityChanged;
var
  P : TModelEntity;
begin
  inherited;

  P := CurrentEntity;
  while Assigned(P) and (not (P is TAbstractPackage)) do
    P := P.Owner;

  if Assigned(P) and (P<>Package) then
  begin
    Package := P as TAbstractPackage;
    InitFromModel
  end;

  if (CurrentEntity is TClass) or (CurrentEntity is TInterface) then
    ScreenCenterEntity(CurrentEntity);
end;

function TRtfdDiagram.GetSelectedRect: TRect;
var
  C: TControl;
  L : TObjectList;
  I : integer;
  R : TRect;
begin
  L := Panel.GetSelectedControls;
  if L.Count=0 then
    Result := Rect(0,0,0,0)
  else
  begin
    Result := Rect(MaxInt,MaxInt,0,0);
    for I := 0 to L.Count-1 do
    begin
      C := TControl(L[I]);
      R := C.BoundsRect;
      if R.Top<Result.Top then
        Result.Top := R.Top;
      if R.Left<Result.Left then
        Result.Left := R.Left;
      if R.Bottom>Result.Bottom then
        Result.Bottom := R.Bottom;
      if R.Right>Result.Right then
        Result.Right := R.Right;
    end;
  end;
  L.Free;
end;


procedure TRtfdDiagram.ScreenCenterEntity(E: TModelEntity);
var
  I : integer;
  Box : TRtfdBox;
begin
  for I := 0 to BoxNames.Count-1 do
    if TRtfdBox(BoxNames.Objects[I]).Entity=E then
    begin
      Box := TRtfdBox(BoxNames.Objects[I]);
      Frame.ScrollBox.ScrollInView(Box);
      Break;
    end;
end;

procedure TRtfdDiagram.SetShowAssoc(const Value: boolean);
begin
  if Value<>ShowAssoc then
    FHasChanged := True;
  inherited;
end;

end.