essconnectpanel.pas

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

    crkObj := TCrackControl(AObject);
    newObj.FOnMouseDown := crkObj.OnMouseDown;
    newObj.FOnMouseMove := crkObj.OnMouseMove;
    newObj.FOnMouseUp := crkObj.OnMouseUp;
    newObj.FOnClick := crkObj.OnClick;
    newObj.FOnDblClick := crkObj.OnDblClick;

    crkObj.OnMouseDown := OnManagedObjectMouseDown;
    crkObj.OnMouseMove := OnManagedObjectMouseMove;
    crkObj.OnMouseUp := OnManagedObjectMouseUp;
    crkObj.OnClick := OnManagedObjectClick;
    crkObj.OnDblClick := OnManagedObjectDblClick;
    Result := AObject;
  end;
end;

procedure TessConnectPanel.ClearManagedObjects;
var
  i: Integer;
begin
  FConnections.Clear;
  for i:=0 to FManagedObjects.Count -1 do
    TManagedObject(FManagedObjects[i]).Free;
  FManagedObjects.Clear;
  SetBounds(0,0,0,0);
  FIsModified := False;
end;

procedure TessConnectPanel.ClearSelection;
var
  i: Integer;
begin
  for i:=0 to FManagedObjects.Count -1 do
    TManagedObject(FManagedObjects[i]).Selected := False;
end;

procedure TessConnectPanel.Click;
var
  found: TControl;
  mcont: TManagedObject;
  {$ifdef LINUX}
  keys_return: TXQueryKeymap;
  {$endif}
begin
  inherited;
  {$ifdef WIN32}
  found := FindVCLWindow(Mouse.CursorPos);
  {$endif}
  {$ifdef LINUX}
  found := FindControl(Mouse.CursorPos);
  {$endif}
  if Assigned(found) and (not FIsMoving)then
  begin
    mcont := FindManagedControl(found);

  {$ifdef WIN32}
    if (GetAsyncKeyState(VK_CONTROL) and $F000) = 0 then
  {$endif}
  {$ifdef LINUX}
  { TODO : There must be a better way to check if any of the Ctrl keys are pressed }
    XQueryKeymap(Application.Display,keys_return);
    if ((Byte(keys_return[4]) and 32) = 0) and
       ((Byte(keys_return[13]) and 32)= 0) then
  {$endif}
      ClearSelection;

    if Assigned(mcont) then
      mcont.Selected := True;
    if found <> Self then TCrackControl(found).Click;
  end;
end;

{$ifdef WIN32}
procedure TessConnectPanel.CMMouseEnter(var Message: TMessage);
{$endif}
{$ifdef LINUX}
procedure TessConnectPanel.MouseEnter(AControl: TControl);
{$endif}
begin
  if Focused and Application.Active and (GetCaptureControl <> Self)then
    SetCaptureControl(Self);
end;

{$ifdef WIN32}
procedure TessConnectPanel.CMMouseLeave(var Message: TMessage);
{$endif}
{$ifdef LINUX}
procedure TessConnectPanel.MouseLeave(AControl: TControl);
{$endif}
var
  pt: TPoint;
  r: TRect;
begin
  pt := Mouse.CursorPos;

  IntersectRect(r,Parent.ClientRect,BoundsRect);
  r.TopLeft := Parent.ClientToScreen(r.TopLeft);
  r.BottomRight := Parent.ClientToScreen(r.BottomRight);

  if (not PtInRect(r,pt)) and (not FIsRectSelecting) then
    {$ifdef WIN32}
    ReleaseCapture;
    {$endif}
    {$ifdef LINUX}
    if GetCaptureControl = Self then SetCaptureControl(nil);
    {$endif}
end;

function TessConnectPanel.ConnectObjects(Src, Dst: TControl;
  AStyle: TessConnectionStyle; Arrow : TessConnectionArrowStyle): Boolean;
var
  conn: TConnection;
begin
  if (FindManagedControl(Src) <> nil) and (FindManagedControl(Dst) <> nil) and
    (Src<>Dst) then
  begin
    conn := TConnection.Create;
    conn.FFrom := Src;
    conn.FTo := Dst;
    conn.FConnectStyle := AStyle;
    conn.ArrowStyle := Arrow;
    FConnections.Add(conn);
    Result := True;
  end else
  begin
    Result := False;
  end;
  Invalidate;
