|
From: vrecion <pav...@sy...> - 2005-02-24 07:58:56
|
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);
|