simplegraph.pas

很不错的绘制矢量图的控件。还有一个使用控件的例子。delphi7以上才可安装

    (Ord('S') shl 24) or (Ord('G') shl 16) or (Ord('.') shl 8) or Ord('0');

const
  MarkerCursors: array[TMarkerType] of TCursor =
    (crDefault, crSizeWE, crSizeWE, crSizeNS, crSizeNS, crSizeNWSE, crSizeNESW,
     crSizeNESW, crSizeNWSE, crHandFlat, crXHair2, crXHair2, crHandPnt);

const
  TextAlignFlags: array[TAlignment] of Integer = (DT_LEFT, DT_RIGHT, DT_CENTER);

var
  RegisteredNodeClasses: TList;
  RegisteredLinkClasses: TList;

{ Helper Functions }

function IsBetween(Value: Integer; Bound1, Bound2: Integer): Boolean;
begin
  if Bound1 > Bound2 then
  begin
    Bound1 := Bound1 xor Bound2;
    Bound2 := Bound1 xor Bound2;
    Bound1 := Bound1 xor Bound2;
  end;
  Result := (Value >= Bound1) and (Value <= Bound2);
end;

procedure TransformPoints(var Points: array of TPoint; const XForm: TXForm);
var
  I: Integer;
begin
 for I := Low(Points) to High(Points) do
   with Points[I], XForm do
   begin
     X := Round(X * eM11 + Y * eM21 + eDx);
     Y := Round(X * eM12 + Y * eM22 + eDy);
   end;
end;

procedure RotatePoints(var Points: array of TPoint;
  const Angle: Extended; const Org: TPoint);
var
  Sin, Cos: Extended;
  Prime: TPoint;
  I: Integer;
begin
 SinCos(Angle, Sin, Cos);
 for I := Low(Points) to High(Points) do
   with Points[I] do
   begin
     Prime.X := X - Org.X;
     Prime.Y := Y - Org.Y;
     X := Round(Prime.X * Cos - Prime.Y * Sin) + Org.X;
     Y := Round(Prime.X * Sin + Prime.Y * Cos) + Org.Y;
   end;
end;

procedure OffsetPoints(var Points: array of TPoint; dX, dY: Integer);
var
  I: Integer;
begin
  for I := Low(Points) to High(Points) do
    with Points[I] do
    begin
      Inc(X, dX);
      Inc(Y, dY);
    end;
end;

function CenterOfPoints(const Points: array of TPoint): TPoint;
var
  I: Integer;
  Sum: TPoint;
begin
  Sum.X := 0;
  Sum.Y := 0;
  for I := Low(Points) to High(Points) do
    with Points[I] do
    begin
      Inc(Sum.X, X);
      Inc(Sum.Y, Y);
    end;
  Result.X := Sum.X div Length(Points);
  Result.Y := Sum.Y div Length(Points);
end;

function BoundsRectOfPoints(const Points: array of TPoint): TRect;
var
  I: Integer;
begin
  Result.TopLeft := Points[Low(Points)];
  Result.BottomRight := Points[Low(Points)];
  for I := Low(Points) + 1 to High(Points) do
    with Points[I], Result do
    begin
      if X < Left then Left := X;
      if Y < Top then Top := Y;
      if X > Right then Right := X;
      if Y > Bottom then Bottom := Y;
    end;
end;

function MakeRect(const Corner1, Corner2: TPoint): TRect;
begin
  if Corner1.X > Corner2.X then
  begin
    Result.Left := Corner2.X;
    Result.Right := Corner1.X;
  end
  else
  begin
    Result.Left := Corner1.X;
    Result.Right := Corner2.X;
  end;
  if Corner1.Y > Corner2.Y then
  begin
    Result.Top := Corner2.Y;
    Result.Bottom := Corner1.Y;
  end
  else
  begin
    Result.Top := Corner1.Y;
    Result.Bottom := Corner2.Y;
  end
