main.pas

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

    I: Integer;
    Ni: Double;
  begin
    Result.X := 0;
    Result.Y := 0;
    Result.Z := 0;
    for I := Index - 3 to Index do
    begin
      Ni := Normalize(3, I, Param);
      Result.X := Result.X + PFPoint(ControlPoints[I]).X * Ni;
      Result.Y := Result.Y + PFPoint(ControlPoints[I]).Y * Ni;
      Result.Z := Result.Z + PFPoint(ControlPoints[I]).Z * Ni;
    end;
  end;

  procedure AddPt(const Pt: TFPoint);
  var
    C: Integer;
    P: PInteger;
  begin
    C := Result.Count;
    Result.Count := Result.Count + cnstFPointSize;
    P := PInteger(Result.List);
    Inc(P,C);
    Move(Pt, P^, SizeOf(TFPoint));
  end;

var
  I: Integer;
  P, Prev: TFPoint;
  T: Double;
begin
  Result := TList.Create;
  P := PFPoint(ControlPoints[0])^;
  AddPt(P);
  Prev := P;
  for I := 3 to ControlPoints.Count - 1 do
  begin
    T := Single(Knots[I]);
    while  T < Single(Knots[I + 1]) do
    begin
      P := GetNURBS(I, T);
      T := T + 0.1; // the smaller value (for instance 0.01) the higher quality
      if (ChordLen > 0) and (abs(P.X - Prev.X) < ChordLen) and (abs(P.Y - Prev.Y) < ChordLen)
      then Continue;
      AddPt(P);
      Prev := P;
    end;
  end;
  P := PFPoint(ControlPoints[ControlPoints.Count - 1])^;
  AddPt(P);
end;

{ DrawSpline

  Draws a spline.  }
procedure DrawSpline;
var
  I: Integer;
  S: Single;
  ControlPoints, FitPoints, Knots, vList: TList;
  P, vP: PFPoint;
  SingPoints, IntPoints, DottedSingPoints: TList;
  PSinglePt: PFPoint;

  procedure DrawCurrentSpline;
  var I: Integer;
  begin
    if fmCADDLLdemo.cbUseWinLine.Checked then // Global coordinates
    begin
      if Lines.IsSolid then DrawGlobal(SingPoints, Lines.IsSolid)
      else begin
        Lines.Curve(SingPoints, DottedSingPoints, False);
        DrawGlobal(DottedSingPoints, False);
      end;
    end
    else                                   // Display coordinates
    begin
      IntPoints := TList.Create;
      if Lines.IsSolid then begin
        GetPointsList(SingPoints, IntPoints);
        DrawPolyLine(PCanvas.Handle, IntPoints);
      end
      else begin
        Lines.Curve(SingPoints, DottedSingPoints, False);
        GetPointsList(DottedSingPoints, IntPoints);
        DrawPolyPolyLine(PCanvas.Handle, IntPoints);
      end;
      for I := 0 to IntPoints.Count - 1 do Dispose(IntPoints[I]);
      IntPoints.Free;
    end;
  end;
begin
  SingPoints := TList.Create;
  DottedSingPoints := TList.Create;
  ControlPoints := TList.Create;
  FitPoints := TList.Create;
  Knots := TList.Create;
  try
    P := EData.Points;
    for I := 0 to EData.Count - 1 do begin
      New(vP);
      vP^ := P^;
      ControlPoints.Add(vP);
      {$IFDEF NOTDRAWSPLINE}
      New(PSinglePt);
      PSinglePt^.X := vP^.X;
      PSinglePt^.Y := vP^.Y;
      PSinglePt^.Z := vP^.Z;
      SingPoints.Add(PSinglePt);
      {$ENDIF}
      Inc(P);
    end;
    {$IFDEF NOTDRAWSPLINE}
    DrawCurrentSpline;
    Exit;
    {$ENDIF}
    for I := 0 to PInteger(P)^ - 1 do begin
      Inc(P);
      New(vP);
      vP^ := P^;
      FitPoints.Add(vP);
    end;
    Inc(P);
    for I := 0 to PInteger(P)^ - 1 do begin
      Inc(P);
      S := P.X;
      Knots.Add(Pointer(S));
    end;
    if FitPoints.Count > ControlPoints.Count then begin
      vList := TList.Create;
      try
        for I := 0 to FitPoints.Count - 1 do begin
