flexpath.pas

是一套创建矢量图形的VCL组件

     // Exchange indexes
     Index := FirstIndex;
     FirstIndex := NextIndex;
     NextIndex := Index;
     // Redefine IsLastFirst
     IsLastFirst := (NextIndex = FirstNode) and (FirstIndex = LastNode);
    end;
   end;
   // Define curve flag
   IsSegmentCurve := (FirstIndex < LastPoint) and
     (Types[FirstIndex+1] = ptControl);
   // Check index distance
   if not IsLastFirst and (Abs(NextIndex-FirstIndex) > 1) then
    if ((FirstIndex = FirstNode) and IsOutOfFigure) or
       not IsSegmentCurve or (NextIndex <> FirstIndex+3) then exit;
   // Calculate index to insert
   if IsOutOfFigure then begin
    if NextIndex < FirstIndex
     then Index := FirstIndex
     else Index := NextIndex;
   end else
   if IsLastFirst then
    Index := LastPoint+1
   else
    Index := NextIndex;
  end;
  FillChar(Nearest, SizeOf(Nearest), 0);
  Nearest.MinIndex := -1;
  if IsSegmentCurve then begin
   // Insert bezier curve node
   FillChar(Path, SizeOf(Path), 0);
   Path.Curvature := 1;
   Path.Func := pfOnLine;
   Path.CheckPoint := Point;
   Path.StrokeWidth := 0;
   Path.IsOnLine := false;
   Path.ScanLine := Nil;
   Path.Nearest := @Nearest;
   with Bezier do begin
    x0 := Points[FirstIndex+0].x;
    y0 := Points[FirstIndex+0].y;
    x1 := Points[FirstIndex+1].x;
    y1 := Points[FirstIndex+1].y;
    x2 := Points[FirstIndex+2].x;
    y2 := Points[FirstIndex+2].y;
    x3 := Points[NextIndex].x;
    y3 := Points[NextIndex].y;
    p0pos := 0;
    p3pos := 1;
   end;
   Path.p0 := Points[FirstIndex+0];
   ProcessSegment(Path, @Bezier);
   ChangePathCount(Points, Types, Index, 3);
   if Index < FirstIndex then inc(FirstIndex, 3);
   with Bezier do begin
    if Nearest.MinSqrDist <= StickThreshold*StickThreshold then begin
     Points[Index] := Nearest.Point;
     Ofs.x := 0;
     Ofs.y := 0;
    end else begin
     Points[Index] := Point;
     Ofs.x := Point.x - Nearest.Point.x;
     Ofs.y := Point.y - Nearest.Point.y;
    end;
    // Control points of FirstIndex
    Points[FirstIndex+1].x :=
      Round( (1-Nearest.CurvePos) * x0 + Nearest.CurvePos * x1 );
    Points[FirstIndex+1].y :=
      Round( (1-Nearest.CurvePos) * y0 + Nearest.CurvePos * y1 );
    Points[FirstIndex+2].x :=
      Round( CalcBezier(x0, x1, x2, Nearest.CurvePos) ) + Ofs.x;
    Points[FirstIndex+2].y :=
      Round( CalcBezier(y0, y1, y2, Nearest.CurvePos) ) + Ofs.y;
    // Control points of inserted point
    Points[Index+1].x :=
      Round( CalcBezier(x1, x2, x3, Nearest.CurvePos) ) + Ofs.x;
    Points[Index+1].y :=
      Round( CalcBezier(y1, y2, y3, Nearest.CurvePos) ) + Ofs.y;
    Points[Index+2].x :=
      Round( (1-Nearest.CurvePos) * x2 + Nearest.CurvePos * x3 );
    Points[Index+2].y :=
      Round( (1-Nearest.CurvePos) * y2 + Nearest.CurvePos * y3 );
    // Set types of inserted control points
    Types[Index+1] := ptControl;
    Types[Index+2] := ptControl;
   end;
  end else begin
   // Insert line node
   PointOnLine(Point, Points[FirstIndex], Points[NextIndex], 0, Nil, @Nearest);
   ChangePathCount(Points, Types, Index, 1);
   if Nearest.MinSqrDist <= StickThreshold*PixelScaleFactor
    then Points[Index] := Nearest.Point
    else Points[Index] := Point;
   if Index < FirstIndex then inc(FirstIndex);
  end;
  // Set type of inserted node
  if IsOutOfFigure and (Index > FirstIndex) then begin
   Types[FirstIndex] := ptNode;
   Types[Index] := ptEndNode;
  end else
  if IsLastFirst then begin
   Types[FirstIndex] := ptNode;
   Types[Index] := ptEndNodeClose;
  end else
   Types[Index] := ptNode;
  Result := Index;
 finally
  if InternalInfo and Assigned(Info) then Dispose(Info);
 end;