end;

function CenterOfRect(const Rect: TRect): TPoint;
begin
  Result.X := (Rect.Left + Rect.Right) div 2;
  Result.Y := (Rect.Top + Rect.Bottom) div 2;
end;

function TransformRgn(Rgn: HRGN; const XForm: TXForm): HRGN;
var
  RgnData: PRgnData;
  RgnDataSize: DWORD;
begin
  Result := 0;
  RgnDataSize := GetRegionData(Rgn, 0, nil);
  if RgnDataSize > 0 then
  begin
    GetMem(RgnData, RgnDataSize);
    try
      GetRegionData(Rgn, RgnDataSize, RgnData);
      Result := ExtCreateRegion(@Xform, RgnDataSize, RgnData^);
    finally
      FreeMem(RgnData);
    end;
  end;
end;

function LineSlopeAngle(const LinePt1, LinePt2: TPoint): Extended;
var
  dX, dY: Integer;
begin
  dX := LinePt2.X - LinePt1.X;
  dY := LinePt2.Y - LinePt1.Y;
  if dX <> 0 then
    Result := ArcTan2(dY, dX)
  else
    Result := Pi / 2;
end;

function DistanceToLine(const LinePt1, LinePt2, QueryPt: TPoint): Integer;
var
  M: Extended;
  Pt: TPoint;
begin
  if LinePt1.X = LinePt2.X then
    Result := Abs(QueryPt.X - LinePt1.X)
  else if LinePt1.Y = LinePt2.Y then
    Result := Abs(QueryPt.Y - LinePt1.Y)
  else
  begin
    M := (LinePt2.Y - LinePt1.Y) / (LinePt2.X - LinePt1.X);
    if (M <> +1) and (M <> -1) then
    begin
      Pt.X := Round((QueryPt.Y - LinePt1.Y + M * LinePt1.X - QueryPt.X / M) / (M - 1 / M));
      Pt.Y := Round(LinePt1.Y + M * (Pt.X - LinePt1.X));
    end
    else
    begin
      Pt.Y := Round((M * (QueryPt.X - LinePt1.X) + (QueryPt.Y + LinePt1.Y)) / 2);
      Pt.X := Round(LinePt1.X + (Pt.Y - LinePt1.Y) / M);
    end;
    Result := Round(Sqrt(Sqr(QueryPt.X - Pt.X) + Sqr(QueryPt.Y - Pt.Y)));
  end;
end;

function NextPointOfLine(const LineAngle: Extended; const ThisPoint: TPoint;
  Distance: Integer): TPoint;
var
  X, Y, M: Extended;
begin
  if Abs(LineAngle) <> Pi / 2 then
  begin
    if Abs(LineAngle) < Pi / 2 then
      Distance := -Distance;
    M := Tan(LineAngle);
    X := ThisPoint.X + Distance / Sqrt(1 + Sqr(M));
    Y := ThisPoint.Y + M * (X - ThisPoint.X);
    Result := Point(Round(X), Round(Y));
  end
  else
  begin
    if LineAngle > 0 then Distance := -Distance;
    Result := Point(ThisPoint.X, ThisPoint.Y + Distance);
  end;
end;

function IntersectLines(const Line1Pt: TPoint; const Line1Angle: Extended;
  const Line2Pt: TPoint; const Line2Angle: Extended; out Intersect: TPoint): Boolean;
var
  M1, M2: Extended;
  C1, C2: Extended;