//          vList.Add(Pointer(PFPoint(FitPoints[I]).X));
//          vList.Add(Pointer(PFPoint(FitPoints[I]).Y));
//          vList.Add(Pointer(PFPoint(FitPoints[I]).Z));
          New(PSinglePt);
          PSinglePt^.X := PFPoint(FitPoints[I]).X;
          PSinglePt^.Y := PFPoint(FitPoints[I]).Y;
          PSinglePt^.Z := PFPoint(FitPoints[I]).Z;
          SingPoints.Add(PSinglePt);
        end;
        EData.Points := PFPoint(vList.List);
        EData.Count := FitPoints.Count;
        DrawCurrentSpline;
      finally
        vList.Free;
      end;
      Exit;
    end;
    vList := GetSpline(ControlPoints, FitPoints, Knots, 0);
    try
      EData.Points := PFPoint(vList.List);
      EData.Count := vList.Count div cnstFPointSize;
      P := EData.Points;
      for I := 0 to EData.Count-1 do begin
        New(PSinglePt);
        PSinglePt^.X := P^.X;
        PSinglePt^.Y := P^.Y;
        PSinglePt^.Z := P^.Z;
        SingPoints.Add(PSinglePt);
        Inc(P);
      end;
      DrawCurrentSpline;
    finally
      vList.Free;
    end;
  finally
    // Clearing memory
    for I := 0 to DottedSingPoints.Count - 1 do Dispose(DottedSingPoints[I]);
    for I := 0 to ControlPoints.Count - 1 do Dispose(ControlPoints[I]);
    for I := 0 to SingPoints.Count - 1 do Dispose(SingPoints[I]);
    for I := 0 to FitPoints.Count - 1 do Dispose(FitPoints[I]);
    DottedSingPoints.Free;
    ControlPoints.Free;
    SingPoints.Free;
    FitPoints.Free;
    Knots.Free;
  end;
end;

{ DrawText

  Draws a text. }
procedure DrawText;
var
  P: TPoint;
  vFontName: string;

  procedure DoFontFromData;
  var
    I, Len: Integer;
    vLogFont: TLogFont;
  begin
    GetObject(PCanvas.Font.Handle, SizeOf(vLogFont), @vLogFont);
    FillChar(vLogFont.lfFaceName, LF_FACESIZE, 0);
    vFontName := string(EData.FontName);
    Len := Length(vFontName);
    if Len = 0 then
      vLogFont.lfFaceName := 'Arial'
    else// setting real TrueType font
    begin
      for I := 0 to LF_FACESIZE - 1 do
        if (I < Len) and (vFontName[I + 1] <> '.') then
          vLogFont.lfFaceName[I] := vFontName[I + 1]
        else
          Break;
    end;
    vLogFont.lfHeight := Round(fWinTextHeightFactor * EData.FHeight * fmCADDLLdemo.FScale / 100);
    if vLogFont.lfHeight = 0 then vLogFont.lfHeight := 1;
    vLogFont.lfWidth := Abs(Round(0.64 * EData.FHeight * EData.FScale * fmCADDLLdemo.FScale / 100));
    if vLogFont.lfWidth = 0 then vLogFont.lfWidth := 1;
    vLogFont.lfEscapement := Round(EData.Rotation * 10);	// in tenths of degrees
    while vLogFont.lfEscapement < 0 do
      Inc(vLogFont.lfEscapement, 3600);
    vLogFont.lfOrientation := vLogFont.lfEscapement;
    PCanvas.Font.Handle := CreateFontIndirect(vLogFont);
  end;
begin
  if EData.HAlign in [1,2,4] then
    P := GetPoint(EData.Point1)
  else
    P := GetPoint(EData.Point);
  PCanvas.Font.Color := PCanvas.Pen.Color;
  DoFontFromData;
  SetTextAlign(PCanvas.Handle, TA_BASELINE);
  PCanvas.Brush.Style := bsClear;
  PCanvas.TextOut(P.X, P.Y, String(EData.Text));
