formatcadfiles.pas

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

unit FormatCadFiles;

interface

uses
  Windows, Classes, Graphics,
  FlexBase, FlexUtils, FlexPath, FlexControls, FlexProps, FlexFileFormats,
  CADIntf, sgConsts, sgLines;

const
  CADImportExtensions =
    'dwg,dxf,plt,hgl,hg,hpg,plo,hp,hp1,hp2,hpgl,hpgl2,gl2,prn,spl,rtl,cgm,svg,svgz';

resourcestring
  sDxfCadFileDescription = 'CAD library - %s File';
  sDxfCadNeedFilename    = 'Can''t load file from steam. Need Filename.';

type
  TFlexCADFormat = class(TFlexFileFormat)
  private
    FFlex: TFlexPanel;
    FCAD: THandle;
    FPenWidth: integer;
    FLayerColors: array of integer;
    FLines: TsgLines;
    function LoadCurveGlobal(SPoints: TList; IsSolid: Boolean): TFlexCurve;
    function GetPoint(const P: TFPoint): TPoint;
  protected
    FX: Integer;
    FY: Integer;
    FScale: double;
    procedure RegisterSupportedExtensions; override;
    procedure LoadEntity(Data: PcadData);
    function LoadLine(Data: PcadData): TFlexCurve;
    function LoadPoly(Data: PcadData): TFlexCurve;
    function LoadSpline(Data: PcadData): TFlexCurve;
    function Load3DFace(Data: PcadData): TFlexCurve;
    function LoadArc(Data: PcadData): TFlexEllipse;
    function LoadSolid(Data: PcadData): TFlexCurve;
    function LoadHatch(Data: PcadData): TFlexCurve;
    function LoadText(Data: PcadData): TFlexText;
    function LoadImage(Data: PcadData): TFlexPicture;
  public
    constructor Create(AOwner: TObject); override;
    destructor Destroy; override;
    procedure ImportFromStream(AStream: TStream; AFlexPanel: TFlexPanel;
      const Extension: TFlexFileExtension; const AFileName: string); override;
    function ImportFromFile(AFlex: TFlexPanel; const AFileName: string;
      AllLayers: boolean; AScale: double = 0; ADocName: string = '';
      ANewDocument: boolean = True): boolean;
    function ImportFromCad(AFlex: TFlexPanel; ACad: THandle; AllLayers: boolean;
      AScale: double; ADocName: string = '';
      ANewDocument: boolean = True): boolean;
    property Flex: TFlexPanel read FFlex;
    property CadHandle: THandle read FCAD;
  end;

implementation

uses
  SysUtils, Math;

{ GetSpline

  Gets a spline.  }
function GetSpline(ControlPoints, FitPoints, Knots: TList; ChordLen: Single): TList;

  function Normalize(N, I: Integer; Param: Double): Double;
  var
    V1, D1, V2, D2: Double;
  begin
    if N = 0 then
    begin
      if (Single(Knots[I]) <= Param) and (Param < Single(Knots[I + 1])) then
        Result := 1
      else
        Result := 0;
    end
    else
    begin
      D1 := Single(Knots[I + N]) - Single(Knots[I]);
      V1 := (Param - Single(Knots[I])) * Normalize(N - 1, I, Param);
      if D1 = 0 then
        V1 := 0
      else
        V1 := V1 / D1;
      D2 := Single(Knots[I + N + 1]) - Single(Knots[I + 1]);
      V2 := (Single(Knots[I + N + 1]) - Param) * Normalize(N - 1, I + 1, Param);
      if D2 = 0 then
        V2 := 0
      else
        V2 := V2 / D2;
      Result := V1 + V2;
    end;
  end;

  function GetNURBS(Index: Integer; Param: Double): TFPoint;
  var
    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;

procedure CADEnumProc(Data: PcadData; var Param); stdcall;
begin
  TFlexCADFormat(Param).LoadEntity(Data);
end;

procedure CADError;
var Buf: array[Byte] of AnsiChar;
begin
  CADGetLastError(Buf);
  raise Exception.Create(String(Buf));
end;

// TFlexCADFormat /////////////////////////////////////////////////////////////

constructor TFlexCADFormat.Create(AOwner: TObject); 
begin
 inherited;
 FStreamSupport := False;
 FLines := TsgLines.Create;
 FPenWidth := PixelScaleFactor div 100;
 FScale := 100 * PixelScaleFactor;