end;

function FindNearestPathSegment(const Points: TPointArray;
  const Types: TPointTypeArray; const Point: TPoint;
  var FirstIndex, NextIndex: integer; Info: PPathInfo = Nil): boolean;
var Nearest: TNearestPoint;
    FigIndex: integer;
    InternalInfo: boolean;
begin
 Result := false;
 InternalInfo := not Assigned(Info);
 try
  // Check path info
  if InternalInfo then begin
   New(Info);
   GetPathInfo(Points, Types, Info^);
  end;
  // Find nearest point
  FillChar(Nearest, SizeOf(Nearest), 0);
  Nearest.MinIndex := -1;
  PointOnPath(Points, Types, Point, True, False, 0, @Nearest, Info);
  if Nearest.MinIndex < 0 then exit;
  // Find figure
  FigIndex := GetFigureIndex(Info^, Nearest.MinIndex);
  if FigIndex < 0 then exit;
  // Define closest path segment
  with Info.Figures[FigIndex] do begin
   FirstIndex := Nearest.MinIndex;
   NextIndex := -1;
   if IsClosed then begin
    // Figure is closed
    if FirstIndex = LastNode then
     NextIndex := FirstNode
    else
    if Types[FirstIndex+1] = ptControl
     then NextIndex := FirstIndex+3
     else NextIndex := FirstIndex+1;
   end else
    // Figure is non-closed
    if FirstIndex = LastNode then begin
     if FirstIndex < LastPoint
      then NextIndex := FirstIndex+3
      else NextIndex := FirstIndex+1;
    end else
    if (FirstIndex = FirstNode) and
       (Nearest.Point.x = Points[FirstNode].x) and
       (Nearest.Point.y = Points[FirstNode].y) then
     NextIndex := FirstIndex-1
    else
    if Types[FirstIndex+1] = ptControl
     then NextIndex := FirstIndex+3
     else NextIndex := FirstIndex+1;
  end;
  Result := true;
 finally
  if InternalInfo and Assigned(Info) then Dispose(Info);
 end;
end;

function InsertNearestPoint(var Points: TPointArray;
  var Types: TPointTypeArray; const Point: TPoint;
  StickThreshold: integer = 0; Info: PPathInfo = Nil): integer;
var FirstIndex, NextIndex: integer;
    InternalInfo: boolean;
begin
 Result := -1;
 InternalInfo := not Assigned(Info);
 try
  // Check path info
  if InternalInfo then begin
   New(Info);
   GetPathInfo(Points, Types, Info^);
  end;
  // Find path segment
  if not FindNearestPathSegment(Points, Types, Point,
    FirstIndex, NextIndex, Info) then exit;
  // Insert new point
  Result := InsertPathPoint(Points, Types, FirstIndex, NextIndex, Point,
    StickThreshold, Info);
 finally
  if InternalInfo and Assigned(Info) then Dispose(Info);
 end;
end;

function GetEditPathCaps(const Points: TPointArray;
  const Types: TPointTypeArray; const Selected: TSelectedArray): TPathEditFuncs;
var i, Count, SelCount: integer;
    First, Second: record
     IsFirst: boolean;
     PointType: TPointType;
     Figure: integer;
    end;
    Figures: integer;
    IsPrevEnd: boolean;
begin
 Result := [];
 Count := Length(Selected);
 if (Count <> Length(Points)) or (Count <> Length(Types)) then exit;
 SelCount := 0;
 Figures := 0;
 IsPrevEnd := true;
 for i:=0 to Count-1 do begin
  if Selected[i] then begin
   // Check selected point
   inc(SelCount);
   if Types[i] = ptControl then begin
    Result := [pfOffset];
    exit;
   end;
   case SelCount of
    1: with First do begin
        IsFirst := IsPrevEnd;
        PointType := Types[i];
        Figure := Figures;
       end;
    2: with Second do begin
        IsFirst := IsPrevEnd;
        PointType := Types[i];
        Figure := Figures;
       end;
   end;
   if (i < Length(Points)-1) and (Types[i+1] = ptControl)
    then Include(Result, pfToLine)
    else Include(Result, pfToCurve);
   if Types[i] = ptNode then Include(Result, pfBreak);
  end;
  // Check end of figure in path
  case Types[i] of
   ptNode:
     IsPrevEnd := false;
   ptEndNode,
   ptEndNodeClose:
     begin
      IsPrevEnd := true;
      inc(Figures);
     end;
  end;
 end;
 // Define pfJoin and pfClose capabilities
 if (SelCount = 2) and
     ( (First.IsFirst and (Second.PointType = ptEndNode)) or
       ((First.PointType = ptEndNode) or Second.IsFirst) ) then begin
  Include(Result, pfJoin);
  Include(Result, pfClose);
 end;
 if SelCount > 0 then begin
  Include(Result, pfOffset);
  //Include(Result, pfDelete);
 end;