end;

{ DrawArcAsPoly

  Draws a arc as poplyline. }
procedure DrawArcAsPoly(const P0,P1,P2,P3: TFPoint);
const
  NSegs = 16; // Number of segments for full ellipse
var
  CX,CY,A,B,AStart,AEnd,Delta: Double;
  S,C: Extended;        // Sin and Cos of current angle
  I,N: Integer;
  P: TFPoint;
  SingPoints, IntPoints, DottedSingPoints: TList;
  PSinglePt: PFPoint;

  function Angle(const Pt: TFPoint): Extended;
  begin
    Result := ArcTan2(Pt.Y - CY, Pt.X - CX);
    if Result < 0 then Result := Result + Pi;
    if Pt.Y < CY then Result := Result + Pi;
  end;

begin
  SingPoints := TList.Create;
  DottedSingPoints := TList.Create;

  CX := (P0.X + P1.X) / 2;      // Center X
  CY := (P0.Y + P1.Y) / 2;      // Center Y
  A := (P1.X - P0.X) / 2;       // Horizontal radius
  B := (P0.Y - P1.Y) / 2;       // Vertical radius
  AStart := Angle(P2);          // Start angle
  AEnd := Angle(P3);            // End angle

  if AEnd <= AStart then AEnd := AEnd + 2*Pi;
  N := Round((AEnd-AStart)/Pi*NSegs);   // Real number of segments depends on arc angle
  if N < 4 then N := 4;
  Delta := (AEnd-AStart)/(N-1);

  for I:=0 to N-1 do
  begin
    SinCos(AStart,S,C);
    P.X := CX + A*C;                    // Current segment X
    P.Y := CY + B*S;                    // Current segment Y

    New(PSinglePt);
    PSinglePt^.X := P.X;
    PSinglePt^.Y := P.Y;
    PSinglePt^.Z := 0.0;// for future version
    SingPoints.Add(PSinglePt);
    AStart := AStart + Delta;           // Next segment
  end;

  if fmCADDLLdemo.cbUseWinLine.Checked then // Global coordinates
  begin
    if Lines.IsSolid then
      DrawGlobal(SingPoints, Lines.IsSolid)
    else
    begin
      Lines.Curve(SingPoints, DottedSingPoints, False);
      DrawGlobal(DottedSingPoints, Lines.IsSolid);
    end;
  end
  else
  begin
    IntPoints := TList.Create;
    if Lines.IsSolid then
    begin
      GetPointsList(SingPoints, IntPoints);
      DrawPolyLine(PCanvas.Handle, IntPoints);
    end
    else
    begin
      Lines.Curve(SingPoints, DottedSingPoints, False);
      GetPointsList(DottedSingPoints, IntPoints);
      DrawPolyPolyLine(PCanvas.Handle, IntPoints);
    end;
    for I := 0 to IntPoints.Count - 1 do
      Dispose(IntPoints[I]);
    IntPoints.Free;
  end;

  for I := 0 to DottedSingPoints.Count - 1 do
    Dispose(DottedSingPoints[I]);
  DottedSingPoints.Free;
  for I := 0 to SingPoints.Count - 1 do
    Dispose(SingPoints[I]);
  SingPoints.Free;
end;

{ DrawArc

  Draws a arc.
  EData.Point, EData.Point1 - bounding rectangle
  EData.Point2 - starting point
  EData.Point3 - ending point
  For full ellipse, Point2 = Point3.             }
procedure DrawArc;
var
  P,P1,P2,P3: TPoint;
  vRect: TRect;
  vRatio, vMajorLength: Single;