end;

destructor TFlexCADFormat.Destroy;
begin
 inherited;
 FLines.Free;
end;

procedure TFlexCADFormat.RegisterSupportedExtensions;
var
  ExtList: TStringList;
  i: integer;
begin
  ExtList := TStringList.Create;
  try
    ExtList.CommaText := CADImportExtensions;
    for i:=0 to ExtList.Count-1 do
      RegisterExtension(
        ExtList[i],
        Format(sDxfCadFileDescription, [UpperCase(ExtList[i])]),
        [skImport]
      );
  finally
    ExtList.Free;
  end;
end;

procedure TFlexCADFormat.ImportFromStream(AStream: TStream;
  AFlexPanel: TFlexPanel; const Extension: TFlexFileExtension;
  const AFileName: string);
begin
  if AFileName = '' then
    raise Exception.Create(sDxfCadNeedFilename);
  ImportFromFile(AFlexPanel, AFileName, True);
end;

function TFlexCADFormat.ImportFromFile(AFlex: TFlexPanel; const AFileName: string;
  AllLayers: boolean; AScale: double = 0; ADocName: string = '';
  ANewDocument: boolean = True): boolean;
var
  CADHandle: THandle;
  L, T, R, B, W, H: Double;
begin
  CADHandle := CADCreate(0, PAnsiChar(AnsiString(AFileName)));    // Open CADHandle file
  if CADHandle = 0 then CADError;
  try
    if AScale = 0 then begin
      if CADGetBox(CADHandle, L, R, T, B) = 0 then CADError;
      W := R - L;
      if W = 0 then W := 1;
      H := T - B;
      if H = 0 then H := 1;
      W := AFlex.DocWidth * 100 / (W * PixelScaleFactor);
      H := AFlex.DocHeight * 100 / (H * PixelScaleFactor);
      if W > H
        then AScale := H
        else AScale := W;
    end;
    Result := ImportFromCad(AFlex, CADHandle, AllLayers, AScale);
  finally
    CADClose(CADHandle);
  end;
end;

function TFlexCADFormat.ImportFromCad(AFlex: TFlexPanel; ACad: THandle;
  AllLayers: boolean; AScale: double; ADocName: string = '';
  ANewDocument: boolean = True): boolean;
var i: integer;
    R: TFRect;
    Count: integer;
    Data: TcadData;
    Layer: TFlexLayer;
    LScale: double;
begin
 Result := false;
 if Assigned(FFlex) or (FCad <> 0) or
    not Assigned(AFlex) or (ACad = 0) then exit;
 try
  FFlex := AFlex;
  if ANewDocument then
    FFlex.NewDocument;
  FCAD := ACad;
  // Set name
  if ADocName <> '' then
    FFlex.Schemes.Name := ADocName;
  // Set document size
  if CADLTScale(CADHandle, LScale) = 0 then
    exit;
  if CADGetBox(FCad, R.Left, R.Right, R.Top, R.Bottom) = 0 then
    exit;
  FLines.Scale := LScale;
  FScale := Round(AScale * PixelScaleFactor);
  FFlex.DocWidth := Round((R.Right - R.Left) * FScale / 100);
  FFlex.DocHeight := Round((R.Top - R.Bottom) * FScale / 100);
  FX := - Round(R.Left * FScale / 100); // see GetPoint
  FY := Round(R.Top * FScale / 100);
  // Process layers
  Count := CADLayerCount(CADHandle);
  if ANewDocument and (Count > 0) then
    FFlex.Layers.Clear;
  SetLength(FLayerColors, Count);
  for i:=0 to Count-1 do begin
    CADLayer(FCad, i, @Data);
    FLayerColors[i] := Data.Color;    
    Layer := FFlex.Layers.ByName[String(Data.Text)];
    if not Assigned(Layer) then begin
      Layer := FFlex.Layers.New;
      Layer.Name := String(Data.Text);
    end;
    if Data.Flags and 1 <> 0 then
      // Invisible
      Layer.Visible := False;
  end;
  FLines.Scale := FScale;
  CADEnum(FCad, integer(AllLayers), @CADEnumProc, Self);
 finally
  FFlex := Nil;
  FCad := 0;
 end;
 Result := true;
end;

procedure TFlexCADFormat.LoadEntity(Data: PcadData);
type
  PSingle = ^Single;
