fmain.pas

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

unit fMain;

interface

//{$DEFINE MEMCHK}

uses
  Controls,Windows, Messages, SysUtils, Classes, Graphics, Forms, Dialogs,
  ExtCtrls, ComCtrls, StdCtrls, csErrorCodes, Buttons, fLayers, fShowPoint,
  sgConsts, sgcadimage, Printers, ToolWin, Menus, ActnList, ImgList
  {$IFDEF MEMCHK}
  ,MemCheck
  {$ENDIF};

type
  TfmMain = class(TForm)
    OpenDialog: TOpenDialog;
    pbImage: TPaintBox;
    imLarge: TImageList;
    mmMenu: TMainMenu;
    mmiFile: TMenuItem;
    mmiOpen: TMenuItem;
    mmiSeparator1: TMenuItem;
    mmiPrint: TMenuItem;
    mmiSeparator2: TMenuItem;
    mmiExit: TMenuItem;
    plPanel: TPanel;
    mmiImage: TMenuItem;
    mmiLayers: TMenuItem;
    mmiShowHalf: TMenuItem;
    mmiFit: TMenuItem;
    mmiBlackWhite: TMenuItem;
    mmiProcessMessages: TMenuItem;
    mmiAbout: TMenuItem;
    clbBar: TControlBar;
    tbrBar: TToolBar;
    tbOpen: TToolButton;
    tbPrint: TToolButton;
    ToolButton1: TToolButton;
    tbFit: TToolButton;
    tbLayers: TToolButton;
    tbHalf: TToolButton;
    ToolButton2: TToolButton;
    cbScale: TComboBox;
    tbColored: TToolButton;
    ToolButton3: TToolButton;
    cbLayouts: TComboBox;
    ToolBar1: TToolBar;
    cbProcessMessages: TCheckBox;
    cbNearest: TCheckBox;
    cbLockFit: TCheckBox;
    pnlStatus: TPanel;
    pnlFile: TPanel;
    pnlCoords: TPanel;
    prbProgress: TProgressBar;
    ToolButton4: TToolButton;
    tbStopLoading: TToolButton;
    mmiSaveAs: TMenuItem;
    SaveDialog: TSaveDialog;
    pnlNearestEnt: TPanel;
    mmiShowPoint: TMenuItem;
    procedure pbImagePaint(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure pbImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pbImageMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure pbImageMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure cbScaleChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure cbProcessMessagesClick(Sender: TObject);
    procedure mmiExitClick(Sender: TObject);
    procedure mmiProcessMessagesClick(Sender: TObject);
    procedure mmiBlackWhiteClick(Sender: TObject);
    procedure cbLayoutsCloseUp(Sender: TObject);
    procedure mmiAboutClick(Sender: TObject);
    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure cbScaleKeyPress(Sender: TObject; var Key: Char);
    procedure FormCanResize(Sender: TObject; var NewWidth,
      NewHeight: Integer; var Resize: Boolean);
    procedure tbOpenClick(Sender: TObject);
    procedure tbPrintClick(Sender: TObject);
    procedure tbFitClick(Sender: TObject);
    procedure tbLayersClick(Sender: TObject);
    procedure tbHalfClick(Sender: TObject);
    procedure tbColoredClick(Sender: TObject);
    procedure cbLockFitClick(Sender: TObject);
    procedure tbStopLoadingClick(Sender: TObject);
    procedure mmiSaveAsClick(Sender: TObject);
    procedure mmiShowPointClick(Sender: TObject);
  private
    FX: Integer;
    FY: Integer;
    FScale: Double;
    FStart: TPoint;
    FOld: TPoint;
    FRectExtentsCAD: TFRect;
    FAbsHeight: Double;
    FAbsWidth: Double;
    FScaleRect: TFPoint;
    FIsDrawingBox: Boolean;
    FShowFndPntMarker: Boolean;
    function Is3D: Boolean;
  protected
    { use with CreateCADEx }
    //procedure WindowProc(var Message: TMessage); message CAD_PROGRESS;
  end;

var
   fmMain: TfmMain;
  CADFile: THandle;
      DXF: THandle;
     Data: TdxfData;
ErrorCode: DWORD;
  OldRect: TRect;
  bStopLoading: Boolean = False;

var
  LayersRect, OldNearestRect: TRect;



implementation

{$R *.DFM}

type
  TMyPaint = class(TPaintBox)
  end;

procedure Error;
var Buf: array[Byte] of Char;
begin
  GetLastErrorCAD(Buf, 256);
  raise Exception.Create(Buf);
end;

function OnProgress(PercentDone: Byte): Integer; stdcall;
begin
  Result := 0;
  if bStopLoading then
  begin
    StopLoading;
    fmMain.prbProgress.Visible := False;
    Result := 1;
  end
  else
  begin
    fmMain.pnlFile.Caption := 'Load file... ' + IntToStr(PercentDone) + '%';
    fmMain.prbProgress.Position := PercentDone;
  end;
end;

procedure TfmMain.pbImagePaint(Sender: TObject);
var
  vRect: TRect;
  Koef, Scale: Double;
  P: TPoint;
begin
  if (CADFile <> 0)and(FAbsHeight <> -1) then
  begin
    if cbLockFit.Checked then
      vRect := pbImage.ClientRect
    else
      vRect := OldRect;
    Koef := FAbsHeight / FAbsWidth;
    Scale := FScale * 0.01;
    P := Point(FX * Ord(not cbLockFit.Checked), FY * Ord(not cbLockFit.Checked));

    if vRect.Right - vRect.Left < vRect.Bottom - vRect.Top then
    begin
      vRect.Left := Round(vRect.Left * Scale + P.X);
      vRect.Right := Round(vRect.Right * Scale + P.X);
      vRect.Top := Round(vRect.Top * Scale + P.Y);
      vRect.Bottom := Round(vRect.Top + (vRect.Right - vRect.Left) * Koef);
    end
    else
    begin
      vRect.Top := Round(vRect.Top * Scale + P.Y);
      vRect.Bottom := Round(vRect.Bottom * Scale + P.Y);
      vRect.Left := Round(vRect.Left * Scale + P.X);
      vRect.Right := Round(vRect.Left + (vRect.Bottom - vRect.Top) / Koef);
    end;

    if vRect.Right > vRect.Left then
      FScaleRect.X := FAbsWidth / (vRect.Right - vRect.Left);
    if vRect.Bottom > vRect.Top then
      FScaleRect.Y := FAbsHeight / (vRect.Bottom - vRect.Top);

    OldNearestRect := Rect(-6,-6,0,0);
    DrawCAD(CADFile, pbImage.Canvas.Handle, vRect);
    if FShowFndPntMarker then
      pbImage.Canvas.Rectangle(pbImage.ClientWidth div 2 - 5, pbImage.ClientHeight div 2 - 5,
        pbImage.ClientWidth div 2 + 5, pbImage.ClientHeight div 2 + 5);
  end;
end;

procedure TfmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if CADFile <> 0 then CloseCAD(CADFile);
end;


procedure TfmMain.pbImageMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbRight then
  begin
    FStart := Point(X, Y);
    FOld := Point(FX, FY);
    pbImage.Cursor := crHandPoint;
    TMyPaint(pbImage).MouseCapture := True;
    Perform(WM_SETCURSOR, Handle, HTCLIENT);
  end
  else if Button = mbLeft then
  begin
    pbImageMouseMove(nil, Shift, X, Y);
  end;
end;

procedure TfmMain.pbImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  newmousePt: TFPoint;
  vRect, R: TRect;
  sX, sY: Single;
  P: TPoint;
  Buf: array[Byte] of Char;
  pBuf: PChar;

  procedure DrawNearestRect(ACanvas: TCanvas; NewRect: TRect; var PredRect: TRect);
  var
    OldPenMode: TPenMode;
    OldBrushColor: TColor;
    OldBrushStyle: TBrushStyle;
  begin
    OldPenMode := ACanvas.Pen.Mode;
    OldBrushColor := ACanvas.Brush.Color;
    OldBrushStyle := ACanvas.Brush.Style;

    ACanvas.Pen.Color := clYellow;
    ACanvas.Pen.Mode := pmXor;
    ACanvas.Brush.Color := clYellow;
    ACanvas.Brush.Style := bsSolid;

    ACanvas.Rectangle(PredRect);
    ACanvas.Rectangle(NewRect);
    PredRect := NewRect;

    ACanvas.Pen.Mode := OldPenMode;
    ACanvas.Brush.Color := OldBrushColor;
    ACanvas.Brush.Style := OldBrushStyle;
  end;

begin
  if pbImage.Cursor = crHandPoint then
  begin
    vRect := pbImage.ClientRect;
    FX := FOld.X + X - FStart.X - (OldRect.Left - vRect.Left);
    FY := FOld.Y + Y - FStart.Y - (OldRect.Top - vRect.Top);
    pbImage.Invalidate;
  end
  else
  begin
    if CADFile <> 0 then
    begin
      if Is3D then
        pnlCoords.Caption := '3D drawing'
      else
      begin
        vRect := pbImage.ClientRect;
        if cbNearest.Checked then
        begin
          P := Point(X, Y);
          pBuf := @Buf[0];
          GetNearestEntity(CADFile, pBuf, 256, vRect, P);
          R := Rect(P.X - 3, P.Y - 3, P.X + 3, P.Y + 3);
          DrawNearestRect(pbImage.Canvas, R, OldNearestRect);
          pnlNearestEnt.Caption := string(pBuf);
        end;
        P := Point(FX, FY);
        sX := (X - P.X) * FScaleRect.X / FAbsWidth;
        sY := 1 - (Y - P.Y)  * FScaleRect.X / FAbsHeight;
        GetCADCoords(CADFile, sX, sY, newmousePt);
        pnlCoords.Caption := Format('(%6.6f, %6.6f)', [newmousePt.X, newmousePt.Y]);
      end;
    end;
  end;
  Self.Focused;
  Self.FocusControl(plPanel);
end;

procedure TfmMain.pbImageMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbRight) and (pbImage.Cursor = crHandPoint) then
  begin
    TMyPaint(pbImage).MouseCapture := False;
    pbImage.Cursor := crDefault;
    tbFit.Enabled := True;
  end;
