essconnectpanel.pas

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

        MovedRect:=Rect(MaxInt,0,0,0);
        for i:=0 to FManagedObjects.Count -1 do
        begin
          if TManagedObject(FManagedObjects[i]).Selected then
          begin
            mcont := TManagedObject(FManagedObjects[i]);
            curr := TCrackControl(mcont.FControl);
            if curr.Left+dx >= 0 then
              curr.Left := curr.Left + dx;
            if curr.Top+dy >= 0 then
              curr.Top := curr.Top + dy;
            if (curr.Left + curr.Width + 50) > Width then
              Width := (curr.Left + curr.Width + 50);
            if (curr.Top + curr.Height + 50) > Height then
              Height := (curr.Top + curr.Height + 50);
            if MovedRect.Left=MaxInt then
              MovedRect := curr.BoundsRect
            else
              UnionRect(MovedRect,curr.BoundsRect,MovedRect);
            curr.Repaint;
            IsModified := True;
          end;
        end;

        if MovedRect.Left <> MaxInt then
          InMakeVisible(MovedRect);

        RecalcSize;
        Invalidate;
      end;
    end else if Assigned(found) then
    begin
      if Assigned(TCrackControl(found).OnMouseMove) then
      begin
        p2 := found.ScreenToClient(pt);
        TCrackControl(found).OnMouseMove(found,Shift,p2.x,p2.y);
      end;
    end;
  end;
end;

procedure TessConnectPanel.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  pt: TPoint;
  r: TRect;
  found: TControl;
  p2: TPoint;
begin
  inherited;
  FIsMoving := False;
  pt.X := X;
  pt.Y := Y;
  IntersectRect(r,Parent.ClientRect,BoundsRect);
  r.TopLeft := Parent.ClientToScreen(r.TopLeft);
  r.BottomRight := Parent.ClientToScreen(r.BottomRight);

  r.TopLeft := ScreenToClient(r.TopLeft);
  r.BottomRight := ScreenToClient(r.BottomRight);

  if FIsRectSelecting then
  begin
    Canvas.Brush.Style := bsClear;
    Canvas.Pen.Mode := pmXor;
    Canvas.Pen.Width := 0;
    Canvas.Rectangle(FSelectRect);
    FIsRectSelecting := False;
    // Do Select everything inside the rect.
    SelectObjectsInRect(FSelectRect);
  end else
  begin
    if (PtInRect(r,pt)) then
    begin
      if GetCaptureControl <> Self then SetCaptureControl(Self);


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

      if Assigned(found) then
      begin
        if Assigned(TCrackControl(found).PopupMenu) and (Button = mbRight) then
          TCrackControl(found).PopupMenu.Popup(Mouse.CursorPos.X,Mouse.CursorPos.Y);

        if Assigned(TCrackControl(found).OnMouseUp) then
        begin
          p2 := found.ScreenToClient(Mouse.CursorPos);
          TCrackControl(found).OnMouseUp(found,Button,Shift,p2.x,p2.y);
        end;
      end;
    end;
  end;
end;

procedure TessConnectPanel.OnManagedObjectClick(Sender: TObject);
var
  inst: TManagedObject;
begin
  inst := FindManagedControl(Sender as TControl);
  if Assigned(inst) then
  begin
    if Assigned(inst.FOnClick) then inst.FOnClick(Sender);
  end;
end;

procedure TessConnectPanel.OnManagedObjectDblClick(Sender: TObject);
var
  inst: TManagedObject;
begin
  inst := FindManagedControl(Sender as TControl);
  if Assigned(inst) then
  begin
    if Assigned(inst.FOnDblClick) then inst.FOnDblClick(Sender);
  end;
end;

procedure TessConnectPanel.OnManagedObjectMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  pt: TPoint;
begin
  if (not Focused) or (GetCaptureControl<>Self) then
  begin
    // Call the essConnectpanel MouseDown instead.
    pt.x := X;
    pt.y := Y;
    pt := (Sender as TControl).ClientToScreen(pt);
    pt := ScreenToClient(pt);
    MouseDown(Button,Shift,pt.x,pt.y);
  end;
end;

procedure TessConnectPanel.OnManagedObjectMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  inst: TManagedObject;
begin
  inst := FindManagedControl(Sender as TControl);
  if Assigned(inst) then
    if Assigned(inst.FOnMouseMove) then inst.FOnMouseMove(Sender,Shift,X,Y);