var
  i: Integer;
  p: PSingle;
  Control: TFlexControl;
  PenProp: TPenProp;
  BrushProp: TBrushProp;
  Layer: TFlexLayer;
  ControlColor: TColor;
begin
  // Fill lines
  FLines.List.Clear;
  FLines.Scale := Data.Rotation * FScale;
  p := PSingle(Data.Ticks);
  for i:=0 to Data.TickCount-1 do begin
    FLines.AddTick(p^);
    Inc(p);
  end;
  // Check entity
  Control := Nil;
  case Data.Tag of
    DXF_LINE:
      Control := LoadLine(Data);
    DXF_POLYLINE..DXF_LWPOLYLINE:
      Control := LoadPoly(Data);
    DXF_CIRCLE,DXF_ARC,DXF_ELLIPSE:
      Control := LoadArc(Data);
    DXF_SPLINE:
      Control := LoadSpline(Data);
    DXF_SOLID:
      Control := LoadSolid(Data);
    DXF_HATCH:
      Control := LoadHatch(Data);
    DXF_TEXT..DXF_ATTDEF, DXF_ATTRIB:
      Control := LoadText(Data);
    DXF_3DFACE:
      Control := Load3DFace(Data);
    DXF_IMAGE_ENT:
      Control := LoadImage(Data);
    DXF_BEGIN_INSERT:
      ; // FControlParent := TFlexGroup.Create(FFlex, FControlParent, FFlex.ActiveLayer);
    DXF_END_INSERT:
      ; // FControlParent := FControlParent.Parent;

{
    DXF_POINT:				DrawPoint;

    DXF_BEGIN_INSERT:                   IsInsideInsert := True;
    DXF_END_INSERT:                     IsInsideInsert := False;
    DXF_BEGIN_VIEWPORT:                 BeginViewport;
    DXF_END_VIEWPORT:                   EndViewport;  }
  end;
  if Assigned(Control) then begin
    Layer := TFlexLayer(FFlex.Layers.FindByName(String(Data.Layer)));
    if Assigned(Layer) then
      Control.Layer := Layer;
    if (Data.Color = clNone) or (Data.Color = clDefault) then
      ControlColor := clBlack
    else
      ControlColor := Data.Color;
    PenProp := TPenProp(Control.Props['Pen']);
    if Control is TFlexText then
      TFlexText(Control).FontProp.Color := ControlColor
    else
    if Assigned(PenProp) then
      if Data.Tag = DXF_HATCH then
        PenProp.Style := psClear
      else begin
        PenProp.Color := ControlColor;
        i := Round(Data.Thickness * FScale / 100);
        if i <= 0 then
          // Minimal thickness
          PenProp.Width := 1
        else
          PenProp.Width := i;
      end;
    if Data.Tag = DXF_HATCH then begin
      BrushProp := TBrushProp(Control.Props['Brush']);
      if Assigned(BrushProp) then
        BrushProp.Color := ControlColor;
    end;
  end;
end;

function TFlexCADFormat.LoadLine(Data: PcadData): TFlexCurve;
var
  I: Integer;
  SingPoints, DottedSingPoints: TList;
  PSinglePt: PFPoint;
begin
  SingPoints := TList.Create;
  DottedSingPoints := TList.Create;
  New(PSinglePt);
  PSinglePt^.X := Data.Point.X;
  PSinglePt^.Y := Data.Point.Y;
  PSinglePt^.Z := Data.Point.Z;
  SingPoints.Add(PSinglePt);
  New(PSinglePt);
  PSinglePt^.X := Data.Point1.X;
  PSinglePt^.Y := Data.Point1.Y;
  PSinglePt^.Z := Data.Point1.Z;
  SingPoints.Add(PSinglePt);

  if FLines.IsSolid then
    Result := LoadCurveGlobal(SingPoints, FLines.IsSolid)
  else
  begin
    FLines.Line(TFPoint(SingPoints[0]^), TFPoint(SingPoints[1]^), DottedSingPoints);
    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.LoadPoly(Data: PcadData): TFlexCurve;
var
  I: Integer;
  P: PFPoint;
  PSinglePt: PFPoint;
  SingPoints, DottedSingPoints: TList;
begin
  SingPoints := TList.Create;
  DottedSingPoints := TList.Create;

  P := Data.Points;
  for I := 0 to Data.Count - 1 do
  begin