main.pas

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

var
  P1,P2: TPoint;
//  P,P3: TPoint;
  bmp: TBitmap;
  vStr: TMemoryStream;
  I: Integer;
  vRect: TRect;
begin
//  P := GetPoint(EData.Point);
  P1 := GetPoint(EData.Point1);
  P2 := GetPoint(EData.Point2);
//  P3 := GetPoint(EData.Point3);
  vRect.TopLeft := P2;
  vRect.BottomRight := P1;
  if vRect.Right < vRect.Left then
  begin
    I := vRect.Right;
    vRect.Right := vRect.Left;
    vRect.Left := I;
  end;
  if vRect.Bottom < vRect.Top then
  begin
    I := vRect.Bottom;
    vRect.Bottom := vRect.Top;
    vRect.Top := I;
  end;
  vStr := TMemoryStream.Create;
  bmp := TBitmap.Create;
  try
    vStr.Write(EData.Ticks^, EData.Handle);
    vStr.Position := 0;
    bmp.LoadFromStream(vStr);
    PCanvas.StretchDraw(vRect, bmp);
  finally
    vStr.Free;
    bmp.Free;
  end;
end;

{ BeginViewport

  Creates a clipping region according to the VIEWPORT's boundary.
  Makes necessary actions before drawing the VIEWPORT and his "contents".    }
procedure BeginViewport;
var
  L: TList;
  P: PFPoint;
  TP: TPoint;
  I, J, K: Integer;
  MainRgn, Rgn: HRgn;
  R: TRect;
begin
  R.TopLeft := GetPoint(EData.Point);
  R.BottomRight := GetPoint(EData.Point1);
  if R.Left > R.Right then SwapInts(R.Left, R.Right);
  if R.Top > R.Bottom then SwapInts(R.Top, R.Bottom);
  SaveDC(PCanvas.Handle);
  if EData.Count = 0 then
  begin
    MainRgn := CreateRectRgnIndirect(R);
    if EData.Flags and 1 <> 0 then
      PCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
  end
  else
  begin
    P := EData.Points;
    I := EData.Count;
    MainRgn := CreateRectRgn(0,0,0,0);
    L := TList.Create;
    try
      while I > 0 do
      begin
        L.Count := 0;
        K := PInteger(P)^;
        Inc(P);
        for J := 0 to K - 1 do
        begin
          TP := GetPoint(P^);
          Inc(P);
          L.Add(Pointer(TP.X));
          L.Add(Pointer(TP.Y));
        end;
        Rgn := CreatePolygonRgn(L.List^, K, ALTERNATE);
        CombineRgn(MainRgn, MainRgn, Rgn, RGN_XOR);
        DeleteObject(Rgn);
        Dec(I);
      end;
    finally
      L.Free;
    end;
  end;
  TP := Point(0,0);
  LPtoDP(PCanvas.Handle, TP, 1);
  OffsetRgn(MainRgn, TP.X, TP.Y);
  SelectClipRgn(PCanvas.Handle, MainRgn);
  DeleteObject(MainRgn);
end;

{ EndViewport

  Makes necessary actions after drawing the VIEWPORT and his "contents".    }
procedure EndViewport;
begin
  RestoreDC(PCanvas.Handle, -1);
end;

{ DoLines

  Creates the list of ticks. }
procedure DoLines;
type PSingle = ^Single;
var
  I: Integer;
  P: PSingle;
begin
  Lines.List.Clear;
  Lines.Scale := EData.Rotation*LScale;
  P := PSingle(EData.Ticks);
  for I := 0 to EData.TickCount - 1 do
  begin
    Lines.AddTick(P^);
    Inc(P);
  end;
end;

{ DoDraw

  Called from DXFEnum for each entity in CADHandle file
  Data points to entity data
  Param is user-defined parameter. }
procedure DoDraw(Data: PcadData; var Param); stdcall;
begin
  // if DXFVisible(CADHandle, Data.Layer) = 0 then
  //   Exit; // invisible layers are ignored
  // MessageBox(0, PChar(Format('%d', [SizeOf(Data)])), 'a', 0);
  if not fmCADDLLdemo.cbDimensions.Checked and (Data.Dimension <> 0) then Exit;
  EData := Data;
  PCanvas.Pen.Color := Data.Color;      // entity color
  PCanvas.Pen.Width := Round(Data.Thickness * fmCADDLLdemo.FScale / 100);
  DoLines;
  case EData.Tag of
    DXF_LINE:                           DrawLine;
    DXF_SOLID:          		DrawSolid;
    DXF_3DFACE:                         Draw3DFace;
    DXF_CIRCLE,DXF_ARC,DXF_ELLIPSE:	DrawArc;
    DXF_POLYLINE..DXF_LWPOLYLINE:       DrawPoly;
    DXF_SPLINE:                         DrawSpline;
    DXF_TEXT..DXF_ATTDEF, DXF_ATTRIB:   DrawText;
    DXF_POINT:				DrawPoint;
    DXF_HATCH:                          DrawHatch;
    DXF_IMAGE_ENT:                      DrawImageEnt;
    DXF_BEGIN_INSERT:                   IsInsideInsert := True;
    DXF_END_INSERT:                     IsInsideInsert := False;
    DXF_BEGIN_VIEWPORT:                 BeginViewport;
    DXF_END_VIEWPORT:                   EndViewport;
  end;