end;

constructor TessConnectPanel.Create(AOwner: TComponent);
begin
  inherited;
{$ifdef LINUX}
  // This panel needs to be able to get focus.
  ControlStyle := ControlStyle - [csNoFocus];
  QWidget_Setbackgroundmode(Handle,QWidgetBackgroundMode_NoBackground);
{$endif}
  FManagedObjects := TList.Create;
  FConnections := TObjectList.Create(True);
  Color := clWhite;
  TempHidden := TObjectList.Create(False);
  {$ifdef WIN32}
  UseDockManager := True;
  {$endif}
end;

{$ifdef WIN32}
procedure TessConnectPanel.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
//  Params.Style := Params.Style and (not WS_CLIPCHILDREN);
end;
{$endif}

procedure TessConnectPanel.DblClick;
var
  found: TControl;
begin
  inherited;
  {$ifdef WIN32}
  found := FindVCLWindow(Mouse.CursorPos);
  {$endif}
  {$ifdef LINUX}
  found := FindControl(Mouse.CursorPos);
  {$endif}
  if Assigned(found) then
  begin
    FindManagedControl(found);
    if found <> Self then TCrackControl(found).DblClick;
  end;
end;

destructor TessConnectPanel.Destroy;
begin
  FreeAndNil(TempHidden);
  if Assigned(FManagedObjects) then
    FreeAndNil(FManagedObjects);
  if Assigned(FConnections) then
    FreeAndNil(FConnections);
  inherited;
end;

function TessConnectPanel.FindManagedControl( AControl: TControl): TManagedObject;
var
  i: Integer;
  curr: TManagedObject;
begin
  Result := nil;
  for i:=0 to FManagedObjects.Count -1 do
  begin
    curr := TManagedObject(FManagedObjects[i]);
    if curr.FControl = AControl then
    begin
      Result := curr;
      exit;
    end;
  end;
end;

function TessConnectPanel.GetConnections: TList;
var
  i: Integer;
begin
  Result := TList.Create;
  for i := 0 to FConnections.Count-1 do
    Result.Add(FConnections[I]);
end;

function TessConnectPanel.GetManagedObjects: TList;
var
  i: Integer;
begin
  Result := TList.Create;
  for i := 0 to FManagedObjects.Count-1 do
    Result.Add(TManagedObject(FManagedObjects[i]).FControl);
end;


function TessConnectPanel.GetFirstSelected: TControl;
var
  Tmp : TObjectList;
begin
  Result := nil;
  Tmp := GetSelectedControls;
  if Tmp.Count>0 then
    Result := Tmp[0] as TControl;
  Tmp.Free;
end;


function TessConnectPanel.GetSelectedControls: TObjectList;
var
  I : Integer;
begin
  Result := TObjectList.Create(False);
  for I := 0 to FManagedObjects.Count-1 do
    if TManagedObject(FManagedObjects[I]).FSelected then
      Result.Add( TManagedObject(FManagedObjects[I]).FControl );
end;


procedure TessConnectPanel.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  found: TControl;
  mcont: TManagedObject;
  p2: TPoint;
  {$ifdef LINUX}
  keys_return: TXQueryKeymap;
  {$endif}
begin
  inherited;

  if not Focused then SetFocus;

  if GetCaptureControl<>Self then
    SetCaptureControl(Self);

  FIsRectSelecting := False;
  FIsMoving := False;
  FMemMousePos.x := X;
  FMemMousePos.y := Y;

  {$ifdef WIN32}
  found := FindVCLWindow(Mouse.CursorPos);
  {$endif}
  {$ifdef LINUX}
  found := FindControl(Mouse.CursorPos);
  {$endif}

  if found = Self then found := nil;
  if Assigned(found) then
  begin
    mcont := FindManagedControl(found);
    if Assigned(mcont) then
    begin

      {$ifdef WIN32}
      if (not mcont.Selected) and ((GetAsyncKeyState(VK_CONTROL) and $f000)=0) then
      {$endif}
      {$ifdef LINUX}
    { TODO : There must be a better way to check if any of the Ctrl keys are pressed }
      XQueryKeymap(Application.Display,keys_return);
      if (not mcont.Selected) and
         ((Byte(keys_return[4]) and 32) = 0) and
         ((Byte(keys_return[13]) and 32)= 0) then
      {$endif}
        ClearSelection;

      mcont.Selected := True;
    end;
    if Assigned(TCrackControl(found).OnMouseDown) then
    begin
      p2 := found.ScreenToClient(Mouse.CursorPos);
      TCrackControl(found).OnMouseDown(found,Button,Shift,p2.x,p2.y);
    end;
  end else
  begin if not Assigned(found) and (Button = mbLeft) then
    FIsRectSelecting := True;
    FSelectRect.TopLeft := FMemMousePos;
    FSelectRect.BottomRight := FMemMousePos;

    Canvas.Brush.Style := bsClear;
    Canvas.Pen.Color := clSilver;
    Canvas.Pen.Mode := pmXor;
    Canvas.Pen.Width := 0;
    Canvas.Rectangle(FSelectRect);
  end;