begin
  Result := True;
  if (Line1Angle = Line2Angle) or
    ((Abs(Line1Angle) = Pi / 2) and (Abs(Line2Angle) = Pi / 2))
  then  // Lines have identical slope, so they are either parallel or identical
    Result := False
  else if Abs(Line1Angle) = Pi / 2 then
  begin
    M2 := Tan(Line2Angle);
    C2 := Line2Pt.Y - M2 * Line2Pt.X;
    Intersect.X := Line1Pt.X;
    Intersect.Y := Round(M2 * Line2Pt.X + C2);
  end
  else if Abs(Line2Angle) = Pi / 2 then
  begin
    M1 := Tan(Line1Angle);
    C1 := Line1Pt.Y - M1 * Line1Pt.X;
    Intersect.X := Line2Pt.X;
    Intersect.Y := Round(M1 * Line1Pt.X + C1);
  end
  else
  begin
    M1 := Tan(Line1Angle);
    C1 := Line1Pt.Y - M1 * Line1Pt.X;
    M2 := Tan(Line2Angle);
    C2 := Line2Pt.Y - M2 * Line2Pt.X;
    Intersect.X := Round((C1 - C2) / (M2 - M1));
    Intersect.Y := Round((M2 * C1 - M1 * C2) / (M2 - M1));
  end;
end;

function IntersectLineRect(const LineAngle: Extended;
  const Rect: TRect; Backward: Boolean): TPoint;
var
  M, C, A: Extended;
  Xc, Yc: Extended;
begin
  Xc := (Rect.Left + Rect.Right) / 2;
  Yc := (Rect.Top + Rect.Bottom) / 2;
  if Abs(LineAngle) = Pi / 2 then
  begin
    if (LineAngle > 0) xor Backward then
      Result := Point(Round(Xc), Rect.Bottom)
    else
      Result := Point(Round(Xc), Rect.Top);
  end
  else if (LineAngle = 0) or (Abs(LineAngle) = Pi) then
  begin
    if (LineAngle <> 0) xor Backward then
      Result := Point(Rect.Left, Round(Yc))
    else
      Result := Point(Rect.Right, Round(Yc));
  end
  else
  begin
    M := Tan(LineAngle);
    C := Yc - M * Xc;
    A := 0;
    if (Rect.Right - Rect.Left) > 0 then
      A := ArcTan2((Rect.Bottom - Rect.Top) / 2, (Rect.Right - Rect.Left) / 2);
    if ((Abs(LineAngle) >= 0) and (Abs(LineAngle) <= A) and Backward) or
       ((Pi - Abs(LineAngle) >= 0) and (Pi - Abs(LineAngle) <= A) and not Backward)
    then
      Result := Point(Rect.Left, Round(M * Rect.Left + C))
    else if ((Abs(LineAngle) >= 0) and (Abs(LineAngle) <= A) and not Backward) or
            ((Pi - Abs(LineAngle) >= 0) and (Pi - Abs(LineAngle) <= A) and Backward)
    then
      Result := Point(Rect.Right, Round(M * Rect.Right + C))
    else if (LineAngle > 0) xor Backward then
      Result := Point(Round((Rect.Bottom - C) / M), Rect.Bottom)
    else
      Result := Point(Round((Rect.Top - C) / M), Rect.Top);
  end;
end;

function IntersectLineEllipse(const LineAngle: Extended;
  const Bounds: TRect; Backward: Boolean): TPoint;
var
  A2, B2, M, T: Extended;
  Xc, Yc, X, Y: Extended;
begin
  Xc := (Bounds.Left + Bounds.Right) / 2;
  Yc := (Bounds.Top + Bounds.Bottom) / 2;
  if Abs(LineAngle) = Pi / 2 then
  begin
    if (LineAngle > 0) xor Backward then
      Result := Point(Round(Xc), Bounds.Bottom)
    else
      Result := Point(Round(Xc), Bounds.Top);
  end
  else if (LineAngle = 0) or (Abs(LineAngle) = Pi) then
  begin
    if (LineAngle <> 0) xor Backward then
      Result := Point(Bounds.Left, Round(Yc))
    else
      Result := Point(Bounds.Right, Round(Yc));
  end
  else
  begin
    M := Tan(LineAngle);
    A2 := Sqr((Bounds.Right - Bounds.Left) / 2);
    B2 := Sqr((Bounds.Bottom - Bounds.Top) / 2);
    T := B2 + A2 * Sqr(M);
    if (Abs(LineAngle) < Pi / 2) xor Backward then
      X := Sqrt(T * (A2 * B2)) / T
    else
      X := -Sqrt(T * (A2 * B2)) / T;
    Y := M * X;
    Result := Point(Round(X+Xc), Round(Y+Yc));
  end;
