RE: [Extgraph-developer] BezierLink code

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

OK.

I will try to incorporate as much code as I can into some working version.

And I will publish it on sf cvs, so that we will hopefully get some
consolidated version.

Pavel

  _____  

From: ext...@li...
[mailto:ext...@li...] On Behalf Of Stefan
Melis
Sent: Wednesday, February 23, 2005 12:53 PM
To: ext...@li...
Subject: [Extgraph-developer] BezierLink code

Hey,

Since we're throwing code around, I thought I'd join in on the fun :)

Here's my code for the BezierLink, it does however have a "problem":

I don't know how to implement the DrawText for this thing, where *should* we
put the text, any ideas?

As you can see I've renamed TSimpleGraph to TExtGraph, I think that'll be a
good thing for the next release.

Cheers,

Stefan

  TMarkerType = (mtNone, mtSizeW, mtSizeE, mtSizeN, mtSizeS, mtSizeNW,
    mtSizeNE, mtSizeSW, mtSizeSE, mtMove, mtMoveStrartPt, mtMoveEndPt,
    mtSelect, mtStretchBezier); (* SM - added mtStretchBezier for
TBezierLink *)

  TGraphMouseState = (gsNone, gsMoveResizeNode, gsSelectRect, gsMoveLink,
gsStretchBezier);
  (* SM - added gsStretchBezier for TBezierLink *)

  TBezierLink = class(TGraphLink)
    class procedure DrawDraft(Canvas: TCanvas; const ARect: TRect);
override;  
    procedure DrawBody(Canvas: TCanvas); override;
  protected
    function FindMarkerAt(X, Y: Integer): TMarkerType; override;
    procedure DrawMarkers(Canvas: TCanvas); override;
  private
    fPointsAltered : Boolean;
  public
    points: array [0..3] of TPoint;
    NumLine: integer;
    lpPoints: array of TPoint;
    lpTypes: array of Byte;
    DraggingPoint: integer;
    function ContainsPoint(X, Y: Integer): Boolean; override;
    destructor Destroy; override;
  end;

{ TBezierLink }

function TBezierLink.ContainsPoint(X, Y: Integer): Boolean;
var
  Margin: Integer;
  R: TRect;
  i: integer;
begin
  Result := False;
  if Showing and (FromNode <> nil) and (ToNode <> nil) then begin
    if (TextRegion <> 0) and PtInRegion(TextRegion, X, Y) then
      Result := True
    else begin
      if Selected then begin
        for i := 1 to 2 do begin
          with points[i] do SetRect(r, X, Y, X, Y);
          InflateRect(r, Owner.MarkerSize, Owner.MarkerSize);
          Result := PtInRect(r, Point(X,Y));
          if result then Exit;
        end;
      end;
      for i := 1 to NumLine-1 do begin
        Margin := Pen.Width + Owner.MarkerSize;
        Margin := Margin div 2;
        R := MakeRect(Point(lppoints[i-1].x, lppoints[i-1].y),
Point(lppoints[i].x, lppoints[i].y));
        InflateRect(R, Margin, Margin);
        Result := PtInRect(R, Point(X, Y));
        if Result then Break;
      end;
    end;
  end;
end;

destructor TBezierLink.Destroy;
begin
  SetLength(lpPoints, 0);
  SetLength(lpTypes, 0);
  inherited;
end;

procedure TBezierLink.DrawBody(Canvas: TCanvas);
var
  i: integer;
//  r: TRect;
//  Margin: Integer;
begin
  with StartPt do Canvas.MoveTo(X, Y);
  if (points[0].x <> StartPt.x) or 

     (points[0].y <> StartPt.y) or 

     (points[3].x <> EndPt.x) or 

     (points[3].y <> EndPt.y)  then begin
    points[0] := StartPt;
    if not fPointsAltered then points[1] := Point(StartPt.x, EndPt.Y);
    if not fPointsAltered then points[2] := Point(EndPt.x, StartPt.y);
    points[3] := EndPt;
  end;
  BeginPath(Canvas.Handle);
  PolyBezier(Canvas.Handle, Points, 4);
  EndPath(Canvas.Handle);
  FlattenPath(Canvas.Handle);
  NumLine := getpath(Canvas.Handle, lpPoints, lpTypes, 0);
  setlength(lppoints, NumLine);
  setlength(lptypes, NumLine);
  GetPath(Canvas.Handle, lppoints[0], lptypes[0], NumLine);
  for i := 0 to NumLine-1 do begin
    case lpTypes[i] of
      PT_MOVETO: Canvas.MoveTo(lppoints[i].x, lppoints[i].y);
      PT_LINETO: Canvas.LineTo(lppoints[i].x, lppoints[i].y);
    end;
  end;