end;

function EditPath(var Points: TPointArray; var Types: TPointTypeArray;
  const Selected: TSelectedArray; Func: TPathEditFunc;
  Params: PPathEditParams = Nil): boolean;
type
 TFigure = record
  FirstNode: integer;
  EndNode: integer;
  LastPoint: integer;
 end;
var
 Index, BreakIndex, NodeIndex, LastIndex, FirstIndex: integer;
 First, Second: TFigure;
 Temp: array of byte;
 Count, DeltaCount, MoveCount, Size: integer;
 Error, SameFigure, NeedMove: boolean;
 p0, p1, CtrlPointA, CtrlPointB: TPoint;

 function CalcFigure(Index: integer; var Figure: TFigure): boolean;
 begin
  with Figure do begin
   if Types[Index] = ptEndNode then begin
    // It is last point in figure. Find first point
    EndNode := Index;
    FirstNode := Index;
    repeat
     dec(Index);
     if Index < 0 then break;
     if Types[Index] = ptNode then FirstNode := Index;
    until Types[Index] in [ptEndNode, ptEndNodeClose];
    Result := true;
   end else begin
    // It is first point in figure. Find last point
    FirstNode := Index;
    EndNode := Index;
    repeat
     inc(EndNode);
    until (EndNode = Count) or (Types[EndNode] in [ptEndNode, ptEndNodeClose]);
    Result := EndNode < Count; // check error in point types
   end;
   if not Result then exit;
   LastPoint := EndNode +1;
   while (LastPoint < Count) and (Types[LastPoint] = ptControl) do
    inc(LastPoint);
   dec(LastPoint);
  end;
 end;

 procedure ReverseFigureDirection(var Figure: TFigure);
 var i: integer;
     TempPoint: TPoint;
     TempType: TPointType;
     Count: integer;
 begin
  with Figure do begin
   Count := LastPoint - FirstNode +1;
   if Count <= 1 then exit;
   for i:=0 to (Count div 2)-1 do begin
    TempPoint := Points[FirstNode+i];
    Points[FirstNode+i] := Points[LastPoint-i];
    Points[LastPoint-i] := TempPoint;
    TempType := Types[FirstNode+i];
    Types[FirstNode+i] := Types[LastPoint-i];
    Types[LastPoint-i] := TempType;
   end;
   Types[EndNode] := Types[FirstNode];
   Types[FirstNode] := ptNode;
   Result := true; // Points changed
  end;
 end;

 procedure ChangeCount(Index, Delta: integer);
 begin
  if Delta > 0 then begin
   SetLength(Points, Count + Delta);
   SetLength(Types, Count + Delta);
  end else
   dec(Index, Delta);
  Move(Points[Index], Points[Index+Delta], (Count - Index) * SizeOf(Points[0]));
  Move(Types[Index], Types[Index+Delta], (Count - Index) * SizeOf(Types[0]));
  if Delta < 0 then begin
   SetLength(Points, Count + Delta);
   SetLength(Types, Count + Delta);
  end;
  inc(Count, Delta);
  Result := true; // Points changed
 end;

begin
 Temp := Nil;
 Result := Func in GetEditPathCaps(Points, Types, Selected);
 if not Result then exit;
 Result := false;
 Count := Length(Selected);
 if (Count <> Length(Points)) or (Count <> Length(Types)) then exit;
 case Func of
  pfOffset:
    if Assigned(Params) then with Params^ do
     if not Params.MoveControls then begin
      for Index:=0 to Count-1 do
       if Selected[Index] then begin
        inc(Points[Index].x, Offset.x);
        inc(Points[Index].y, Offset.y);
        Result := true; // Points changed
       end;
     end else begin
      BreakIndex := 0;
      FirstIndex := -1;
      NodeIndex := -1;
      for Index:=0 to Count-1 do begin
       if Index = BreakIndex then FirstIndex := Index;
       if Types[Index] <> ptControl then begin
        NodeIndex := Index;
        if Types[Index] in [ptEndNode, ptEndNodeClose] then
         if (Index < Count-1) and (Types[Index+1] = ptControl)
           then BreakIndex := Index + 3
           else BreakIndex := Index + 1;
       end;