fmain.pas

CAD转换工具 CAD转换工具 CAD转换工具 CAD转换工具

  if tbColored.Down then
    SetDefaultColor(CADFile, Integer(clBlack))
  else
    SetDefaultColor(CADFile, Integer(clWhite));
  pbImage.Invalidate;
  if tbColored.Down then
      tbColored.ImageIndex := 22
    else
      tbColored.ImageIndex := 23;
  tbColored.Down := mmiBlackWhite.Checked;
end;

procedure TfmMain.cbLayoutsCloseUp(Sender: TObject);
begin
  FShowFndPntMarker := false;
  if cbLayouts.ItemIndex <> -1 then
  begin
    CurrentLayoutCAD(CADFile, cbLayouts.ItemIndex, True);
    pbImage.Invalidate;
    tbFit.Enabled := True;
  end;
  Self.Focused;
  Self.FocusControl(plPanel);
end;

procedure TfmMain.mmiAboutClick(Sender: TObject);
var
  Version, Formats: PAnsiChar;
begin
  Version := StrAlloc(260);
  Formats := StrAlloc(260);
  sgcadimage.GetPlugInInfo(Version, Formats);
  ShowMessage('CADImage.dll demo for ' + Formats + #13#10'Vesion ' + Version);
end;

procedure TfmMain.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  if (CADFile <> 0) and not cbLockFit.Checked and (FScale - FScale * 0.05 > 0.01) then
  begin
    FScale := FScale - FScale * 0.05;
    cbScale.Text := FloatToStrF(FScale, ffFixed, 17, 3) + '%';
    FShowFndPntMarker := false;
    pbImage.Invalidate;
    tbFit.Enabled := True;
    Handled := True;
  end;
end;

procedure TfmMain.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  if (CADFile <> 0) and not cbLockFit.Checked and (FScale < 10000) then
  begin
    FScale := FScale + FScale * 0.05;
    cbScale.Text := FloatToStrF(FScale, ffFixed, 17, 3) + '%';
    FShowFndPntMarker := false;
    pbImage.Invalidate;
    tbFit.Enabled := True;
    Handled := True;
  end;
end;

procedure TfmMain.cbScaleKeyPress(Sender: TObject; var Key: Char);
begin
  Key := #0;
  FShowFndPntMarker := false;
end;

procedure TfmMain.FormCanResize(Sender: TObject; var NewWidth,
  NewHeight: Integer; var Resize: Boolean);
begin
  //
end;

procedure TfmMain.tbOpenClick(Sender: TObject);
var
  Cnt,I: Integer;
  Layer: THandle;
  Layout: THandle;
  vName: string;

  //ErrorCode: DWORD;
  //Buf: PChar;
  //C: Cardinal;

begin
  if not OpenDialog.Execute then Exit;
  if CADFile <> 0 then
  begin
    CloseCAD(CADFile);
    CADFile := 0;
  end;

  prbProgress.Visible := True;
  prbProgress.Position := 0;
  tbStopLoading.Enabled := True;
  bStopLoading := False;
  FShowFndPntMarker := false;

  CADFile := CreateCAD(Handle, PChar(OpenDialog.FileName));

  {
  CADFile := CreateCADEx(
    Handle,
    PChar(OpenDialog.FileName),
    PChar(IntToStr(CAD_PROGRESS)));
  }
  tbStopLoading.Enabled := False;
  prbProgress.Visible := False;

  //ErrorCode := GetLastErrorCAD(Buf,256);
  {if ErrorCode = ERROR_CAD_UNSUPFORMAT_FILE then
  begin
    sbStatusBar.Panels[0].Text := 'No file loaded';
    StartedTimer := False;
    Error;
  end;}

  if CADFile = 0 then Error;

  pnlFile.Caption := OpenDialog.FileName;
  FScale := 100.0;
  cbProcessMessages.Enabled := True;
  tbColored.Down := True;
  tbColored.Enabled := True;
  tbPrint.Enabled := True;
  tbLayers.Enabled := True;
  tbHalf.Enabled := True;
  cbNearest.Enabled := True;
  cbProcessMessages.Checked := True;
  tbColored.Down := True;
  mmiProcessMessages.Enabled := True;
  mmiBlackWhite.Enabled := True;
  mmiProcessMessages.Checked := True;
  mmiBlackWhite.Checked := True;
  mmiSaveAs.Enabled := True;
  mmiPrint.Enabled := True;
  mmiShowPoint.Enabled := True;

  cbScale.ItemIndex := 3;
  tbColoredClick(nil);
  GetExtentsCAD(CADFile, FRectExtentsCAD);
  FAbsHeight := FRectExtentsCAD.Top - FRectExtentsCAD.Bottom;
  FAbsWidth  := FRectExtentsCAD.Right - FRectExtentsCAD.Left;
  FX := 0;
  FY := 0;
  fmLayers.clbLayers.Clear;
  Cnt := CADLayerCount(CADFile);
  for I:=0 to Cnt-1 do
  begin
    Layer := CADLayer(CADFile, I, @Data);
    //C := Data.Color;
    //if Data.Flags and 1 <> 0 then C := C or $80000000;
    fmLayers.clbLayers.Items.AddObject(Data.Text, TObject(Layer));
    fmLayers.clbLayers.Checked[I] := True;//Boolean(DXFVisible(Layer, Data.Text));
  end;
  cbLayouts.Clear;
  Cnt := CADLayoutsCount(CADFile);
  for I:=0 to Cnt-1 do
  begin
    SetLength(vName, 100);
    CADLayoutName(CADFile, I, PChar(vName), 100);
    Layout := CADLayout(CADFile, I);
    cbLayouts.Items.AddObject(vName, TObject(Layout));
  end;
  cbLayouts.ItemIndex := DefaultLayoutIndex(CADFile);
  OldRect := pbImage.ClientRect;
  pbImagePaint(pbImage);
  OldNearestRect := Rect(-6,-6,0,0);
end;

procedure TfmMain.tbPrintClick(Sender: TObject);
var
  vRect: TRect;
  Koef, Scale: Double;

  procedure PrintCAD;
  begin
    Printer.BeginDoc;
    try
      DrawCAD(CADFile, Printer.Canvas.Handle, vRect);
    finally
      Printer.EndDoc;
    end;
  end;

begin
  if (CADFile <> 0)and(FAbsHeight <> -1) then
  begin
    if FAbsHeight > FAbsWidth then
      Printer.Orientation := poPortrait
    else
      Printer.Orientation := poLandscape;
    vRect := Classes.Rect(0, 0, Printer.PageWidth, Printer.PageHeight);
    Koef := FAbsHeight / FAbsWidth;
    Scale := FScale * 0.01;
    if vRect.Right - vRect.Left < vRect.Bottom - vRect.Top then
    begin
      vRect.Left := Round(vRect.Left * Scale);
      vRect.Right := Round(vRect.Right * Scale);
      vRect.Top := Round(vRect.Top * Scale);
      vRect.Bottom := Round(vRect.Top + (vRect.Right - vRect.Left) * Koef);
    end
    else
    begin
      vRect.Top := Round(vRect.Top * Scale);
      vRect.Bottom := Round(vRect.Bottom * Scale);
      vRect.Left := Round(vRect.Left * Scale);
      vRect.Right := Round(vRect.Left + (vRect.Bottom - vRect.Top) / Koef);
    end;
    PrintCAD;
  end;
end;

procedure TfmMain.tbFitClick(Sender: TObject);
begin
  FScale := 95;
  FX := 0;
  FY := 0;
  OldRect := pbImage.ClientRect;
  Invalidate;
  tbFit.Enabled := False;
end;

procedure TfmMain.tbLayersClick(Sender: TObject);
begin
  fmLayers.ShowModal;
end;

procedure TfmMain.tbHalfClick(Sender: TObject);
var
  NewDrawingBox: TFRect;
begin
  if CADFile <> 0 then
  begin
    if not FIsDrawingBox then
    begin
      FAbsWidth := FAbsWidth / 2;
      NewDrawingBox.Left :=  FRectExtentsCAD.Left + FAbsWidth;
      NewDrawingBox.Top :=  FRectExtentsCAD.Top;
      NewDrawingBox.Z1 := 0;
      NewDrawingBox.Right := FRectExtentsCAD.Right;
      NewDrawingBox.Bottom := FRectExtentsCAD.Bottom;
      NewDrawingBox.Z2 := 0;
      SetDrawingBoxCAD(CADFile, NewDrawingBox);
    end
    else
    begin
      ResetDrawingBoxCAD(CADFile);
      GetExtentsCAD(CADFile, FRectExtentsCAD);
      FAbsHeight := FRectExtentsCAD.Top - FRectExtentsCAD.Bottom;
      FAbsWidth  := FRectExtentsCAD.Right - FRectExtentsCAD.Left;
    end;
    FIsDrawingBox := not FIsDrawingBox;
    pbImage.Refresh;
  end;
end;
procedure TfmMain.tbColoredClick(Sender: TObject);
begin
  if CADFile = 0 then Exit;
  if tbColored.Down then
  begin
//    SetDefaultColor(CADFile, Integer(TColor($800980)));//clBlack))
    SetBlackWhite(CADFile, 0);
  end
  else
  begin
//    SetDefaultColor(CADFile, Integer(clWhite));
    SetBlackWhite(CADFile, 1);
  end;
  mmiBlackWhite.Checked := tbColored.Down;
  if tbColored.Down then
    tbColored.ImageIndex := 22
  else
    tbColored.ImageIndex := 23;
  pbImage.Invalidate;
end;

procedure TfmMain.cbLockFitClick(Sender: TObject);
begin
  tbFitClick(nil);
end;

procedure TfmMain.tbStopLoadingClick(Sender: TObject);
begin
  bStopLoading := True;
end;

{ use with CreateCADEx 
procedure TfmMain.WindowProc(var Message: TMessage);
var
  vCADProgress: PCADProgress;
begin
  inherited;
  if Message.Msg = CAD_PROGRESS then
  begin
    vCADProgress := PCADProgress(Message.LParam);
    prbProgress.Position := vCADProgress.PercentDone;
    case vCADProgress.Stage of
    0:pnlFile.Caption := 'The operation is about to begin';
    1:
      begin
        pnlFile.Caption := string(vCADProgress.Msg);
        pnlFile.Caption := pnlFile.Caption + ' ' + IntToStr(vCADProgress.PercentDone) + '% done';
      end;
    2:pnlFile.Caption := 'The operation has just completed';
    end;

  end;
end;
}

procedure TfmMain.mmiSaveAsClick(Sender: TObject);
var
  vCADDraw: TCADDraw;
  vAbsWidth: Single;
  vAbsHeight: Single;
  vFileName: string;
begin
  if (CADFile = 0) or not SaveDialog.Execute then Exit;
  GetBoxCAD(CADFile,vAbsWidth,vAbsHeight);
  vCADDraw.DC := pbImage.Canvas.Handle;
  vCADDraw.R.Left := 0;
  vCADDraw.R.Top := 0;
  vCADDraw.R.Right := Round(vAbsWidth);
  vCADDraw.R.Bottom := Round(vAbsHeight);
  vCADDraw.DrawMode := 0;
  vCADDraw.Size := SizeOf(vCADDraw);
  vFileName := SaveDialog.FileName;

  case SaveDialog.FilterIndex of
    1: SaveCADtoBitmap(CADFile, vCADDraw, PChar(vFileName));
    2: SaveCADtoJpeg(CADFile, vCADDraw, PChar(vFileName));
    3: SaveCADtoGif(CADFile, vCADDraw, PChar(vFileName));
  end;

end;

procedure TfmMain.mmiShowPointClick(Sender: TObject);
var
  vRect: TRect;
  vCADRect: TFRect;
  vRes: Integer;
  CADPoint: TFPoint;
  Koef, Scale: Double;
  P: TPoint;
  W, H: double;
  ShowMarker: Boolean;
begin
  Scale := FScale;
  GetExtentsCAD(CADFile, vCADRect);
  ShowMarker := FShowFndPntMarker;
  vRes := GetPointParams(vCADRect, Scale, CADPoint, ShowMarker);
  if vRes = 0 then Exit;
  if (vCADRect.Left < CADPoint.X) and (CADPoint.X < vCADRect.Right) and
    (vCADRect.Bottom < CADPoint.Y) and (CADPoint.Y < vCADRect.Top) then
  begin
    FScale := Scale;
    FShowFndPntMarker := ShowMarker;
    cbScale.Text := FloatToStr(FScale);

    vRect := pbImage.ClientRect;
    Scale := FScale * 0.01;
    P := Point(FX * Ord(not cbLockFit.Checked), FY * Ord(not cbLockFit.Checked));
    Koef := FAbsHeight / FAbsWidth;
    H := pbImage.ClientHeight - (pbImage.ClientHeight * (CADPoint.Y - FRectExtentsCAD.Bottom) / FAbsHeight);
    W := pbImage.ClientHeight / Koef * (CADPoint.X - FRectExtentsCAD.Left) / FAbsWidth;

    FY := Round(pbImage.ClientHeight/2 - H * FScale * 0.01);
    FX := Round(pbImage.ClientWidth/2 - W * FScale * 0.01);

    Invalidate;
  end
  else
    ShowMessage('Seleted point does not belong to the drawing');
end;

initialization

  {$IFDEF MEMCHK}
  MemChk;
  {$ENDIF}

end.