//  Shows the Rectangles which are used in ContainsPoint():
//  for i := 1 to NumLine-1 do begin
//    Margin := Pen.Width + Owner.MarkerSize;
//    Margin := Margin div 2;
//    R := MakeRect(Point(lppoints[i-1].x, lppoints[i-1].y),
Point(lppoints[i].x, lppoints[i].y));
//    InflateRect(R, Margin, Margin);
//    Canvas.Rectangle(R);
//  end;
end;

class procedure TBezierLink.DrawDraft(Canvas: TCanvas; const ARect: TRect);
var
  i: integer;
  points: array [0..3] of TPoint;
  NumLine: integer;
  lpPoints: array of TPoint;
  lpTypes: array of Byte;
begin
  Canvas.MoveTo(Arect.TopLeft.X, Arect.TopLeft.Y);
  if (points[0].x <> Arect.TopLeft.X) or 

     (points[0].y <> Arect.TopLeft.Y) or 

     (points[3].x <> Arect.BottomRight.x) or 

     (points[3].y <> Arect.BottomRight.y) then begin
    points[0] := Arect.TopLeft;
    points[1] := Point(Arect.TopLeft.x, Arect.BottomRight.Y);
    points[2] := Point(Arect.BottomRight.x, Arect.TopLeft.y);
    points[3] := Arect.BottomRight;
  end;
  BeginPath(Canvas.Handle);
  PolyBezier(Canvas.Handle, Points, 4);
  EndPath(Canvas.Handle);
  FlattenPath(Canvas.Handle);
  NumLine := getpath(Canvas.Handle, lpPoints, lpTypes, 0);
  setlength(lppoints, NumLine);
  setlength(lptypes, NumLine);
  GetPath(Canvas.Handle, lppoints[0], lptypes[0], NumLine);
  for i := 0 to NumLine-1 do begin
    case lpTypes[i] of
      PT_MOVETO: Canvas.MoveTo(lppoints[i].x, lppoints[i].y);
      PT_LINETO: Canvas.LineTo(lppoints[i].x, lppoints[i].y);
    end;
  end;
end;

procedure TBezierLink.DrawMarkers(Canvas: TCanvas);
var
  i: integer;
  r: TRect;
begin
  inherited;
  if Selected then begin
    for i := 1 to 2 do begin
      with points[i] do SetRect(r, X, Y, X, Y);
      InflateRect(r, Owner.MarkerSize, Owner.MarkerSize);
      Canvas.FrameRect(r);
    end;
  end;
end;

function TBezierLink.FindMarkerAt(X, Y: Integer): TMarkerType;
var
  Marker: TMarkerType;
  Pt: TPoint;
  i: integer;
  r: TRect;
begin
  Result := mtNone;
  if Showing then begin
    if Selected then begin
      Pt := Point(X, Y);
      for Marker := mtMoveStrartPt to mtMoveEndPt do begin
        if PtInRect(MarkerRect(Marker), Pt) then begin
          Result := Marker;
          Exit;
        end;
      end;
      for i := 1 to 2 do begin
        with points[i] do SetRect(r, X, Y, X, Y);
        InflateRect(r, Owner.MarkerSize, Owner.MarkerSize);
        if PtInRect(r, Pt) then begin
          Result := mtStretchBezier;
          DraggingPoint := i;
          Exit;
        end;
      end;
    end;
    if ContainsPoint(X, Y, true) then
      Result := mtSelect;
  end;
end;

{ / TBezierLink }

procedure TExtGraph.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
var
  Pt: TPoint;
begin
...
      // A Link is under cursor
      else
      begin
        if (Button = mbLeft) and not 

           (ssDouble in Shift) and 

           (MarkerAtCursor in [mtMoveEndPt, mtMoveStrartPt]) then begin
          if MarkerAtCursor = mtMoveEndPt then
            StartPoint := TGraphLink(ObjectAtCursor).FromNode.Center
          else
            StartPoint := TGraphLink(ObjectAtCursor).ToNode.Center;
          StopPoint := Pt;
          State := gsMoveLink;
          Linking := True;
        end;
        if (Button = mbLeft) and not 

           (ssDouble in Shift) and 

           (MarkerAtCursor in [mtStretchBezier]) then
          State := gsStretchBezier;
      end;
    end;
...

procedure TExtGraph.MouseMove(Shift: TShiftState; X, Y: Integer);
const
  FreezeTopMarkers  = [mtMove, mtSizeNW, mtSizeN, mtSizeNE];
  FreezeLeftMarkers = [mtMove, mtSizeNW, mtSizeW, mtSizeSW];
var
...
  BezierAtCursor: TBezierLink;
begin
...
    else if State = gsStretchBezier then begin
      BezierAtCursor := TBezierLink(ObjectAtCursor);
      BezierAtCursor.fPointsAltered := True;
      BezierAtCursor.points[BezierAtCursor.DraggingPoint] := Point(X,Y);
      BezierAtCursor.DrawBody(Canvas);
      Invalidate;
    end
...
end;

initialization
...
  TExtGraph.Register(TBezierLink);
finalization
...
  TExtGraph.Unregister(TBezierLink);