form1.frm

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

    PreviousPoint.X = 0
    PreviousPoint.Y = 0
    GetClientRect Form1.hWnd, R
    KX = Form1.Width / R.right
    KY = Form1.Height / R.bottom
    SetProgressProc AddressOf CADProgress
End Sub

Public Sub DrawToPictureBox()
  Dim AbsWidth, AbsHeight As Single
  Dim R As RECT
  Dim bih As BITMAPINFOHEADER
  Dim bi As BITMAPINFO
  Dim hbmp As Long
  Dim BitsMem As Long
  Dim hMemDib As Long
  Dim MemLockDib As Long
  
  Dim Pic As PicBmp
  Dim ipic As IPicture
  Dim IID_IDispatch As GUID
  Dim lRC As Long
  Dim bSize As Integer
  Dim bits() As Byte
  
  If CADImage <> 0 Then
    R.left = 0
    R.top = 0
    ' set image width
    R.right = Form3.Picture1.Width / Screen.TwipsPerPixelX
    ' set image height
    GetBoxCAD CADImage, AbsWidth, AbsHeight
    R.bottom = (AbsHeight / AbsWidth) * Form3.Picture1.Height / Screen.TwipsPerPixelY
    ' fill memory: [BITMAPINFOHEADER][Color table][bitmap data]
    hMemDib = DrawCADtoDIB(CADImage, R)
    ' locate memory
    MemLockDib = GlobalLock(hMemDib)
    CopyMemory bi, ByVal MemLockDib&, Len(bi)
       
    BitsMem = MemLockDib + Len(bi)
    ReDim bits(bi.bmiHeader.biSizeImage - 1)
    CopyMemory bits(0), ByVal BitsMem&, bi.bmiHeader.biSizeImage
    hbmp = CreateDIBitmap(Form3.Picture1.hDC, bi.bmiHeader, CBM_INIT, bits(0), bi, DIB_RGB_COLORS)
       
    If hbmp <> 0 Then
      IID_IDispatch.Data1 = &H20400
      IID_IDispatch.Data4(0) = &HC0
      IID_IDispatch.Data4(7) = &H46
      Pic.Size = Len(Pic)
      Pic.Type = vbPicTypeBitmap
      Pic.hbmp = hbmp
      Pic.hPal = 0
      lRC = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, ipic)
      If lRC = 0 Then
        Form3.Picture1 = ipic
        Set ipic = Nothing
      Else
        Form3.Picture1 = Nothing
        Call DeleteObject(hbmp)
      End If
      Form3.Show
    End If
    GlobalFree (hMemDib)
  End If
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    PreviousPoint.X = X
    PreviousPoint.Y = Y
    Form1.MousePointer = 5
    drag = True
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If drag = True Then
        Offset.X = Offset.X - (PreviousPoint.X - X) / KX
        Offset.Y = Offset.Y - (PreviousPoint.Y - Y) / KY
        PreviousPoint.X = X
        PreviousPoint.Y = Y
        Refresh
    End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    drag = False
    Form1.MousePointer = 0
    Refresh
End Sub

Private Sub Form_Paint()
Dim R As RECT
Dim AbsWidth As Single
Dim AbsHeight As Single
Dim K As Double
  If CADImage <> 0 Then
    GetBoxCAD CADImage, AbsWidth, AbsHeight
    If AbsHeight <> -1 Then
        GetClientRect Form1.hWnd, R
        If AbsWidth = 0 Then
          K = 1
        Else
          K = AbsHeight / AbsWidth
        End If
        R.bottom = (R.top + (R.right - R.left) * K)
        R.left = (R.left * FScale / 100) + Offset.X
        R.right = (R.right * FScale / 100) + Offset.X
        R.top = (R.top * FScale / 100) + Offset.Y
        R.bottom = (R.bottom * FScale / 100) + Offset.Y
        DrawCAD CADImage, Form1.hDC, R
    End If
  End If
End Sub

Private Sub CloseImage()
  If CADImage <> 0 Then
    CloseCAD CADImage
  End If
End Sub

Private Sub Form_Resize()
  Refresh
End Sub

Private Sub Form_Unload(Cancel As Integer)
    CloseImage
    Unload Form2
    Unload Form3
    Unload Form4
End Sub

Sub Uncheck()
  Select Case FScale
    Case 50:
      m50.Checked = False
    Case 100:
      m100.Checked = False
    Case 200:
      m200.Checked = False
    Case 500:
      m500.Checked = False
    Case 1000:
      m1000.Checked = False
 End Select
End Sub

