sglines.pas

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

{ TsgLines.AddCurve

  Creates the points-list for drawing a curve}
procedure TsgLines.AddCurve(SingPts, DottedSingPts: TList; Close: Boolean);
var
  X1, X2, Y1, Y2, Z1, Z2, DX, DY, DZ, Cur, TotalCur, Len, PartLineLength: Double;
  Beginning, AdditionCur, isTooManyDottedLines: Boolean;
  AmountPatterns, CounterPatterns, I, vTicksCount: Integer;
  LineLength: Single;
  Lengths: TList;
  vPFPoint, P1, P2: PFPoint;

  procedure AddPt(Current: Double; SegmentLen: Single; ChangeFIndex: Boolean);
  begin
    if ChangeFIndex then
    begin
      Inc(FIndex);
      if FIndex > vTicksCount - 1 then
      begin
        FIndex := 0;
        Inc(CounterPatterns);// one pattern has been added
      end;
    end;
    New(vPFPoint);
    vPFPoint^.X := X1 + DX * Current / SegmentLen;
    vPFPoint^.Y := Y1 + DY * Current / SegmentLen;
    vPFPoint^.Z := Z1 + DZ * Current / SegmentLen;
    DottedSingPts.Add(vPFPoint);
  end;

begin
  vTicksCount := (FTicks.Count shr 1) shl 1;

  isTooManyDottedLines := False;
  // Length of a pattern
  FPatternLength := 0.0;
  for I := 0 to (vTicksCount - 1) do
    FPatternLength := FPatternLength + Abs(Ticks[I]);

  if Close then//  Addition of the first point of a curve
  begin
    New(vPFPoint);
    vPFPoint^.X := PFPoint(SingPts.Items[0])^.X;
    vPFPoint^.Y := PFPoint(SingPts.Items[0])^.Y;
    vPFPoint^.Z := PFPoint(SingPts.Items[0])^.Z;
    SingPts.Add(vPFPoint);
  end;
  Len := 0.0;
  // Creates the lengths-list of segments of this "polyline"
  Lengths:= TList.Create;
  try
    P1 := PFPoint(SingPts.Items[SingPts.Count - 1]);
    for I := SingPts.Count - 2 downto 0 do
    begin
      P2 := PFPoint(SingPts.Items[I]);
      if (P1^.X = P2^.X) and (P1^.Y = P2^.Y) and (P1^.Z = P2^.Z) then
      begin
        Dispose(SingPts[I]);
        SingPts.Delete(I);
        Continue;
      end;
      LineLength := Sqrt((P2^.X - P1^.X) * (P2^.X - P1^.X) + (P2^.Y - P1^.Y) * (P2^.Y - P1^.Y)+ (P2^.Z - P1^.Z) * (P2^.Z - P1^.Z)) / FScale;
      Lengths.Add(Pointer(LineLength));
      Len := Len + LineLength;
      P1 := PFPoint(SingPts.Items[I]);
      isTooManyDottedLines := isTooManyDottedLines or (LineLength > iMaxNumDottedLines * FPatternLength);
    end;

    if SingPts.Count < 2 then
    begin
      New(vPFPoint);
      vPFPoint^ := PFPoint(SingPts.Items[0])^;
      DottedSingPts.Add(vPFPoint);
      New(vPFPoint);
      vPFPoint^ := PFPoint(SingPts.Items[0])^;
      DottedSingPts.Add(vPFPoint);
      Exit;
    end;

    if isTooManyDottedLines then
    begin
      for I := 0 to SingPts.Count - 1 do
      begin
        if I > 1 then
        begin
          New(vPFPoint);
          vPFPoint^ := PFPoint(SingPts.Items[I-1])^;
          DottedSingPts.Add(vPFPoint);
        end;
        New(vPFPoint);
        vPFPoint^ := PFPoint(SingPts.Items[I])^;
        DottedSingPts.Add(vPFPoint);
      end;
      Exit;
    end;

    // Amount of patterns in the "polyline"
    AmountPatterns := SGFloor(Len / FPatternLength);
    // Length of a part of a line
    // (Ticks[0] is a "solid" component of the line)

    if not FIsUniform then
      PartLineLength := (Ticks[0] + (Len - AmountPatterns * FPatternLength)) / 2
    else
      PartLineLength := Ticks[0];

    FIndex := -1;
    I := 0;
    P1 := SingPts.Items[I];
    P2 := SingPts.Items[I+1];
    LineLength := Single(Lengths.Items[Lengths.Count - 1 - I]);
    X1 := P1^.X;  X2 := P2^.X;
    Y1 := P1^.Y;  Y2 := P2^.Y;
    Z1 := P1^.Z;  Z2 := P2^.Z;
    DX := X2 - X1;
    DY := Y2 - Y1;
    DZ := Z2 - Z1;
    Cur := 0;
    TotalCur := 0;
    Beginning:= True;
    AdditionCur := True;
    CounterPatterns := 0;

    AddPt(0, LineLength, True);// adding of a starting point
    while True do
    begin
      if AdditionCur then
      begin
        if Beginning or (CounterPatterns = AmountPatterns) then
        begin
          if Ticks[0] = 0 then       // For "ISO dot"-linetypes
          begin
            AddPt(Cur, LineLength, True);
            if (CounterPatterns = AmountPatterns) or (AmountPatterns = 1) then
            begin
              P2 := SingPts.Items[SingPts.Count - 1];
              X1 := P2.X;
              Y1 := P2.Y;
              Z1 := P2.Z;
              // When the first argument a zero, the second argument is not important
              AddPt(0, LineLength, False);
              AddPt(0, LineLength, False);
              Exit;
            end;
            Inc(CounterPatterns);
            Cur := Cur + Abs(Ticks[FIndex]);
          end;
          Cur := Cur + PartLineLength;
          Beginning := False;
        end
        else
          Cur := Cur + Abs(Ticks[FIndex]);
      end;
      if Cur < LineLength then
      begin
        AddPt(Cur, LineLength, True);
        AdditionCur := True;
      end
      else
      begin
        if Beginning or (FIndex mod 2 = 0) then
        begin
          // Two points for continuation of a line
          AddPt(LineLength, LineLength, False);
          AddPt(LineLength, LineLength, False);
        end;

        TotalCur := TotalCur + LineLength;
        if Abs(TotalCur - Len) < fAccuracy then Break;// i.e. if TotalCur >= Len

        // Proceed to next point
        Cur := Cur - LineLength;
        Inc(I);
        P1 := SingPts.Items[I];
        P2 := SingPts.Items[I+1];
        LineLength := Single(Lengths.Items[Lengths.Count - 1 - I]);
        X1 := P1^.X;  X2 := P2^.X;
        Y1 := P1^.Y;  Y2 := P2^.Y;
        Z1 := P1^.Z;  Z2 := P2^.Z;
        DX := X2 - X1;
        DY := Y2 - Y1;
        DZ := Z2 - Z1;
        AdditionCur := False;
      end;
    end;
  finally
    if (DottedSingPts.Count > 0) and (DottedSingPts.Count mod 2 <> 0) then
    begin
      Dispose(DottedSingPts[DottedSingPts.Count-1]);
      DottedSingPts.Delete(DottedSingPts.Count-1);
    end;
    Lengths.Free;
  end;