end;

function IntersectLineRoundRect(const LineAngle: Extended;
  const Bounds: TRect; Backward: Boolean; Rgn: HRgn): TPoint;
var
  CR: TRect;
  Sw, Sh, W, H: Integer;
  A2, B2, M, C: Extended;
  Xc, Yc, X, Y: Extended;
  a, b, d: Extended;
begin
  Result := IntersectLineRect(LineAngle, Bounds, Backward);
  SetRect(CR, Result.X, Result.Y, Result.X, Result.Y);
  InflateRect(CR, 1, 1);
  if not RectInRegion(Rgn, CR) and (Abs(LineAngle) <> Pi / 2) then
  begin
    W := Bounds.Right - Bounds.Left;
    H := Bounds.Bottom - Bounds.Top;
    if W > H then
    begin
      Sw := W div 4;
      if Sw > H then
        Sh := H
      else
        Sh := Sw;
    end
    else
    begin
      Sh := H div 4;
      if Sh > W then
        Sw := W
      else
        Sw := Sh;
    end;
    if ((LineAngle > 0) and (LineAngle < Pi / 2) and Backward) or
       ((LineAngle < -Pi / 2) and (LineAngle > -Pi) and not Backward)
    then
      SetRect(CR, Bounds.Left, Bounds.Top, Bounds.Left + Sw, Bounds.Top + Sh)
    else if ((LineAngle > 0) and (LineAngle < Pi / 2) and not Backward) or
            ((LineAngle < -Pi / 2) and (LineAngle > -Pi) and Backward)
    then
      SetRect(CR, Bounds.Right - Sw, Bounds.Bottom - Sh, Bounds.Right, Bounds.Bottom)
    else if ((LineAngle < 0) and (LineAngle > -Pi / 2) and Backward) or
            ((LineAngle > Pi / 2) and (LineAngle < Pi) and not Backward)
    then
      SetRect(CR, Bounds.Left, Bounds.Bottom - Sh, Bounds.Left + Sw, Bounds.Bottom)
    else if ((LineAngle < 0) and (LineAngle > -Pi / 2) and not Backward) or
            ((LineAngle > Pi / 2) and (LineAngle < Pi) and Backward)
    then
      SetRect(CR, Bounds.Right - Sw, Bounds.Top, Bounds.Right, Bounds.Top + Sh);
    Xc := (Bounds.Left + Bounds.Right) / 2;
    Yc := (Bounds.Top + Bounds.Bottom) / 2;
    M := Tan(LineAngle);
    C := Yc - M * Xc;
    Xc := (CR.Left + CR.Right) / 2;
    Yc := (CR.Top + CR.Bottom) / 2;
    A2 := Sqr(Sw / 2);
    B2 := Sqr(Sh / 2);
    a := (B2 + A2 * Sqr(M));
    b := (A2 * M * (C - Yc)) - B2 * Xc;
    d := Sqr(b) - a * (B2 * Sqr(Xc) + A2 * Sqr(C - Yc) - A2 * B2);
    if d > 0 then
    begin
      if (Abs(LineAngle) < Pi / 2) xor Backward then
        X := (-b + Sqrt(d)) / a
      else
        X := (-b - Sqrt(Sqr(b) - a * (B2 * Sqr(Xc) + A2 * Sqr(C - Yc) - A2 * B2))) / a;
      Y := M * X + C;
      Result := Point(Round(X), Round(Y));
    end;
  end;
end;