end;

procedure TfmMain.cbScaleChange(Sender: TObject);
var
  S: string;
begin
  S := cbScale.Items[cbScale.ItemIndex];
  Delete(S, Length(S), 1);
  FScale := ConvToFloatDef(S, 100.0);
  tbFit.Enabled := True;
  FShowFndPntMarker := false;
  Invalidate;
end;

procedure TfmMain.FormCreate(Sender: TObject);
begin
  FScale := 100.0;
  OldRect := pbImage.ClientRect;
  pbImage.Align := alClient;
  fmLayers := TfmLayers.Create(Self);
  pnlCoords.Caption := Format('(%6.6f, %6.6f)', [0.0, 0.0]);
  FIsDrawingBox := False;
  cbProcessMessages.Enabled := False;
  tbColored.Enabled := False;
  cbNearest.Enabled := False;
  mmiSaveAs.Enabled := false;
  mmiPrint.Enabled := false;
  mmiShowPoint.Enabled := false;
  FShowFndPntMarker := false;

  ErrorCode := 0;
  SetProgressProc(OnProgress);
end;

procedure TfmMain.FormResize(Sender: TObject);
begin
  pnlFile.Width := pnlStatus.Width div 2;
end;

function TfmMain.Is3D: Boolean;
var
 vIs3D: Integer;
begin
  GetIs3dCAD(CADFile, vIs3D);
  Result :=  vIs3D = 1;
end;

procedure TfmMain.cbProcessMessagesClick(Sender: TObject);
begin
  if CADFile = 0 then Exit;
  if cbProcessMessages.Checked then
  begin
    SetProcessMessagesCAD(CADFile, 1);
  end
  else
  begin
    SetProcessMessagesCAD(CADFile, 0);
  end;
  pbImage.Invalidate;
end;

procedure TfmMain.mmiExitClick(Sender: TObject);
begin
  Close;
end;

procedure TfmMain.mmiProcessMessagesClick(Sender: TObject);
begin
  if CADFile = 0 then Exit;
  if cbProcessMessages.Checked then
    SetProcessMessagesCAD(CADFile, 1)
  else
    SetProcessMessagesCAD(CADFile, 0);
  cbProcessMessages.Checked := mmiProcessMessages.Checked;
  pbImage.Invalidate;
end;

procedure TfmMain.mmiBlackWhiteClick(Sender: TObject);
begin
  if CADFile = 0 then Exit;