end;

{ TfmCADDLLdemo.pbDrawingPaint

  Use bit-coded DXFEnum flag =4 for setting a way of cutting a viewport's
  contents to fit a "rectangular" VIEWPORT, without using Windows API REGIONS.
  If you have no possibility to use Windows API REGIONS
  (for example, you use OpenGL or something similar), set this flag.  }
procedure TfmCADDLLdemo.pbDrawingPaint(Sender: TObject);
begin
  if CADHandle <> 0 then
  begin
    Lines.Scale := LScale;
    pbDrawing.Canvas.Brush.Color := Color;
    pbDrawing.Canvas.FillRect(pbDrawing.Canvas.ClipRect);
    CADEnum(CADHandle, Ord(sbAllLayers.Checked), @DoDraw, Self);        // use DXFEnum for import as a linear "metafile"
  end;
end;

procedure TfmCADDLLdemo.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if CADHandle <> 0 then
    CADClose(CADHandle);
end;

procedure TfmCADDLLdemo.cbScaleChange(Sender: TObject);
begin
  FScale := StrToInt(cbScale.Text);
  pbDrawing.Invalidate;
end;

procedure TfmCADDLLdemo.pbDrawingMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbRight then
  begin
    FStart := Point(X,Y);
    FOld := Point(FX,FY);
    pbDrawing.Cursor := crHandPoint;
    TMyPaint(pbDrawing).MouseCapture := True;
    // tsDrawing.Perform(WM_SETCURSOR, tsDrawing.Handle, HTCLIENT);
  end;
end;

procedure TfmCADDLLdemo.pbDrawingMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if pbDrawing.Cursor = crHandPoint then
  begin
    FX := FOld.X + X - FStart.X;
    FY := FOld.Y + Y - FStart.Y;
    FPlaceToHome := False;
    pbDrawing.Invalidate;
  end;
end;

procedure TfmCADDLLdemo.pbDrawingMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbRight) and (pbDrawing.Cursor = crHandPoint) then
  begin
    TMyPaint(pbDrawing).MouseCapture := False;
    pbDrawing.Cursor := crDefault;
  end;
end;

procedure TfmCADDLLdemo.cbLayersDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var C: TColor;
begin
  C := TColor(cbLayers.Items.Objects[Index]);
  with cbLayers.Canvas do
  begin
    Brush.Color := clWindow;
    FillRect(Rect);
    if C < 0 then Font.Color := clGray else Font.Color := clBlack;
    TextRect(Rect, Rect.Left+16, Rect.Top, cbLayers.Items[Index]);
    Brush.Color := C and MaxInt;
    Rectangle(Rect.Left+2, Rect.Top+2, Rect.Left+12, Rect.Top+12);
  end;
end;

procedure TfmCADDLLdemo.FormCreate(Sender: TObject);
begin
  Lines := TsgLines.Create;
  FPlaceToHome := False;
  FZoomAll := False;
  FX := 0;
  FY := 0;
  btnPlaceImageToHome.Enabled:= False;
  LoadFlexCursors;
  fpMain.InDesign := True;
end;

procedure TfmCADDLLdemo.FormDestroy(Sender: TObject);
begin
  Lines.Free;
end;

procedure TfmCADDLLdemo.mmiOpenClick(Sender: TObject);
const S: array[0..1] of string = ('Inches','Millimeters');
var
  I, Cnt: Integer;
  C: Cardinal;
  Data: TcadData;
  vLayoutName: AnsiString;
begin
  try
    if mmiOpen.Checked then
      Exit;
    OpenDialog1.InitialDir := FCurrentDir;
    if not OpenDialog1.Execute then
      Exit;
    mmiOpen.Checked := True;
    if Length(OpenDialog1.FileName) > 1 then
      FCurrentDir := ExtractFilePath(OpenDialog1.FileName);
    if CADHandle <> 0 then CADClose(CADHandle);
    CADHandle := CADCreate(Application.Handle, PAnsiChar(AnsiString(OpenDialog1.FileName)));    // Open CADHandle file
    if CADHandle = 0 then Error;
    if CADUnits(CADHandle,I) = 0 then Error;    // Drawing units (inches or millimeters)
    if CADLTScale(CADHandle,LScale) = 0 then Error;
    lblMeasure.Caption := S[I];
    FScale := 100;
    cbScale.ItemIndex := 7;
    cbLayers.Items.Clear;
    Cnt := CADLayerCount(CADHandle);
    for I := 0 to Cnt - 1 do
    begin
      CADLayer(CADHandle,I,@Data);
      C := Data.Color;
      if Data.Flags and 1 <> 0 then
        C := C or $80000000;
      cbLayers.Items.AddObject(String(Data.Text), TObject(C));
    end;
    cbLayouts.Items.Clear;
    Cnt := CADLayoutCount(CADHandle);
    for I := 0 to Cnt - 1 do
    begin
      SetLength(vLayoutName, 100);
      CADLayoutName(CADHandle, I, PAnsiChar(vLayoutName), 100);
      cbLayouts.Items.Add(String(vLayoutName));
    end;
    if CADLayoutCurrent(CADHandle, DWORD(I), False) = 1 then
      cbLayouts.ItemIndex := I;
    FX := 0;
    FY := 0;
    FZoomAll := True;
    mmiPlaceImageToHomeClick(nil);
    cbProhibitArcsAsCurvesClick(nil);
    btnPlaceImageToHome.Enabled := True;
    cbScale.SetFocus;
    mmiOpen.Checked := False;
  except
    mmiOpen.Checked := False;
  end;