end;

{ TsgLines.Curve

  Creates points-list for the dotted-curve}
procedure TsgLines.Curve(SingPts, DottedSingPts: TList; Close: Boolean);
begin
  // Error: for solid lines; for drawing the first list is used
  if IsSolid then
    raise EListError.Create('TsgLines.Curve: FTicks.Count <= 1');
  Reset;
  if DottedSingPts.Count > 0 then
    raise EListError.Create('TsgLines.Curve: DottedSingPts.Count > 0');
  //DottedSingPts.Clear;
  AddCurve(SingPts, DottedSingPts, Close);
end;

procedure TsgLines.AddPoly(SingPts, DottedSingPts: TList; Close: Boolean);
var
  I: Integer;
  Pt1, Pt2: TFPoint;
  PSingPt: PFPoint;
begin
  if Close then//  Addition of the first point of a curve
  begin
    New(PSingPt);
    PSingPt^.X := PFPoint(SingPts.Items[0])^.X;
    PSingPt^.Y := PFPoint(SingPts.Items[0])^.Y;
    PSingPt^.Z := PFPoint(SingPts.Items[0])^.Z;
    SingPts.Add(PSingPt);
  end;
  for I := 0 to SingPts.Count - 2 do
  begin
    Pt1 := PFPoint(SingPts.Items[I])^;
    Pt2 := PFPoint(SingPts.Items[I+1])^;
    if (I <> 0) and (Pt1.X = Pt2.X) and (Pt1.Y = Pt2.Y) and (Pt1.Z = Pt2.Z) then
      Continue;
    AddLine(Pt1, Pt2, DottedSingPts);
  end;
end;

procedure TsgLines.SetScale(const Value: Double);
begin
  FScale := Abs(Value);
  if FScale < fAccuracy then
    FScale := 1.0;
end;

{ TsgLines.Line

  Creates a points-list for a dotted-line}
procedure TsgLines.Line(Pt1, Pt2: TFPoint; DottedSingPts: TList);
begin
  //Exit for solid line, for drawing the first list is used
  if IsSolid then
    raise EListError.Create('TsgLines.Line: FTicks.Count <= 1');
  Reset;
  if DottedSingPts.Count > 0 then
    raise EListError.Create('TsgLines.Line: DottedSingPts.Count > 0');
  AddLine(Pt1, Pt2, DottedSingPts);
end;

{ TsgLines.HatchLine

  Creates a points-list for a dotted-line of hatch}
