formatcadfiles.pas

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

    New(PSinglePt);
    PSinglePt^ := P^;
    SingPoints.Add(PSinglePt);
    Inc(P);
  end;

  if FLines.IsSolid then
    Result := LoadCurveGlobal(SingPoints, FLines.IsSolid)
  else begin
    FLines.Poly(SingPoints, DottedSingPoints, False);
    Result := LoadCurveGlobal(DottedSingPoints, FLines.IsSolid);
  end;

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

function TFlexCADFormat.LoadSpline(Data: PcadData): TFlexCurve;
var
  I: Integer;
  S: Single;
  ControlPoints, FitPoints, Knots, vList: TList;
  P, vP: PFPoint;
  SingPoints, DottedSingPoints: TList;
  PSinglePt: PFPoint;
begin
  SingPoints := TList.Create;
  DottedSingPoints := TList.Create;
  ControlPoints := TList.Create;
  FitPoints := TList.Create;
  Knots := TList.Create;
  try
    P := Data.Points;
    for I := 0 to Data.Count - 1 do begin
      New(vP);
      vP^ := P^;
      ControlPoints.Add(vP);
      Inc(P);
    end;
    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;

    vList := Nil;
    try
      if FitPoints.Count > ControlPoints.Count then begin
        vList := TList.Create;
        for I := 0 to FitPoints.Count - 1 do begin
          New(PSinglePt);
          PSinglePt^.X := PFPoint(FitPoints[I]).X;
          PSinglePt^.Y := PFPoint(FitPoints[I]).Y;
          PSinglePt^.Z := PFPoint(FitPoints[I]).Z;
          SingPoints.Add(PSinglePt);
        end;
        Data.Points := PFPoint(vList.List);
        Data.Count := FitPoints.Count;
      end else begin
        vList := GetSpline(ControlPoints, FitPoints, Knots, 0);
        Data.Points := PFPoint(vList.List);
        Data.Count := vList.Count div cnstFPointSize;
        P := Data.Points;
        for I := 0 to Data.Count-1 do begin
          New(PSinglePt);
          PSinglePt^.X := P^.X;
          PSinglePt^.Y := P^.Y;
          PSinglePt^.Z := P^.Z;
          SingPoints.Add(PSinglePt);
          Inc(P);
        end;
      end;
    finally
      vList.Free;
    end;

    if FLines.IsSolid then
      Result := LoadCurveGlobal(SingPoints, FLines.IsSolid)
    else begin
      FLines.Curve(SingPoints, DottedSingPoints, False);
      Result := LoadCurveGlobal(DottedSingPoints, False);
    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;

function TFlexCADFormat.Load3DFace(Data: PcadData): TFlexCurve;

  procedure Edge(const P1, P2: TFPoint);
  begin
    Result.AddPoint(GetPoint(P1));
    Result.AddPoint(GetPoint(P2));
    Result.EndFigure(True);
  end;

begin
  Result := TFlexCurve.Create(FFlex, FFlex.ActiveScheme, FFlex.ActiveLayer);
  Result.BeginUpdate;
  try
    while Result.PointCount > 0 do Result.DeletePoint(0);
    if Data.Flags and 1 = 0 then Edge(Data.Point, Data.Point1);
    if Data.Flags and 2 = 0 then Edge(Data.Point1, Data.Point2);
    if Data.Flags and 4 = 0 then Edge(Data.Point2, Data.Point3);
    if Data.Flags and 8 = 0 then Edge(Data.Point3, Data.Point);
  finally
    Result.EndUpdate;
  end;
end;