end;

procedure TfmCADDLLdemo.mmiPlaceImageToHomeClick(Sender: TObject);
begin
  FPlaceToHome := True;
  mmiZoomAllClick(nil);
end;

procedure TfmCADDLLdemo.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TfmCADDLLdemo.cbSplitArcsClick(Sender: TObject);
begin
  pbDrawing.Invalidate;
end;

procedure TfmCADDLLdemo.cbUseWinLineClick(Sender: TObject);
begin
  pbDrawing.Invalidate;
end;

procedure TfmCADDLLdemo.cbProhibitArcsAsCurvesClick(Sender: TObject);
begin
  // 1 => permit conversion of arcs to polyline
  CADProhibitCurvesAsPoly(CADHandle, Ord(not fmCADDLLdemo.cbProhibitArcsAsCurves.Checked));
  pbDrawing.Invalidate;
end;

procedure TfmCADDLLdemo.pmiShowAboutClick(Sender: TObject);
begin
  ShowMessage(
    'CAD Importer SDK DLL Version.'#13 +
    'www.cadsofttools.com'#13#13 +
    'FlexGraphics CAD Files import.'#13 +
    'www.flex-graphics.com');
end;

procedure TfmCADDLLdemo.mmiZoomAllClick(Sender: TObject);
var
  L, T, R, B, W, H: Double;
  vNewScaleStr: string;
begin
  if CADGetBox(CADHandle, L, R, T, B) = 0 then Exit;
  W := R - L;
  if W = 0 then
    W := 1;
  H := T - B;
  if H = 0 then
    H := 1;
  W := pbDrawing.Width * 100 / W;
  H := pbDrawing.Height * 100 / H;
  if W > H then
    W := H;
  if (FZoomAll = True) or (Sender <> nil) then
  begin
    FScale := Round(W);
    vNewScaleStr := IntToStr(FScale);
    if cbScale.Items.IndexOf(vNewScaleStr) < 0 then
      cbScale.Items.AddObject(vNewScaleStr, nil);
    cbScale.ItemIndex := cbScale.Items.IndexOf(vNewScaleStr);
    FZoomAll := False;
  end;
  if FPlaceToHome = True then
  begin
    FX := - Round(L * FScale / 100); // see GetPoint
    FY := Round(T * FScale / 100);
  end;
  pbDrawing.Invalidate;
end;

procedure TfmCADDLLdemo.cbLayoutsChange(Sender: TObject);
var
  I: DWORD;
begin
  if CADHandle <> 0 then
  begin
    I := cbLayouts.ItemIndex;
    CADLayoutCurrent(CADHandle, I, True);
    FPlaceToHome := True;
    mmiZoomAllClick(Sender);
    cbScale.SetFocus;
  end;
end;

procedure TfmCADDLLdemo.btnConvertClick(Sender: TObject);
begin
  with TFlexCADFormat.Create(Nil) do
    try
      ImportFromCad(fpMain, Main.CADHandle, sbAllLayers.Checked, FScale, '', not cbPreserveFlexDoc.Checked);
    finally
      Free;
    end;
end;

procedure TfmCADDLLdemo.tbtPickClick(Sender: TObject);
begin
 fpMain.ToolMode := ftmSelect;
end;

procedure TfmCADDLLdemo.tbtZoomClick(Sender: TObject);
begin
 fpMain.ToolMode := ftmZoom;
end;

procedure TfmCADDLLdemo.tbtPanClick(Sender: TObject);
begin
 fpMain.ToolMode := ftmPan;
end;

procedure TfmCADDLLdemo.tbtShapeClick(Sender: TObject);
begin
  fpMain.ToolMode := ftmPointEdit;
end;

procedure TfmCADDLLdemo.sbFlexSaveClick(Sender: TObject);
begin
  if sd_Flex.Execute then
    fpMain.SaveToFile(sd_Flex.FileName);
end;

initialization
  {$IFDEF MEMCHK}
  MemChk
  {$ENDIF}

end.