begin
  if fmCADDLLdemo.cbSplitArcs.Checked then
  begin
    DrawArcAsPoly(EData.Point, EData.Point1, EData.Point2, EData.Point3);
    Exit;
  end;
  P := GetPoint(EData.Point);
  P1 := GetPoint(EData.Point1);
  P2 := GetPoint(EData.Point2);
  P3 := GetPoint(EData.Point3);
  //Windows.SetArcDirection(PCanvas.Handle, AD_COUNTERCLOCKWISE);
  if ((EData^.Point2.X <> EData^.Point3.X)
    or (EData^.Point2.Y <> EData^.Point3.Y)) and (P2.X = P3.X)
    and (P2.Y = P3.Y) then
  begin
    SetPixelV(PCanvas.Handle, P2.X, P2.Y, PCanvas.Pen.Color);
    Exit;
  end;
  if (fmCADDLLdemo.cbProhibitArcsAsCurves.Checked) and (EData.EntityType=1) then
  begin
    vRatio := EData.Ratio;
    P := GetPoint(EData.Point);
    P1 := GetPoint(MakeFPoint(EData.Point.X + EData.Point1.X, EData.Point.Y + EData.Point1.Y, 0));
    vMajorLength := Sqrt(Sqr(P1.X - P.X) + Sqr(P1.Y - P.Y));
    vRect.Left := P.X - Round(vMajorLength);
    vRect.Top := P.Y + Round(vMajorLength * vRatio);
    vRect.Right := P.X + Round(vMajorLength);
    vRect.Bottom := P.Y - Round(vMajorLength * vRatio);
    PCanvas.Arc(vRect.Left, vRect.Top, vRect.Right, vRect.Bottom, P2.X, P2.Y, P3.X, P3.Y);
  end
  else
    PCanvas.Arc(P.X, P1.Y, P1.X, P.Y, P2.X, P2.Y, P3.X, P3.Y);
end;

{ DrawHatch

  Draws a hatch.
  EData.Count - number of polyline vertices
  EData.Points - pointer to point array }
procedure DrawHatch;
var
  I, SaveIndex, Index: Integer;
  P: PFPoint;
  PSinglePt: PFPoint;
  vPoly, SingPoints: TList;
  vRgn, vMainRGN: HRGN;
  P1: TPoint;
begin
  if EData.Flags and 16 <> 0 then             // hatch is SOLID
  begin
    vPoly := TList.Create;
    vMainRGN := CreateRectRgn(0, 0, 0, 0);// FCanvas.ClipRect.Right, FCanvas.ClipRect.Bottom);
    SaveIndex := SaveDC(PCanvas.Handle);
    try
      P := EData.Points;
      Index := 0;
      for I := 0 to EData.Count do
      begin
        if Index = I then
        begin
          Inc(Index, PInteger(P)^ + 1);
          if I <> 0 then
          begin
            vRGN := CreatePolygonRgn(vPoly.List^, vPoly.Count shr 1, ALTERNATE);
            CombineRgn(vMainRGN, vRGN, vMainRGN,  RGN_XOR);
            DeleteObject(vRGN);
            vPoly.Clear;
          end
        end
        else
        begin
          P1 := GetPoint(P^);
          vPoly.Add(Pointer(P1.X));
          vPoly.Add(Pointer(P1.Y));
        end;
        Inc(P);
      end;
      GetRegionData(vMainRgn,0,nil);
      PCanvas.Brush.Style := bsSolid;
      PCanvas.Brush.Color := EData.Color;
      FillRgn(PCanvas.Handle, vMainRGN, PCanvas.Brush.Handle);
    finally
      RestoreDC(PCanvas.Handle, SaveIndex);
      DeleteObject(vMainRGN);
      vPoly.Free;
    end;
    Exit;
  end;
  SingPoints := TList.Create;
  P := EData.DashDots;
  for I := 0 to EData.DashDotsCount - 1 do
  begin
    New(PSinglePt);
    PSinglePt^.X := P^.X;
    PSinglePt^.Y := P^.Y;
    PSinglePt^.Z := P^.Z;
    SingPoints.Add(PSinglePt);
    Inc(P);
  end;
  DrawGlobal(SingPoints, False);
  // Clearing memory
  for I := 0 to SingPoints.Count - 1 do
    Dispose(SingPoints[I]);
  SingPoints.Free;
end;

{ DrawImageEnt

  Draw a bmp image}
procedure DrawImageEnt;