end;

procedure TessConnectPanel.OnManagedObjectMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  inst: TManagedObject;
begin
  inst := FindManagedControl(Sender as TControl);
  if Assigned(inst) then
    if Assigned(inst.FOnMouseUp) then inst.FOnMouseUp(Sender,Button,Shift,X,Y);
end;

procedure TessConnectPanel.Paint;
const
  HANDLESIZE: Integer = 5;
var
  Rect, r2: TRect;
  p,p1: TPoint;
  TopColor, BottomColor: TColor;
  i: Integer;
  conn: TConnection;


  procedure AdjustColors(Bevel: TPanelBevel);
  begin
    TopColor := clBtnHighlight;
    if Bevel = bvLowered then TopColor := clBtnShadow;
    BottomColor := clBtnShadow;
    if Bevel = bvLowered then BottomColor := clBtnHighlight;
  end;

  function CenterOf(const r: TRect): TPoint;
  begin
    Result.x := (r.Left + r.Right) div 2;
    Result.y := (r.Top + r.Bottom) div 2;
  end;

  procedure MakeRectangle(var r: TRect; x1,y1,x2,y2: Integer);
  begin
  r.Left := x1; r.Right := x2;
  r.Top := y1; r.Bottom := y2;
  end;
begin
  Canvas.Pen.Mode := pmCopy;
  Rect := GetClientRect;
  if BevelOuter <> bvNone then
  begin
    AdjustColors(BevelOuter);
    Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  end;
  Frame3D(Canvas, Rect, Color, Color, BorderWidth);
  if BevelInner <> bvNone then
  begin
    AdjustColors(BevelInner);
    Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  end;

  if Assigned(FBackBitmap) then
    Canvas.Brush.Bitmap := FBackBitmap
  else
    Canvas.Brush.Color := Color;
  Canvas.FillRect(Rect);

  Canvas.Brush.Style := bsSolid;
  Canvas.Pen.Color := clBlack;
  Canvas.Pen.Width := 3;

  for i:=0 to FConnections.Count -1 do
  begin
    conn := (FConnections[i] as TConnection);
    if (not Conn.FFrom.Visible) or (not Conn.FTo.Visible) then
      Continue;
    case conn.FConnectStyle of
      csThin:
        begin
          Canvas.Pen.Width := 1;
          Canvas.Pen.Style := psSolid;
        end;
      csNormal:
        begin
          Canvas.Pen.Width := 3;
          Canvas.Pen.Style := psSolid;
        end;
      csThinDash:
        begin
          Canvas.Pen.Width := 1;
          Canvas.Pen.Style := psDash;
        end;
    end;

    CalcShortest(conn.FFrom.BoundsRect,conn.FTo.BoundsRect,p,p1);
    if FindManagedControl(conn.FFrom).Selected and (not FSelectedOnly) then
      Canvas.Pen.Color := clGreen
    else
      Canvas.Pen.Color := clBlack;

    Canvas.Brush.Color := clWhite;
    DrawArrow(Canvas,p,p1,Conn.ArrowStyle);
  end;

  Canvas.Pen.Style := psSolid;
  Canvas.Brush.Bitmap := nil;
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := clBlack;

  //Grab-handles
  if not FSelectedOnly then for i:=0 to FManagedObjects.Count -1 do
  begin
    if TManagedObject(FManagedObjects[i]).Selected and (TManagedObject(FManagedObjects[i]).FControl.Visible) then
    begin
      Rect := TManagedObject(FManagedObjects[i]).FControl.BoundsRect;
      MakeRectangle(r2, Rect.Left -HANDLESIZE, Rect.Top -HANDLESIZE, Rect.Left+HANDLESIZE, Rect.Top+HANDLESIZE);
      Canvas.FillRect(r2);
      MakeRectangle(r2, Rect.Right -HANDLESIZE, Rect.Top -HANDLESIZE, Rect.Right+HANDLESIZE, Rect.Top+HANDLESIZE);
      Canvas.FillRect(r2);
      MakeRectangle(r2, Rect.Left -HANDLESIZE, Rect.Bottom -HANDLESIZE, Rect.Left+HANDLESIZE, Rect.Bottom+HANDLESIZE);
      Canvas.FillRect(r2);
      MakeRectangle(r2, Rect.Right -HANDLESIZE, Rect.Bottom -HANDLESIZE, Rect.Right+HANDLESIZE, Rect.Bottom+HANDLESIZE);
      Canvas.FillRect(r2);
    end;
  end;
