DELPHI AREA Forum

SimpleGraph - I've been trying for a while to ensure that links can only be created between two nodes, I know this used to be the case in earlier versions but I can't reproduce similar behaviour in the latest version. All in all its a very nice component! thanks

Hi,

Check the linkable option of the links. By setting this option off (for all links), only nodes can be linked.

I'm not sure I fully understand,

TGraphLinkOption has the following options; gloFixedStartPoint, gloFixedEndPoint, gloFixedBreakPoints, gloFixedAnchorStartPoint, gloFixedAnchorEndPoint

Is this what you mean ?

Sorry, my mistake. I thought there is already an option for that purpose.
Now you can only use the hook events to prevent the connection making between the link.

All sorted now, I did a few minor modifications to the mouse up and mouse down handlers in SimpleGraph.pas which solves my problem.

Code: Select all

procedure TGraphLink.MouseUp(Button: TMouseButton; Shift: TShiftState; const Pt: TPoint);
begin
  if not Dragging or (Button <> mbRight) or (ChangeMode <> lcmMovePoint) then
  begin
    inherited MouseUp(Button, Shift, Pt);
    if (ChangeMode = lcmMovePoint) and AcceptingHook then begin
      Hook(MovingPoint, HookingObject);
      fMovingPoint := -1;
      fHookingObject := nil;
      fAcceptingHook := False;
      ChangeMode := lcmNone;
    end else if (Target <> nil) then begin
      fMovingPoint := -1;
      fHookingObject := nil;
      fAcceptingHook := False;
      ChangeMode := lcmNone;
    end else begin
      Destroy;
    end;
  end;
end


Code: Select all

procedure TSimpleGraph.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  Pt: TPoint;
  NewObject: TGraphObject;
begin
  if not Focused then SetFocus;
  inherited MouseDown(Button, Shift, X, Y);
  Pt := ClientToGraph(X, Y);
  CheckObjectAtCursor(Pt);
  case CommandMode of
    cmInsertNode, cmInsertLink:
      if Assigned(DragSource) then
        DragSource.MouseDown(Button, Shift, Pt)
      else if (Button = mbLeft) and not (ssDouble in Shift) then
      begin
        NewObject := nil;
        case CommandMode of
          cmInsertNode:
            NewObject := InsertObjectByMouse(Pt, DefaultNodeClass, SnapToGrid xor (ssCtrl in Shift));
          cmInsertLink:
            begin
              if Assigned(ObjectAtCursor) then begin      { modified }
                if ObjectAtCursor.IsNode then begin        { modified }
                  NewObject := InsertObjectByMouse(Pt, DefaultLinkClass, SnapToGrid xor (ssCtrl in Shift));
                end;
              end;
            end;
        end;
        if Assigned(NewObject) then
        begin
          NewObject.Selected := True;
          NewObject.MouseDown(Button, Shift, Pt);
          if DragSource <> NewObject then
          begin
            CommandMode := cmEdit;
            ObjectChanged(NewObject, [gcData]);
          end
          else
            CursorPos := Pt;
          RenewObjectAtCursor(NewObject);
        end;
      end;
    cmPan:
      if (Button = mbLeft) and not (ssDouble in SHift) then
      begin
        fDragSourcePt.X := X;
        fDragSourcePt.Y := Y;
        Screen.Cursor := crHandGrab
      end;
  else
    if Assigned(ObjectAtCursor) and (CommandMode <> cmViewOnly) and
      (goSelectable in ObjectAtCursor.Options)
    then
      ObjectAtCursor.MouseDown(Button, Shift, Pt)
    else if (Button = mbLeft) and not (ssDouble in Shift) then
    begin
      fDragSourcePt := Pt;
      fDragTargetPt := Pt;
      MarkedArea := MakeRect(fDragSourcePt, fDragTargetPt);
      Screen.Cursor := crCross;
    end;
  end;
end;