Private Sub JPG_Click()
Dim CrDraw As CADDRAW
Dim AbsWidth As Single
Dim AbsHeight As Single
Dim K As Double
Dim Hnd As Long, Size As Long, P As Long, FHnd As Long, Ret As Long

  If CADImage <> 0 Then
    CD.FileName = ""
    CD.Filter = "Jpg files (jpg)|*.jpg"
    CD.ShowSave
    GetBoxCAD CADImage, AbsWidth, AbsHeight
    If AbsHeight <> -1 Then
        GetClientRect Form1.hWnd, CrDraw.R
        If AbsWidth = 0 Then
          K = 1
        Else
          K = AbsHeight / AbsWidth
        End If
        CrDraw.Size = Len(CrDraw) 'size of CADDRAW
        CrDraw.R.top = 0
        CrDraw.R.left = 0
        CrDraw.R.bottom = CrDraw.R.right * K
        CrDraw.R.right = CrDraw.R.right * FScale / 100
        CrDraw.R.bottom = CrDraw.R.bottom * FScale / 100
        ' color mode
        ' 0 - color
        ' 1 - black and white
        ' 2 - glayscale mode
        CrDraw.DrawMode = 0 ' color mode
        Hnd = DrawCADtoJpeg(CADImage, CrDraw)
        If Hnd <> 0 Then
            Size = GlobalSize(Hnd)
            P = GlobalLock(Hnd)
            FHnd = CreateFile(CD.FileName, GENERIC_WRITE, FILE_SHARE_READ, ByVal 0&, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
            If FHnd <> 0 Then
                WriteFile FHnd, ByVal P&, Size, Ret, ByVal 0&
                CloseHandle FHnd
            End If
            GlobalUnlock Hnd
            GlobalFree Hnd
        End If
    End If
  End If
End Sub

Private Sub m100_Click()
  ScaleClick m100
End Sub

Private Sub m1000_Click()
  ScaleClick m1000
End Sub

Private Sub m200_Click()
  ScaleClick m200
End Sub

Private Sub m50_Click()
  ScaleClick m50
End Sub

Private Sub m500_Click()
  ScaleClick m500
End Sub

Private Sub mLoad_Click()
  Dim EData As data
  Dim Cnt As Long
  Dim i As Integer
  Dim Layer As Long
  Dim C As Long
  Dim vNum As String
  Dim szBorder As Double
  Dim vFileName As String
  CD.Filter = "CAD files (dwg dxf rtl spl prn gl2 hpgl2 hpgl hp2 hp1 hp plo hpg hg hgl plt cgm svg)|"
  CD.Filter = CD.Filter + "*.dwg;*.dxf;*.rtl;*.spl;*.prn;*.gl2;*.hpgl2;*.hpgl;*.hp2;*.hp1;*.hp;*.plo;*.hpg;*.hg;*.hgl;*.plt;*.cgm;*.svg"
  CD.FileName = ""
  CD.ShowOpen
  If CD.FileName <> "" Then
    vFileName = CD.FileName
    LoadPreview (vFileName)
    CloseImage
    pbBar.left = sbBar.Panels(1).Width
    pbBar.top = sbBar.top
    pbBar.Width = sbBar.Panels(2).Width
    pbBar.Visible = True
    CADImage = CreateCAD(Form1.hWnd, vFileName)
    
    pbBar.Visible = False
    If CADImage <> 0 Then
      SetCADBorderType CADImage, BorderType
      SetCADBorderSize CADImage, BorderSize
      m100_Click
      Refresh
      ClickFlag = 0
      Form2.List1.Clear
      Cnt = CADLayerCount(CADImage)
      For i = 0 To Cnt - 1
        Layer = CADLayer(CADImage, i, EData)
        C = EData.Color
        Form2.List1.AddItem EData.Text
        Form2.List1.ItemData(i) = Layer
        Form2.List1.Selected(i) = True
      Next i
      
      Dim vName As String
      vName = String(100, " ")
      Form4.Combo1.Clear
      Cnt = CADLayoutsCount(CADImage)
      For i = 0 To Cnt - 1
        vNum = CADLayoutName(CADImage, i, vName, Len(vName))
        Form4.Combo1.AddItem (vName)
      Next i
      Form4.Combo1.ListIndex = DefaultLayoutIndex(CADImage)
      sbBar.Panels(1).Text = vFileName
    End If
  End If
End Sub

Sub ScaleClick(Item As Menu)
    Uncheck
    Item.Checked = True
    FScale = Item.Tag
    Refresh
End Sub

Private Sub mmiDrawPicture_Click()
  DrawToPictureBox
End Sub

Private Sub mmiExit_Click()
    Unload Me
End Sub

Private Sub mmiOptions_Click()
  Form5.Show 1
  Form1.Refresh
End Sub

Private Sub mPrint_Click()
Dim R As RECT
Dim AbsWidth As Single
Dim AbsHeight As Single
Dim K As Double
  If CADImage <> 0 Then
    GetBoxCAD CADImage, AbsWidth, AbsHeight
    If AbsHeight <> -1 Then
        R.left = 0
        R.top = 0
        R.right = GetDeviceCaps(Printer.hDC, 8) 'Horizontal width in pixels
        R.bottom = GetDeviceCaps(Printer.hDC, 10) 'Vertical height in pixels
        If AbsWidth = 0 Then
          K = 1
        Else
          K = AbsHeight / AbsWidth
        End If
        R.bottom = (R.right - R.left) * K
        Printer.Line (0, 0)-(0, 0)
        DrawCAD CADImage, Printer.hDC, R
        Printer.EndDoc
    End If
  End If
End Sub

Private Sub NLayers_Click()
  ClickFlag = 1
  Form2.Show
End Sub

Private Sub NLayouts_Click()
  Form4.Show
End Sub