main.pas

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

{************************************************************}
{              CADHandle Importer SDK DLL Version demo       }
{                                                            }
{      Copyright (c) 2002-2005 SoftGold software company     }
{                                                            }
{************************************************************}
{ Modified by FlexGraphics Software.                         }
{************************************************************}
{$DEFINE DRAWSPLINE}

unit Main;

interface

//{$DEFINE MEMCHK}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, ComCtrls, StdCtrls, Math, Menus, Buttons, sgConsts,
  {$IFDEF MEMCHK}
  MemCheck,
  {$ENDIF}
  SGLines, FlexBase, ToolWin, ImgList, FlexUtils, FormatCadFiles;

type
  TfmCADDLLdemo = class(TForm)
    pnlOptions: TPanel;
    OpenDialog1: TOpenDialog;
    MainMenu1: TMainMenu;
    mmiHome: TMenuItem;
    Exit1: TMenuItem;
    N1: TMenuItem;
    mmiOpen: TMenuItem;
    mmiPlaceImageToHome: TMenuItem;
    lblMeasure: TLabel;
    cbScale: TComboBox;                 
    cbSplitArcs: TCheckBox;
    cbLayers: TComboBox;
    pmiAbout: TMenuItem;
    pmiShowAbout: TMenuItem;
    cbUseWinLine: TCheckBox;
    cbDimensions: TCheckBox;
    sbAllLayers: TCheckBox;
    mmiZoomAll: TMenuItem;
    cbProhibitArcsAsCurves: TCheckBox;
    btnPlaceImageToHome: TSpeedButton;
    cbLayouts: TComboBox;
    Splitter1: TSplitter;
    fpMain: TFlexPanel;
    btnConvert: TSpeedButton;
    imgTools: TImageList;
    tbrMain: TToolBar;
    tbtPick: TToolButton;
    tbtZoom: TToolButton;
    tbtPan: TToolButton;
    tbtShape: TToolButton;
    sbFlexSave: TSpeedButton;
    sd_Flex: TSaveDialog;
    Panel1: TPanel;
    pbDrawing: TPaintBox;
    Convert1: TMenuItem;
    SaveFlexGraphicsdocument1: TMenuItem;
    N2: TMenuItem;
    cbPreserveFlexDoc: TCheckBox;
    Bevel1: TBevel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure pbDrawingPaint(Sender: TObject);
    procedure pbDrawingMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure pbDrawingMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure pbDrawingMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure cbScaleChange(Sender: TObject);
    procedure cbSplitArcsClick(Sender: TObject);
    procedure cbLayersDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
    procedure cbProhibitArcsAsCurvesClick(Sender: TObject);
    procedure cbLayoutsChange(Sender: TObject);
    procedure cbUseWinLineClick(Sender: TObject);
    procedure btnConvertClick(Sender: TObject);
    procedure mmiOpenClick(Sender: TObject);
    procedure mmiPlaceImageToHomeClick(Sender: TObject);
    procedure mmiZoomAllClick(Sender: TObject);
    procedure pmiShowAboutClick(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure tbtPickClick(Sender: TObject);
    procedure tbtZoomClick(Sender: TObject);
    procedure tbtPanClick(Sender: TObject);
    procedure tbtShapeClick(Sender: TObject);
    procedure sbFlexSaveClick(Sender: TObject);
  private
    FCurrentDir: string;
    FX: Integer;
    FY: Integer;
    FPlaceToHome: Boolean;
    FZoomAll: Boolean;
    FScale: Integer;
    FStart: TPoint;
    FOld: TPoint;
  public
    { Public declarations }
  end;

var
  fmCADDLLdemo: TfmCADDLLdemo;
  Lines: TsgLines;
  CADHandle: THandle;
  LScale: Double;

implementation

uses CADIntf, FlexFileFormats;

{$R *.DFM}

type
  TMyPaint = class(TPaintBox)
  end;

var
  EData: PcadData;
  IsInsideInsert: Boolean = False;

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

{ GetPoint

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

function PCanvas: TCanvas;
begin
  Result := fmCADDLLdemo.pbDrawing.Canvas;
end;

{ SetRotation

  Set font for rotated text.
procedure SetRotation;
var
  LF: TLogFont;
begin
  GetObject(PCanvas.Font.Handle, SizeOf(LF), @LF);
  LF.lfEscapement := Round(EData.Rotation * 10);	// in tenths of degrees
  while LF.lfEscapement < 0
  do Inc(LF.lfEscapement, 3600);
  LF.lfOrientation := LF.lfEscapement;
  PCanvas.Font.Handle := CreateFontIndirect(LF);
end;
}

{ GetPointsList

  Function converts the PFPoint-list in the PPoint-list
  with converting CADHandle units to pixels.                       }
procedure GetPointsList(SingPoints, IntPts: TList);
var
  I: Integer;
  DXFPt: TFPoint;
  PIntPt: PPoint;
begin
  for I := 0 to SingPoints.Count - 1 do
  begin
    New(PIntPt);
    DXFPt.X := (PFPoint(SingPoints.Items[I]))^.X;
    DXFPt.Y := (PFPoint(SingPoints.Items[I]))^.Y;
    DXFPt.Z := (PFPoint(SingPoints.Items[I]))^.Z;// for future version
    PIntPt.X := GetPoint(DXFPt).X;
    PIntPt.Y := GetPoint(DXFPt).Y;
    IntPts.Add(PIntPt);
  end;
end;

procedure DrawPoint;
var
  P: TPoint;
begin
  P := GetPoint(EData.Point);// EData.Point - point position
  SetPixelV(PCanvas.Handle, P.X, P.Y, PCanvas.Pen.Color);
end;

{ DrawGlobal

  Draws a (poly)line in global coordinates. }
procedure DrawGlobal(SPoints: TList; IsSolid: Boolean);
var
  I, N, PrevX, PrevY: Integer;
  P: TPoint;
  PDXF: TFPoint;
begin
  if SPoints.Count = 0 then
    Exit// Error
  else
  begin
    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
      P := GetPoint(PDXF);
      PrevX := P.X;
      PrevY := P.Y;
      PCanvas.MoveTo(P.X, P.Y);
      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
      P := GetPoint(PDXF);
      // For correct drawing and scaling dots
      if (P.X = PrevX) and (P.Y = PrevY) then
        PCanvas.LineTo(P.X, P.Y + 1)
      else
        PCanvas.LineTo(P.X, P.Y);
      Inc(I, N);
    end;
  end;
end;

{ DrawLine

  Draws a line.
  EData.Point - starting point
  EData.Point1 - ending point. }
procedure DrawLine;
var
  I: Integer;
  SingPoints, IntPoints, DottedSingPoints: TList;
  PSinglePt: PFPoint;
begin
  SingPoints := TList.Create;
  DottedSingPoints := TList.Create;
  New(PSinglePt);
  PSinglePt^.X := EData.Point.X;
  PSinglePt^.Y := EData.Point.Y;
  PSinglePt^.Z := EData.Point.Z;
  SingPoints.Add(PSinglePt);
  New(PSinglePt);
  PSinglePt^.X := EData.Point1.X;
  PSinglePt^.Y := EData.Point1.Y;
  PSinglePt^.Z := EData.Point1.Z;
  SingPoints.Add(PSinglePt);

  if PCanvas.Pen.Color = clBlue then
    PCanvas.Pen.Color := clBlue;

  if fmCADDLLdemo.cbUseWinLine.Checked then // Global coordinates
  begin
    if Lines.IsSolid then
      DrawGlobal(SingPoints, Lines.IsSolid)
    else
    begin
      Lines.Line(TFPoint(SingPoints[0]^), TFPoint(SingPoints[1]^), DottedSingPoints);
      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.Line(TFPoint(SingPoints[0]^), TFPoint(SingPoints[1]^), DottedSingPoints);
      GetPointsList(DottedSingPoints, IntPoints);
      DrawPolyPolyLine(PCanvas.Handle, IntPoints);
    end;
    for I := 0 to IntPoints.Count - 1 do
      Dispose(IntPoints[I]);
    IntPoints.Free;
  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;

{ DrawSolid

  4 points in EData
  The order in CADHandle file is 0-1-3-2. }
procedure DrawSolid;
var
  FSolid: array[0..3] of TPoint;
begin
  PCanvas.Pen.Width := 0;
  PCanvas.Brush.Style := bsSolid;
  PCanvas.Brush.Color := PCanvas.Pen.Color;
  FSolid[0] := GetPoint(EData.Point);
  FSolid[1] := GetPoint(EData.Point1);
  FSolid[2] := GetPoint(EData.Point3);
  FSolid[3] := GetPoint(EData.Point2);
  Polygon(PCanvas.Handle, FSolid[0], 4);
  PCanvas.Brush.Style := bsClear;
end;

procedure Draw3DFace;

  procedure Edge(const P1, P2: TFPoint);
  var
    Pt: array[0..1] of TPoint;
  begin
    Pt[0] := GetPoint(P1);
    Pt[1] := GetPoint(P2);
    Polygon(PCanvas.Handle, Pt[0], 2);
  end;

begin
  PCanvas.Pen.Width := 0;
  PCanvas.Brush.Style := bsSolid;
  PCanvas.Brush.Color := PCanvas.Pen.Color;
  if EData.Flags and 1 = 0 then
    Edge(EData.Point, EData.Point1);
  if EData.Flags and 2 = 0 then
    Edge(EData.Point1, EData.Point2);
  if EData.Flags and 4 = 0 then
    Edge(EData.Point2, EData.Point3);
  if EData.Flags and 8 = 0 then
    Edge(EData.Point3, EData.Point);
  PCanvas.Brush.Style := bsClear;
end;

{ DrawPoly

  Draws a (poly)line in global coordinates.
  EData.Count - number of polyline vertices
  EData.Points - pointer to point array.    }
procedure DrawPoly;
var
  I: Integer;
  P: PFPoint;
  PSinglePt: PFPoint;
  SingPoints, IntPoints, DottedSingPoints: TList;
begin
  SingPoints := TList.Create;
  DottedSingPoints := TList.Create;

  P := EData.Points;
  for I := 0 to EData.Count - 1 do
  begin
    //if I = 0 then PCanvas.MoveTo(GetPoint(P^).X, GetPoint(P^).Y);
    New(PSinglePt);
    PSinglePt^.X := P^.X;
    PSinglePt^.Y := P^.Y;
    PSinglePt^.Z := P^.Z;
    SingPoints.Add(PSinglePt);
    Inc(P);
  end;

  if fmCADDLLdemo.cbUseWinLine.Checked then // Global coordinates
  begin
    if Lines.IsSolid then
      DrawGlobal(SingPoints, Lines.IsSolid)
    else
    begin
      Lines.Poly(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.Poly(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;

  // 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;

{ 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