essconnectpanel.pas

ESS-Model is a powerful, reverse engine, UML-tool for Delphi/Kylix and Java-files.

{
  ESS-Model
  Copyright (C) 2002  Eldean AB, Peter S鰀erman, Ville Krumlinde

  This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU General Public License
  as published by the Free Software Foundation; either version 2
  of the License, or (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
}

unit essConnectPanel;

interface

uses
{$ifdef WIN32}
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls,Contnrs;
{$endif}
{$ifdef LINUX}
  Types, SysUtils, Classes, QGraphics, QControls, QForms, QDialogs,
  QExtCtrls,Contnrs;
{$endif}

type
  // Available linestyles
  TessConnectionStyle = (csThin, csNormal, csThinDash);
  //Different kinds of arrowheads
  TessConnectionArrowStyle = (asEmptyOpen,asEmptyClosed);

  {
    Specifies a connection between two managed objects.
  }
  TConnection = class
  public
    FFrom, FTo: TControl;
    FConnectStyle: TessConnectionStyle;
    ArrowStyle : TessConnectionArrowStyle;
  end;


  {
    Wrapper around a control managed by essConnectPanel
  }
  TManagedObject = class
  private
    FSelected: Boolean;
    procedure SetSelected(const Value: Boolean);
  private
    FControl: TControl;
    // Old eventhandlers
    FOnMouseDown :TMouseEvent;
    FOnMouseMove :TMouseMoveEvent;
    FOnMouseUp :TMouseEvent;
    FOnClick :TNotifyEvent;
    FOnDblClick :TNotifyEvent;
    property Selected: Boolean read FSelected write SetSelected;
  public
    destructor Destroy; override;
  end;

  {
    Component that manages a list of contained controls that can be connected with
    somekind of line and allows the user to move it around and gives the containd
    control grabhandles when selected.

    Further it manages the layout of the contained controls.
  }
  TessConnectPanel = class(TCustomPanel)
  private
    FIsModified, FIsMoving, FIsRectSelecting, FSelectedOnly: Boolean;
    FMemMousePos: TPoint;
    FSelectRect: TRect;
    FBackBitmap: TBitmap;
    TempHidden : TObjectList;
    procedure SetSelectedOnly(const Value : boolean);
  protected
    { Protected declarations }
    FManagedObjects: TList;
    FConnections: TObjectList;

{$ifdef WIN32}
    procedure CreateParams(var Params: TCreateParams); override;
{$endif}

    procedure Click; override;
    procedure DblClick; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

{$ifdef WIN32}
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
{$endif}
{$ifdef LINUX}
    procedure MouseEnter(AControl: TControl); override;
    procedure MouseLeave(AControl: TControl); override;
{$endif}
    function FindManagedControl( AControl: TControl ): TManagedObject;
    procedure SelectObjectsInRect(SelRect: TRect);

    procedure OnManagedObjectMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure OnManagedObjectMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure OnManagedObjectMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure OnManagedObjectClick(Sender: TObject);
    procedure OnManagedObjectDblClick(Sender: TObject);

    procedure Paint; override;
  public
    OnContentChanged : TNotifyEvent;
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    // Add a control to the managed list
    function AddManagedObject(AObject: TControl): TControl;
    // Return the first of the selected controls if any.
    function GetFirstSelected : TControl;

    // Returns a objectlist containing the selected controls.
    // The list should be freed by the caller.
    function GetSelectedControls : TObjectList;


    // Returns a list containing all the managed controls.
    // The list should be freed by the caller.
    function GetManagedObjects: TList;


    // Returns a list with all interobject connections.
    // The list should be freed by the caller.
    function GetConnections : TList;

    // Add a connection from Src to Dst with the supplied style
    function ConnectObjects(Src, Dst: TControl;
      AStyle:TessConnectionStyle = csNormal;
      Arrow : TessConnectionArrowStyle = asEmptyClosed): Boolean;

    // Free all managed objects and the managed controls.
    procedure ClearManagedObjects;

    // Unselect all selected objects
    procedure ClearSelection;

    procedure SetFocus; override;

    procedure RecalcSize;

    property IsModified: Boolean read FIsModified write FIsModified;

    // Bitmap to be used as background
    property BackBitmap : TBitmap read FBackBitmap write FBackBitmap;

    //Only draw selected
    property SelectedOnly : boolean read FSelectedOnly write SetSelectedOnly;
  published
    { Published declarations }
    property Align;
    property Alignment;
    property Anchors;
    property BevelInner;
    property BevelOuter;
    property BevelWidth;
{$ifdef WIN32}
    property BiDiMode;
    property Ctl3D;
    property UseDockManager default True;
    property DockSite;
    property DragCursor;
    property DragKind;
    property FullRepaint;
    property Locked;
    property ParentBiDiMode;
    property ParentCtl3D;
    property OnCanResize;
    property OnDockDrop;
    property OnDockOver;
    property OnEndDock;
    property OnGetSiteInfo;
    property OnStartDock;
    property OnUnDock;
{$endif}
    property BorderWidth;
    property BorderStyle;
    property Caption;
    property Color default clWhite;
    property Constraints;
    property DragMode;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDrag;
  end;

procedure Register;

implementation
{$ifdef WIN32}
uses Math;
{$endif}
{$ifdef LINUX}
uses Math,Qt,Xlib;
{$endif}

type
  TCrackControl = class(TControl) end;

procedure Register;
begin
  RegisterComponents('Eldean', [TessConnectPanel]);
end;



procedure DrawArrow(Canvas:TCanvas; pfrom, pto: TPoint; ArrowStyle : TessConnectionArrowStyle);
  var
    HeadLength: Integer;
    x1,x2: Integer;
    y1,y2: Integer;
    xbase: Integer;
    xLineDelta: Integer;
    xLineUnitDelta: Double;
    xNormalDelta: Integer;
    xNormalUnitDelta: Double;
    ybase: Integer;
    yLineDelta: Integer;
    yLineUnitDelta: Double;
    yNormalDelta: Integer;
    yNormalUnitDelta: Double;
    oldPW: Integer;
    oldPS: TPenStyle;
    Tmp1 : double;
begin
    x1 := pfrom.x;  // first point
    y1 := pfrom.y;

    x2 := pto.x;  // second point with arrow
    y2 := pto.y;

    Canvas.MoveTo(x1,y1);
    Canvas.LineTo(x2,y2);

    xLineDelta := x2 - x1;
    yLineDelta := y2 - y1;

    if (xLineDelta=0) and (yLineDelta=0) then exit; // Line is 0 length
    if (abs(xLineDelta)>20000) or (abs(yLineDelta)>20000) then exit; // Line is too long

    Tmp1 := SQRT( SQR(xLineDelta) + SQR(yLineDelta) );
    if Tmp1=0 then
      xLineUnitDelta := 0
    else
      xLineUnitDelta := xLineDelta / Tmp1;

    Tmp1 := SQRt( SQR(xLineDelta) + SQR(yLineDelta) );
    if Tmp1=0 then
      yLineUnitDelta := 0
    else
      yLineUnitDelta := yLineDelta / Tmp1;

    // (xBase,yBase) is where arrow line is perpendicular to base of triangle.
    HeadLength := 10; // pixels
    xBase := x2 - Round(HeadLength * xLineUnitDelta);
    yBase := y2 - Round(HeadLength * yLineUnitDelta);

    xNormalDelta :=  yLineDelta;
    yNormalDelta := -xLineDelta;
    xNormalUnitDelta := xNormalDelta / Sqrt( Sqr(xNormalDelta) + Sqr(yNormalDelta) );
    yNormalUnitDelta := yNormalDelta / Sqrt( Sqr(xNormalDelta) + Sqr(yNormalDelta) );

    oldPW := Canvas.Pen.Width;
    oldPS := Canvas.Pen.Style;
    Canvas.Pen.Width := 1;
    Canvas.Pen.Style := psSolid;

    // Draw the arrow tip
    case ArrowStyle of
      asEmptyClosed :
        Canvas.Polygon([Point(x2,y2),
          Point(xBase + ROUND(HeadLength*xNormalUnitDelta),
                yBase + ROUND(HeadLength*yNormalUnitDelta)),
          Point(xBase - ROUND(HeadLength*xNormalUnitDelta),
                yBase - ROUND(HeadLength*yNormalUnitDelta)) ]);
      asEmptyOpen :
        Canvas.Polyline([Point(xBase + ROUND(HeadLength*xNormalUnitDelta),
               yBase + ROUND(HeadLength*yNormalUnitDelta)),
               Point(x2,y2),
         Point(xBase - ROUND(HeadLength*xNormalUnitDelta),
               yBase - ROUND(HeadLength*yNormalUnitDelta)) ]);
    end;

    Canvas.Pen.Width := oldPW;
    Canvas.Pen.Style := oldPS;
end;


function PointToAngle(R : TRect; P : TPoint) : double;
var
  Px,Py : integer;
begin
  Px := p.x - ( r.left + (r.Right-r.left) div 2 );
  Py := p.y - ( r.top + (R.Bottom-R.Top) div 2 );
  Result := Arctan2(py* (r.Right-r.left) , px* (R.Bottom-R.Top) );
end;

function AngleToPoint(R : TRect; Angle : double) : TPoint;
var
  Si,Co,E : double;
  X,Y : integer;

  function Range(Min,Max,Value : integer) : integer;
  begin
    if (value < min) then
      value := min;
    if (value > max) then
      value := max;
    Result := Value;
  end;

begin
  Si := Sin(Angle);
  Co := Cos(Angle);
  E := 0.001;
  X:=0;
  Y:=0;
  if Abs(Si)>E then
  begin
    X := Round((1.0 + Co/Abs(si)) / 2.0 * (r.Right-r.left));
    X := Range(0, (r.Right-r.left), x);
  end
  else if Co>=0.0 then
    X := (r.Right-r.left);

  if Abs(Co)>e then
  begin
    Y := Round((1.0 + Si/Abs(co))/2.0 * (R.Bottom-R.Top));
    Y := range(0, (R.Bottom-R.Top), y);
  end else if Si>=0 then
    Y := (R.Bottom-R.Top);
  Result := Point(R.Left + X,R.Top + Y);
end;

procedure CalcShortest(FromRect,ToRect : TRect; var P1,P2 : TPoint);
var
  Temp : TPoint;
begin
  Temp := Point( FromRect.Left + (FromRect.Right-FromRect.Left)div 2, FromRect.Top + (FromRect.Bottom-FromRect.Top)div 2);
  P2 := AngleToPoint( ToRect , PointToAngle(ToRect,Temp) );

  Temp := Point( ToRect.Left + (ToRect.Right-ToRect.Left)div 2, ToRect.Top + (ToRect.Bottom-ToRect.Top)div 2);
  P1 := AngleToPoint( FromRect , PointToAngle(FromRect,Temp) );
end;

{ TessConnectPanel }
function TessConnectPanel.AddManagedObject(AObject: TControl): TControl;
var
  crkObj : TCrackControl;
  newObj: TManagedObject;
begin
  Result := nil;
  if (AObject.Left + AObject.Width) > Width then Width := Max(Width,AObject.Left + AObject.Width + 50);
  if (AObject.Top + AObject.Height) > Height then Height := Max(Height,AObject.Top + AObject.Height + 50);

  AObject.Parent := Self;
  AObject.Visible := True;
  if FindManagedControl(AObject) = nil then
  begin
    newObj := TManagedObject.Create;
    newObj.FControl := AObject;
    FManagedObjects.Add(newObj);