function TFlexCADFormat.LoadArc(Data: PcadData): TFlexEllipse;
var
  P,P1,P2,P3: TPoint;
  R: TRect;

  function CalcAngle(X, Y: double; const Coeff: double): integer;
  var Angle: double;
  begin
    Y := Y * Coeff;
    if X = 0 then begin
     if Y > 0
      then Result := 90 * PixelScaleFactor
      else Result := 270 * PixelScaleFactor;
    end else begin
     Angle := 180.0 * ArcTan2(Y, X) / pi;
     if Angle < 0 then Angle := 360.0 + Angle;
     Result := Round(Angle * PixelScaleFactor);
    end;
  end;

  procedure SetAnglesByPoints(const P0, P1: TPoint; const DocRect: TRect);
  var HR, WR: double;
      Coeff: double;
  begin
    WR := Result.WidthProp.Value / 2;
    HR := Result.HeightProp.Value / 2;
    if HR = 0
     then Coeff := 0
     else Coeff := WR / HR;
    with DocRect do begin
      Result.BeginAngleProp.Value := CalcAngle(P0.X - Left - WR, HR - P0.Y + Top, Coeff);
      Result.EndAngleProp.Value   := CalcAngle(P1.X - Left - WR, HR - P1.Y + Top, Coeff);
    end;
  end;

begin
  P := GetPoint(Data.Point);
  P1 := GetPoint(Data.Point1);
  P2 := GetPoint(Data.Point2);
  P3 := GetPoint(Data.Point3);
  Result := TFlexEllipse.Create(FFlex, FFlex.ActiveScheme, FFlex.ActiveLayer);
  R := Rect(P.X, P.Y, P1.X, P1.Y);
  Result.DocRect := R;
  if (P2.X <> P3.X) or (P2.Y <> P3.Y) then
    SetAnglesByPoints(P2, P3, R);
end;

function TFlexCADFormat.LoadSolid(Data: PcadData): TFlexCurve;
var
  I: Integer;
  PSinglePt: PFPoint;
  SingPoints: TList;
begin
  SingPoints := TList.Create;
  New(PSinglePt);
  PSinglePt^ := Data.Point;
  SingPoints.Add(PSinglePt);
  New(PSinglePt);
  PSinglePt^ := Data.Point1;
  SingPoints.Add(PSinglePt);
  New(PSinglePt);
  PSinglePt^ := Data.Point2;
  SingPoints.Add(PSinglePt);
  New(PSinglePt);
  PSinglePt^ := Data.Point3;
  SingPoints.Add(PSinglePt);

  Result := LoadCurveGlobal(SingPoints, True);

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

{ DrawHatch

  Draws a hatch.
  EData.Count - number of polyline vertices
  EData.Points - pointer to point array }
function TFlexCADFormat.LoadHatch(Data: PcadData): TFlexCurve;
var
  I, Index: Integer;
  P: PFPoint;
begin
  Result := TFlexCurve.Create(FFlex, FFlex.ActiveScheme, FFlex.ActiveLayer);
  Result.BeginUpdate;
  try
    while Result.PointCount > 0 do Result.DeletePoint(0);
    if Data.Flags and 16 <> 0 then begin
      // hatch is SOLID
      P := Data.Points;
      Index := 0;
      for I := 0 to Data.Count - 1 do begin
        if Index = I then begin
          Inc(Index, PInteger(P)^ + 1);
          if I <> 0 then
            Result.EndFigure(True);
        end else
          Result.AddPoint(GetPoint(P^));
        Inc(P);
      end;
      Result.EndFigure(True);
    end;
  finally
    Result.EndUpdate;
  end;