end;

procedure TessConnectPanel.RecalcSize;
var
  i, xmax, ymax: Integer;
begin
  xmax := 300;
  ymax := 150;
  for i:=0 to ControlCount -1 do
  begin
    if (Controls[i].Align <> alNone) or (not Controls[i].Visible) then
      Continue;
    xmax := Max(xmax,Controls[i].Left + Controls[i].Width + 50);
    ymax := Max(ymax,Controls[i].Top + Controls[i].Height + 50);
  end;
  SetBounds(Left,Top,xmax,ymax);
  if Assigned(OnContentChanged) then
    OnContentChanged(nil);
end;


procedure TessConnectPanel.SelectObjectsInRect(SelRect: TRect);
var
  i: Integer;
  r1,r2: TRect;
begin
  r1 := SelRect;
  if (SelRect.Top > SelRect.Bottom) then
  begin
    SelRect.Top := r1.Bottom;
    SelRect.Bottom := r1.Top;
  end;
  if (SelRect.Left > SelRect.Right) then
  begin
    SelRect.Left := r1.Right;
    SelRect.Right := r1.Left;
  end;

  for i:=0 to FManagedObjects.Count -1 do
  begin
    r1 := TCrackControl(TManagedObject(FManagedObjects[i]).FControl).BoundsRect;
    IntersectRect(r2,SelRect,r1);
    if EqualRect(r1,r2) and TManagedObject(FManagedObjects[i]).FControl.Visible then
      TManagedObject(FManagedObjects[i]).Selected := True;
  end;
end;

procedure TessConnectPanel.SetFocus;
var
  F : TCustomForm;
  X,Y : integer;
begin
  F := GetParentForm(Self);

  // Try to see if we can call inherited, otherwise there is a risc of getting
  // 'Cannot focus' exception when starting from delphi-tools.
  if CanFocus and (Assigned(F) and F.Active) then
  begin
    // To avoid having the scrollbox resetting its positions after a setfocus call.
    X := (Parent as TScrollBox).HorzScrollBar.Position;
    Y := (Parent as TScrollBox).VertScrollBar.Position;
    inherited;
    (Parent as TScrollBox).HorzScrollBar.Position := X;
    (Parent as TScrollBox).VertScrollBar.Position := Y;
  end;

  if GetCaptureControl <> Self then SetCaptureControl(Self);
end;

{$ifdef WIN32}
procedure TessConnectPanel.WMEraseBkgnd(var Message: TWmEraseBkgnd);
var
  can : Tcanvas;
begin
  can := tcanvas.create;
  try
    can.handle := message.DC;
    if Assigned(FBackBitmap) then
      Can.Brush.Bitmap := FBackBitmap
    else
      Can.Brush.Color := Color;
    Can.FillRect(ClientRect);
  finally
    can.free;
  end;
  Message.Result := 1;
end;
{$endif}


procedure TessConnectPanel.SetSelectedOnly(const Value : boolean);
var
  I : integer;
begin
  if FSelectedOnly <> Value then
  begin
    FSelectedOnly := Value;

    if FSelectedOnly then
    begin
      TempHidden.Clear;
      for i:=0 to FManagedObjects.Count -1 do
        if (not TManagedObject(FManagedObjects[i]).Selected) and TManagedObject(FManagedObjects[i]).FControl.Visible then
        begin
          TManagedObject(FManagedObjects[i]).FControl.Visible := False;
          TempHidden.Add( FManagedObjects[i] );
        end;
    end
    else
    begin
      for I := 0 to TempHidden.Count-1 do
        TManagedObject(TempHidden[I]).FControl.Visible := True;
      TempHidden.Clear;
    end;

  end;
end;


{ TManagedObject }

destructor TManagedObject.Destroy;
begin
  if Assigned(FControl) then FreeAndNil(FControl);
  inherited;
end;

procedure TManagedObject.SetSelected(const Value: Boolean);
begin
  FControl.Parent.Invalidate;
  FSelected := Value;
  if FSelected then
    FControl.BringToFront;
end;

end.