procedure TsgLines.HatchLine(Pt1, Pt2, BasePt: TFPoint; DottedSingPts: TList);
begin
  //Exit for solid line, for drawing the first list is used
  if IsSolid then
    raise EListError.Create('TsgLines.Line: FTicks.Count <= 1');
  Reset;
  if DottedSingPts.Count > 0 then
    raise EListError.Create('TsgLines.Line: DottedSingPts.Count > 0');
  AddHatchLine(Pt1, Pt2, BasePt, DottedSingPts);
end;

{ TsgLines.Poly

  Creates a points-list for a dotted-polyline}
procedure TsgLines.Poly(SingPts, DottedSingPts: TList; Close: Boolean);
begin
  //Exit for solid lines, for drawing the first list is used
  if IsSolid then
    raise EListError.Create('TsgLines.Poly: FTicks.Count <= 1');
  Reset;
  if DottedSingPts.Count > 0 then
    raise EListError.Create('TsgLines.Poly: DottedSingPts.Count > 0');
  AddPoly(SingPts, DottedSingPts, Close);
end;

procedure TsgLines.Clear;
begin
  FTicks.Clear;
end;

{ TsgLines.AddTick

  Adds the new line element. }
procedure TsgLines.AddTick(Value: Single);
var
  S: Single;
begin
  S := Value;// * Self.FScale;
  FTicks.Add(Pointer(S));
end;

procedure TsgLines.AddTicks(const AParts: array of Single);
var
  I: Integer;
begin
  for I := Low(AParts) to High(AParts) do
    FTicks.Add(Pointer(AParts[I]));
end;

procedure TsgLines.Assign(ASource: TsgLines);
  procedure LocAssign(AList, ALocSource: TList);
  var
    I: Integer;
  begin
    AList.Clear;
    AList.Capacity := ALocSource.Capacity;
    for I := 0 to ALocSource.Count - 1 do
      AList.Add(ALocSource[I]);
  end;
begin
  Self.FScale := ASource.FScale;
  Self.FIndex := ASource.FIndex;
  //Self.IsSolid := Self.IsSolid;
  Self.FPatternLength := ASource.FPatternLength;
  LocAssign(Self.FTicks, ASource.FTicks);
end;

procedure TsgLines.Check;
var
  I: Integer;
begin
  for I := 0 to FTicks.Count - 1 do
    if FTicks[I] <> nil then Exit;
  FTicks.Count := 0;
end;

{ DrawPolyPolyLine

  Draws a polyline on points of the prepared list
  (list consists of PPoint-points).                 }
procedure DrawPolyPolyLine(DC: HDC; IntPoints: TList);
var
  Points: TList;
  I, N, C: Integer;
  P: Pointer;
  Pt1, Pt2, PtPrev: TPoint;
  isPrevDot: Boolean;
begin
  if DC = 0 then Exit;
  Points := TList.Create;
  try
    isPrevDot:= False;
    I := 0;
    while I < IntPoints.Count -1 do
    begin
      Pt1 :=  PPoint(IntPoints.Items[I])^;
      Pt2 :=  PPoint(IntPoints.Items[I+1])^;
      // For correct drawing and scaling dots
      if (Pt2.X = Pt1.X) and (Pt2.Y = Pt1.Y) then
      begin
        // If the current dot equally with previous dot
        if isPrevDot and (PtPrev.X = Pt1.X) and (PtPrev.Y = Pt1.Y) then
        begin
          Inc(I, 2);
          Continue;// miss of identical points
        end;
        PtPrev.X := Pt1.X;
        PtPrev.Y := Pt1.Y;
        Pt2.Y := Pt2.Y + 1;
        isPrevDot:= True;
      end
      else
        isPrevDot:= False;
      Points.Add(Pointer(Pt1.X));
      Points.Add(Pointer(Pt1.Y));
      Points.Add(Pointer(Pt2.X));
      Points.Add(Pointer(Pt2.Y));
      Inc(I, 2);
    end;
    N := Points.Count shr 2;
    if N = 0 then Exit;
    C := Points.Count;
    for I := 0 to N - 1 do
      Points.Add(Pointer(2));
    P := Points.List;
    Inc(PInteger(P), C);
    PolyPolyline(DC, Points.List^, P^, N);
  finally
    Points.Free;
  end;
end;

{ DrawPolyLine

  Draws a only solid polyline on points of the prepared list
  (list consists of PPoint-points).                 }
procedure DrawPolyLine(DC: HDC; IntPoints: TList);
var
  Points: TList;
  I: Integer;
  Pt, PtPrev: TPoint;
begin
  if DC = 0 then Exit;
  Points := TList.Create;
  try
    for I := 0 to IntPoints.Count - 1 do
    begin
      Pt := PPoint(IntPoints.Items[I])^;
      if (I <> 0) and (PtPrev.X = Pt.X) and (PtPrev.Y = Pt.Y) then
        Continue;// miss of identical points
      Points.Add(Pointer(Pt.X));
      Points.Add(Pointer(Pt.Y));
      PtPrev.X := Pt.X;
      PtPrev.Y := Pt.Y;
    end;
    Windows.Polyline(DC, Points.List^, Points.Count shr 1);
  finally
    Points.Free;
  end;
end;

end.