{
  if Data.Flags and 16 <> 0 then begin        // hatch is SOLID
    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;
      I := 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;

function TFlexCADFormat.LoadText(Data: PcadData): TFlexText;
var
  P: TPoint;
  vFontName: string;
  I, Len: Integer;
  Bmp: TBitmap;
  tm: TTextMetric;
  ti: TTranslateInfo;
begin
  Result := TFlexText.Create(FFlex, FFlex.ActiveScheme, FFlex.ActiveLayer);
  if Data.HAlign in [1,2,4] then
    P := GetPoint(Data.Point1)
  else
    P := GetPoint(Data.Point);

  vFontName := string(Data.FontName);
  Len := Length(vFontName);
  if Len = 0 then
    vFontName := 'Arial'
  else begin // setting real TrueType font
    I := Pos('.', vFontName);
    if I > 0 then
      SetLength(vFontName, I - 1);
  end;
  with Result.FontProp do begin
    Name := vFontName;
    if Data.FHeight = 0 then
      Height := PixelScaleFactor
    else
      Height := Round(fWinTextHeightFactor * Data.FHeight * FScale / 100);
  end;
  Result.TextProp.Text := String(Data.Text);

  Bmp := TBitmap.Create;
  try
    Result.FontProp.Setup(Bmp.Canvas, 100 * PixelScaleFactor);
    GetTextMetrics(Bmp.Canvas.Handle, tm);
    dec(P.Y, tm.tmAscent);
  finally
    Bmp.Free;
  end;

  Result.DocRect := Rect(P.X, P.Y, P.X, P.Y);
  Result.AutoSizeProp.Value := True;

  Result.IsSelected := True;
  with Result.DocRect do
    ti.Center := Point(Left, Bottom);
  ti.Rotate := Round(Data.Rotation);
  if ti.Rotate < 0 then
    ti.Rotate := 360 - Abs(ti.Rotate) mod 360;
  ti.Mirror := False;
  FFlex.Translate(ti);
  Result.IsSelected := False;
end;

function TFlexCADFormat.LoadImage(Data: PcadData): TFlexPicture;
var
  MS: TMemoryStream;
  R: TRect;
begin
  Result := TFlexPicture.Create(FFlex, FFlex.ActiveScheme, FFlex.ActiveLayer);
  R.TopLeft := GetPoint(Data.Point1);
  R.BottomRight := GetPoint(Data.Point2);
  Result.DocRect := R;
  MS := TMemoryStream.Create;
  try
    MS.Write(Data.Ticks^, Data.Handle);
    MS.Position := 0;
    Result.PictureProp.LoadFromStream(MS);
  finally
    MS.Free;
  end;
end;

{ GetPoint

  Converts CADHandle units to pixels.}
function TFlexCADFormat.GetPoint(const P: TFPoint): TPoint;
begin
  Result.X := (FX + Round(P.X * FScale / 100));
  Result.Y := (FY - Round(P.Y * FScale / 100));
end;

{ DrawGlobal

  Draws a (poly)line in global coordinates. }
function TFlexCADFormat.LoadCurveGlobal(SPoints: TList; IsSolid: Boolean): TFlexCurve;
var
  I, N: Integer;
  Prev, PA, PB: TPoint;
  PDXF: TFPoint;
begin
  if SPoints.Count = 0 then
    Result := Nil // Error
  else begin
    Result := TFlexCurve.Create(FFlex, FFlex.ActiveScheme, FFlex.ActiveLayer);
    Result.BeginUpdate;
    try
      while Result.PointCount > 0 do Result.DeletePoint(0);
      N := 2;
      if IsSolid then
        N := 1;
      I := 0;
      while I < SPoints.Count -1 do begin
        PDXF.X := PFPoint(SPoints.Items[I])^.X;
        PDXF.Y := PFPoint(SPoints.Items[I])^.Y;
        PDXF.Z := PFPoint(SPoints.Items[I])^.Z;// for future version
        PA := GetPoint(PDXF);
        PDXF.X := PFPoint(SPoints.Items[I+1])^.X;
        PDXF.Y := PFPoint(SPoints.Items[I+1])^.Y;
        PDXF.Z := PFPoint(SPoints.Items[I+1])^.Z;// for future version
        PB := GetPoint(PDXF);
        if (PA.X = Prev.X) and (PA.Y = Prev.Y) then
          Result.AddPoint(PB)
        else begin
          Result.EndFigure(False);
          Result.AddPoint(PA);
          Result.AddPoint(PB);
        end;
        Inc(I, N);
        Prev := PB;
      end;
      if Result.PointTypes[Result.PointCount-1] = ptNode then
        Result.EndFigure(False);
    finally
      Result.EndUpdate;
    end;
  end;
end;

initialization
  RegisteredFlexFileFormats.RegisterFormat(TFlexCADFormat);

end.