求助如何提取dwg文件中的bmp文件，预览dwg文件

tsming

求助如何提取dwg文件中的bmp文件，预览dwg文件

谢谢

alin

DwgThumbnail CONTROL

MJTD_7777

you kongjian!!

英雄无敌

Option Explicit

Private Type BITMAPINFOHEADER
        biSize As Long
        biWidth As Long
        biHeight As Long
        biPlanes As Integer
        biBitCount As Integer
        biCompression As Long
        biSizeImage As Long
        biXPelsPerMeter As Long
        biYPelsPerMeter As Long
        biClrUsed As Long
        biClrImportant As Long
End Type
Private Type BITMAPFILEHEADER
        bfType As Integer
        bfSize As Long
        bfReserved1 As Integer
        bfReserved2 As Integer
        bfOffBits As Long
End Type

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private mvarPicture As PictureBox
Dim mvarBuffer() As Long
Dim mvarPictureType As Integer
Dim mvarFileName As String
Public Function GetDrawingPreview(dwgPath As String, Tmppath As String) As Boolean
On Error GoTo errH
    Dim fh As Integer, tmpBuffer() As Byte, i As Long
    Dim biHeader As BITMAPINFOHEADER, ver As Integer
    Dim sentinel As Long, nOffset As Long, imageSize As Long
    Dim tmp As Long, previewType As Byte, retval As Boolean
    mvarFileName = Tmppath
    If Dir$(dwgPath, vbNormal) = "" Then
'        mvarErrorCode = vbObjectError + 6
'        mvarErrorText = "File not found"
        retval = False
    Else
        fh = FreeFile
        Open dwgPath For Binary As #fh
        ' Read the first 18 bytes of the drawing
        ReDim tmpBuffer(0 To 17)
        Get #fh, , tmpBuffer
        ' Ensure that the drawing is at least R14
        ver = Val(Chr(tmpBuffer(4)) & Chr(tmpBuffer(5)))
        If ver < 14 Then
' If not, close the file and report an error
            Close #fh
'            mvarErrorCode = vbObjectError + 4
'            mvarErrorText = "Cannot process pre-14 drawings"
            retval = False
        Else
            ' Bytes 13 through 17 contain the starting position for a 39-byte
            ' block of information that desribes the preview.
            ' Thanks to Denis Gagne for this tip.
            CopyMemory sentinel, tmpBuffer(13), 4
            'Retrieve the preview descriptor block
            ReDim tmpBuffer(18 To sentinel + 39)
            'CopyMemory sentinel6, tmpBuffer(13), 2
            Get #fh, , tmpBuffer
            ' Determine the type of preview (if any) and act accordingly.
            ' Thanks to Paul Marshall for this tip.
                        mvarPictureType = tmpBuffer(UBound(tmpBuffer) - 9)
                        If mvarPictureType > 0 Then
                                ' Of the 39 bytes, bytes 31 through 34 contain the
                                ' starting location of the preview image data
                                CopyMemory nOffset, tmpBuffer(UBound(tmpBuffer) - 8), 4
                                ' Bytes 35 through 39 contain the size of the image data
                                CopyMemory imageSize, tmpBuffer(UBound(tmpBuffer) - 4), 4
                                tmp = UBound(tmpBuffer)
                                ' Retrieve the preview data
                                ReDim tmpBuffer(0 To imageSize + nOffset - tmp)
                                Get #fh, , tmpBuffer
                                Close #fh
                                ReDim mvarBuffer(0 To imageSize - 1)
                                ' Isolate the image data
                                CopyMemory mvarBuffer(0), tmpBuffer(nOffset - tmp - 1), imageSize
                                ' and make a bitmap file from it
                                WriteImage
                                ' Load it

                                'Set Form1.Picture1.Picture = LoadPicture(mvarFileName)
                                ' Delete it
                                'Kill mvarFileName
                                retval = True
                         End If
        End If
    End If
errH:
    GetDrawingPreview = retval '& vbCrLf & mvarFileName
End Function
Private Sub WriteImage()
On Error Resume Next
    Dim fh As Integer, bfHeader As BITMAPFILEHEADER
    Dim biHeader As BITMAPINFOHEADER, clrTableSize As Long
    Dim i As Integer, tmp As String, pixels As Long
    'Dim mvarBuffer(10) '''''''-----------
    'If mvarPictureType = IVW_PREVIEWBITMAP Then
        ' Copy the BITMAPINFOHEADER from the buffer into a structure
        CopyMemory biHeader, mvarBuffer(0), 40
        clrTableSize = IIf(biHeader.biBitCount < 9, 4 * (2 ^ biHeader.biBitCount), 0)
        ' Fill the BITMAPFILEHEADER structure
        With bfHeader
            .bfType = &H4D42           ' Image type
            .bfSize = 54 + clrTableSize + biHeader.biSizeImage ' Length of file (in bytes)
            .bfOffBits = 54 + clrTableSize         ' Number of bytes to the start of the pixel data
        End With
    'End If
    fh = FreeFile
    Open mvarFileName For Binary As #fh
    'If mvarPictureType = IVW_PREVIEWBITMAP Then
    Put #fh, , bfHeader
    Put #fh, , mvarBuffer
    Close #fh
End Sub
我也是从网上找的