|
|
发表于 2007-9-11 16:42:00
|
显示全部楼层
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 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 |
|
置顶卡