end;

procedure TessConnectPanel.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  pt,pt1: TPoint;
  r: TRect;
  found: TControl;
  mcont: TManagedObject;
  p2: TPoint;
  i,dx,dy, mdx, mdy: Integer;
  curr: TCrackControl;
  MovedRect : TRect;

  procedure InMakeVisible(C : TRect);
  begin
    mdx := TScrollBox(Parent).HorzScrollBar.Position;
    mdy := TScrollBox(Parent).VertScrollBar.Position;

    if (dx>0) and (C.BottomRight.X >= TScrollBox(Parent).HorzScrollBar.Position + Parent.Width) then
      TScrollBox(Parent).HorzScrollBar.Position := C.BottomRight.X - Parent.Width;

    if (dy>0) and (C.BottomRight.Y >= TScrollBox(Parent).VertScrollBar.Position + Parent.Height) then
      TScrollBox(Parent).VertScrollBar.Position := C.BottomRight.Y - Parent.Height;

    if (dx<0) and (C.Left <= TScrollBox(Parent).HorzScrollBar.Position) then
      TScrollBox(Parent).HorzScrollBar.Position := C.Left;

    if (dy<0) and (C.Top <= TScrollBox(Parent).VertScrollBar.Position) then
      TScrollBox(Parent).VertScrollBar.Position := C.Top;

    mdy := mdy - TScrollBox(Parent).VertScrollBar.Position;
    mdx := mdx - TScrollBox(Parent).HorzScrollBar.Position;

    if (mdx <> 0) or (mdy <> 0) then
    begin
      p2 := Mouse.CursorPos;
      p2.X := p2.X + mdx;
      p2.Y := p2.Y + mdy;
      Mouse.CursorPos := p2;
    end;
  end;

begin
  inherited;
  pt1 := Mouse.CursorPos;

  pt.x := X;
  pt.Y := Y;
  dx := pt.x - FMemMousePos.x;
  dy := pt.y - FMemMousePos.y;

  IntersectRect(r,Parent.ClientRect,BoundsRect);
  r.TopLeft := Parent.ClientToScreen(r.TopLeft);
  r.BottomRight := Parent.ClientToScreen(r.BottomRight);


  if (not PtInRect(r,pt1)) and (not (FIsRectSelecting or FIsMoving)) then
    {$ifdef WIN32}
    ReleaseCapture
    {$endif}
    {$ifdef LINUX}
     begin
        if GetCaptureControl = Self then SetCaptureControl(nil);
     end
    {$endif}
  else
  begin
    {$ifdef WIN32}
    found := FindVCLWindow(pt1);
    {$endif}
    {$ifdef LINUX}
    found := FindControl(pt1);
    {$endif}

    if FIsRectSelecting then
    begin
      FMemMousePos := pt;
      Canvas.Brush.Style := bsClear;
      Canvas.Pen.Color := clSilver;
      Canvas.Pen.Mode := pmXor;
      Canvas.Pen.Width := 0;
      Canvas.Rectangle(FSelectRect);
      FSelectRect.BottomRight := FMemMousePos;
      Canvas.Rectangle(FSelectRect);
    end else if (ssLeft in Shift) then
    begin
      //  Move the selected boxes
      if (Abs(Abs(dx)+Abs(dy)) > 5) or (FIsMoving) then
      begin
        FMemMousePos := pt;
        FIsMoving := True;