在窗体中放一个Picture控件,设置属性Dim intW As Long '芞遵僅 Dim intH As Long '芞詢僅 Picture1.AutoSize = True Picture1.ScaleMode = vbPixels '覃猁聆彸煦望薹腔芞 Picture1.Picture = LoadPicture("C:\ddd.jpg") '腕遵僅杅硉 intW = Picture1.ScaleWidth '腕詢僅杅硉 intH = Picture1.ScaleHeight
Dim intW As Long '图片宽度 Dim intH As Long '图片高度 Picture1.AutoSize = True Picture1.ScaleMode = vbPixels Picture1.Picture = LoadPicture("C:\ddd.jpg") intW = Picture1.ScaleWidth intH = Picture1.ScaleHeight
'I have released this source code into the public domain. You may use it 'with no strings attached. 'Just call GetImageSize with a string containing the filename, and 'it will return a user defined type 'ImageSize' (see below) 'Return values of 0 indicate an error of some sort. The error handling 'in this module is limited. There is *NO* error handling on the test 'form. This routine is limited to X or Y sizes of 32767 pixels, but that 'should not be a problem.'Check back athttp://www.qtm.net/~davidc 'I may add support for more file types.'supported in this version: 'JPEG 'GIF 'PNG'This routine does not require any royalty fees for Unisys as it 'does nothing with the compressed part of GIF files. It simply reads '4 bytes to determine image size.Option Explicit Public WImg As Long Public HImg As Long Public Type ImageSize Width As Long Height As Long End TypePublic Sub GetImageSize(sFileName As String) On Error Resume Next 'you'll want to change this Dim iFN As Integer Dim bTemp(3) As Byte Dim lFlen As Long Dim lPos As Long Dim bHmsb As Byte Dim bHlsb As Byte Dim bWmsb As Byte Dim bWlsb As Byte Dim bBuf(7) As Byte Dim bDone As Byte Dim iCount As IntegerlFlen = FileLen(sFileName) iFN = FreeFile Open sFileName For Binary As iFN Get #iFN, 1, bTemp()'PNG file If bTemp(0) = &H89 And bTemp(1) = &H50 And bTemp(2) = &H4E _ And bTemp(3) = &H47 Then Get #iFN, 19, bWmsb Get #iFN, 20, bWlsb Get #iFN, 23, bHmsb Get #iFN, 24, bHlsb 'GetImageSize.Width = CombineBytes(bWlsb, bWmsb) 'GetImageSize.Height = CombineBytes(bHlsb, bHmsb) WImg = CombineBytes(bWlsb, bWmsb) HImg = CombineBytes(bHlsb, bHmsb) End If'GIF file If bTemp(0) = &H47 And bTemp(1) = &H49 And bTemp(2) = &H46 _ And bTemp(3) = &H38 Then Get #iFN, 7, bWlsb Get #iFN, 8, bWmsb Get #iFN, 9, bHlsb Get #iFN, 10, bHmsb 'GetImageSize.Width = CombineBytes(bWlsb, bWmsb) 'GetImageSize.Height = CombineBytes(bHlsb, bHmsb) WImg = CombineBytes(bWlsb, bWmsb) HImg = CombineBytes(bHlsb, bHmsb) End If 'JPEG file If bTemp(0) = &HFF And bTemp(1) = &HD8 And bTemp(2) = &HFF Then Debug.Print "JPEG" lPos = 3 Do Do Get #iFN, lPos, bBuf(1) Get #iFN, lPos + 1, bBuf(2) lPos = lPos + 1 Loop Until (bBuf(1) = &HFF And bBuf(2) <> &HFF) Or lPos > lFlenFor iCount = 0 To 7 Get #iFN, lPos + iCount, bBuf(iCount) Next iCount If bBuf(0) >= &HC0 And bBuf(0) <= &HC3 Then bHmsb = bBuf(4) bHlsb = bBuf(5) bWmsb = bBuf(6) bWlsb = bBuf(7) bDone = 1 Else lPos = lPos + (CombineBytes(bBuf(2), bBuf(1))) + 1 End If Loop While lPos < lFlen And bDone = 0 'GetImageSize.Width = CombineBytes(bWlsb, bWmsb) 'GetImageSize.Height = CombineBytes(bHlsb, bHmsb) WImg = CombineBytes(bWlsb, bWmsb) HImg = CombineBytes(bHlsb, bHmsb) End If Close iFNEnd Sub Private Function CombineBytes(lsb As Byte, msb As Byte) As Long CombineBytes = CLng(lsb + (msb * 256)) End Function
echos: 能不能说说从哪能得到这些文件的格式。因为我还想处理其它格式的文件,比如bmp什么的。
你去google搜索有关图像的格式的文章, 说实在的,我只研究过gif的格式 因为它很简单,只需读出它的几个字节就可以得出他的所有信息 这个代码我是看你问问题,在网上帮你找的, 要不你就到图书馆找找有关bmp的资料 好像以前看到过一些说明图像编码格式的书 你到北京图书馆去找找在线的书看看 给你一个bmp的例子非压缩BMP位图的宽度和高度在文件开始11H后的8个字节。 Sub testmp()Dim FileName As StringFileName = "c:\test.bmp" Open FileName For Binary As #1 Get #1, 19, ImageWidth: Get #1, , ImageHeight '读取位图的宽度和高度 Close #1 DW = 15 * ImageWidth - ImageWin.Width '将像点转换为Twip(微点) DH = 15 * ImageHeight - ImageWin.Height End Sub
在VB程序中获取PNG、GIF、JPG、BMP四种常用格式图形的尺寸大小。 首先建立一个模块,输入如下内容。Public Type ImageSize Width As Long Height As Long End TypePublic Function GetImageSize(sFileName As String) As ImageSize On Error Resume Next Dim iFN As Integer Dim bTemp(3) As Byte Dim lFlen As Long Dim lPos As Long Dim bHmsb As Byte Dim bHlsb As Byte Dim bWmsb As Byte Dim bWlsb As Byte Dim bBuf(7) As Byte Dim bDone As Byte Dim iCount As Integer lFlen = FileLen(sFileName) iFN = FreeFile Open sFileName For Binary As iFN Get #iFN, 1, bTemp() 'PNG 文件 If bTemp(0) = &H89 And bTemp(1) = &H50 And bTemp(2) = &H4E _ And bTemp(3) = &H47 Then Get #iFN, 19, bWmsb Get #iFN, 20, bWlsb Get #iFN, 23, bHmsb Get #iFN, 24, bHlsb GetImageSize.Width = CombineBytes(bWlsb, bWmsb) GetImageSize.Height = CombineBytes(bHlsb, bHmsb) End If 'GIF 文件 If bTemp(0) = &H47 And bTemp(1) = &H49 And bTemp(2) = &H46 _ And bTemp(3) = &H38 Then Get #iFN, 7, bWlsb Get #iFN, 8, bWmsb Get #iFN, 9, bHlsb Get #iFN, 10, bHmsb GetImageSize.Width = CombineBytes(bWlsb, bWmsb) GetImageSize.Height = CombineBytes(bHlsb, bHmsb) End If 'JPEG 文件 If bTemp(0) = &HFF And bTemp(1) = &HD8 And bTemp(2) = &HFF Then Debug.Print "JPEG" lPos = 3 Do Do Get #iFN, lPos, bBuf(1) Get #iFN, lPos + 1, bBuf(2) lPos = lPos + 1 Loop Until (bBuf(1) = &HFF And bBuf(2) <> &HFF) Or lPos > lFlen For iCount = 0 To 7 Get #iFN, lPos + iCount, bBuf(iCount) Next iCount If bBuf(0) >= &HC0 And bBuf(0) <= &HC3 Then bHmsb = bBuf(4) bHlsb = bBuf(5) bWmsb = bBuf(6) bWlsb = bBuf(7) bDone = 1 Else lPos = lPos + (CombineBytes(bBuf(2), bBuf(1))) + 1 End If Loop While lPos < lFlen And bDone = 0 GetImageSize.Width = CombineBytes(bWlsb, bWmsb) GetImageSize.Height = CombineBytes(bHlsb, bHmsb) End If 'BMP 文件 If bTemp(0) = &H42 And bTemp(1) = &H4D Then Get #iFN, 19, bWlsb Get #iFN, 20, bWmsb Get #iFN, 23, bHlsb Get #iFN, 24, bHmsb GetImageSize.Width = CombineBytes(bWlsb, bWmsb) GetImageSize.Height = CombineBytes(bHlsb, bHmsb) End If Close iFN End FunctionPrivate Function CombineBytes(lsb As Byte, msb As Byte) As Long CombineBytes = CLng(lsb + (msb * 256)) '把十六进制数换成十进制 End Function
'检查尺寸 Private Function fileImgSize(FileName As String) As LongDim Size As Long On Error GoTo load_img_Error: '打开文件 Open FileName For Binary Access Read As #1 '得到二进制数据的长度 Size = LOF(1) fileImgSize = Size '关闭文件 Close #1 Exit Function load_img_Error: MsgBox "打开文件错误,请检查文件是否存在或者是否已被打开" ' 避免错误 Exit FunctionEnd Function
Dim intH As Long '芞詢僅
Picture1.AutoSize = True
Picture1.ScaleMode = vbPixels
'覃猁聆彸煦望薹腔芞
Picture1.Picture = LoadPicture("C:\ddd.jpg")
'腕遵僅杅硉
intW = Picture1.ScaleWidth
'腕詢僅杅硉
intH = Picture1.ScaleHeight
Dim intH As Long '图片高度
Picture1.AutoSize = True
Picture1.ScaleMode = vbPixels
Picture1.Picture = LoadPicture("C:\ddd.jpg") intW = Picture1.ScaleWidth
intH = Picture1.ScaleHeight
要搞清各种图片的存储格式JPG,bmp等,才能知道什么位置存储了分辨率的数据。
'I have released this source code into the public domain. You may use it
'with no strings attached.
'Just call GetImageSize with a string containing the filename, and
'it will return a user defined type 'ImageSize' (see below)
'Return values of 0 indicate an error of some sort. The error handling
'in this module is limited. There is *NO* error handling on the test
'form. This routine is limited to X or Y sizes of 32767 pixels, but that
'should not be a problem.'Check back athttp://www.qtm.net/~davidc
'I may add support for more file types.'supported in this version:
'JPEG
'GIF
'PNG'This routine does not require any royalty fees for Unisys as it
'does nothing with the compressed part of GIF files. It simply reads
'4 bytes to determine image size.Option Explicit
Public WImg As Long
Public HImg As Long
Public Type ImageSize
Width As Long
Height As Long
End TypePublic Sub GetImageSize(sFileName As String)
On Error Resume Next 'you'll want to change this
Dim iFN As Integer
Dim bTemp(3) As Byte
Dim lFlen As Long
Dim lPos As Long
Dim bHmsb As Byte
Dim bHlsb As Byte
Dim bWmsb As Byte
Dim bWlsb As Byte
Dim bBuf(7) As Byte
Dim bDone As Byte
Dim iCount As IntegerlFlen = FileLen(sFileName)
iFN = FreeFile
Open sFileName For Binary As iFN
Get #iFN, 1, bTemp()'PNG file
If bTemp(0) = &H89 And bTemp(1) = &H50 And bTemp(2) = &H4E _
And bTemp(3) = &H47 Then
Get #iFN, 19, bWmsb
Get #iFN, 20, bWlsb
Get #iFN, 23, bHmsb
Get #iFN, 24, bHlsb
'GetImageSize.Width = CombineBytes(bWlsb, bWmsb)
'GetImageSize.Height = CombineBytes(bHlsb, bHmsb)
WImg = CombineBytes(bWlsb, bWmsb)
HImg = CombineBytes(bHlsb, bHmsb)
End If'GIF file
If bTemp(0) = &H47 And bTemp(1) = &H49 And bTemp(2) = &H46 _
And bTemp(3) = &H38 Then
Get #iFN, 7, bWlsb
Get #iFN, 8, bWmsb
Get #iFN, 9, bHlsb
Get #iFN, 10, bHmsb
'GetImageSize.Width = CombineBytes(bWlsb, bWmsb)
'GetImageSize.Height = CombineBytes(bHlsb, bHmsb)
WImg = CombineBytes(bWlsb, bWmsb)
HImg = CombineBytes(bHlsb, bHmsb)
End If
'JPEG file
If bTemp(0) = &HFF And bTemp(1) = &HD8 And bTemp(2) = &HFF Then
Debug.Print "JPEG"
lPos = 3
Do
Do
Get #iFN, lPos, bBuf(1)
Get #iFN, lPos + 1, bBuf(2)
lPos = lPos + 1
Loop Until (bBuf(1) = &HFF And bBuf(2) <> &HFF) Or lPos > lFlenFor iCount = 0 To 7
Get #iFN, lPos + iCount, bBuf(iCount)
Next iCount
If bBuf(0) >= &HC0 And bBuf(0) <= &HC3 Then
bHmsb = bBuf(4)
bHlsb = bBuf(5)
bWmsb = bBuf(6)
bWlsb = bBuf(7)
bDone = 1
Else
lPos = lPos + (CombineBytes(bBuf(2), bBuf(1))) + 1
End If
Loop While lPos < lFlen And bDone = 0
'GetImageSize.Width = CombineBytes(bWlsb, bWmsb)
'GetImageSize.Height = CombineBytes(bHlsb, bHmsb)
WImg = CombineBytes(bWlsb, bWmsb)
HImg = CombineBytes(bHlsb, bHmsb)
End If
Close iFNEnd Sub
Private Function CombineBytes(lsb As Byte, msb As Byte) As Long
CombineBytes = CLng(lsb + (msb * 256))
End Function
能不能说说从哪能得到这些文件的格式。因为我还想处理其它格式的文件,比如bmp什么的。
说实在的,我只研究过gif的格式
因为它很简单,只需读出它的几个字节就可以得出他的所有信息
这个代码我是看你问问题,在网上帮你找的,
要不你就到图书馆找找有关bmp的资料
好像以前看到过一些说明图像编码格式的书
你到北京图书馆去找找在线的书看看 给你一个bmp的例子非压缩BMP位图的宽度和高度在文件开始11H后的8个字节。
Sub testmp()Dim FileName As StringFileName = "c:\test.bmp"
Open FileName For Binary As #1
Get #1, 19, ImageWidth: Get #1, , ImageHeight '读取位图的宽度和高度
Close #1
DW = 15 * ImageWidth - ImageWin.Width '将像点转换为Twip(微点)
DH = 15 * ImageHeight - ImageWin.Height
End Sub
首先建立一个模块,输入如下内容。Public Type ImageSize
Width As Long
Height As Long
End TypePublic Function GetImageSize(sFileName As String) As ImageSize
On Error Resume Next
Dim iFN As Integer
Dim bTemp(3) As Byte
Dim lFlen As Long
Dim lPos As Long
Dim bHmsb As Byte
Dim bHlsb As Byte
Dim bWmsb As Byte
Dim bWlsb As Byte
Dim bBuf(7) As Byte
Dim bDone As Byte
Dim iCount As Integer
lFlen = FileLen(sFileName)
iFN = FreeFile
Open sFileName For Binary As iFN
Get #iFN, 1, bTemp()
'PNG 文件
If bTemp(0) = &H89 And bTemp(1) = &H50 And bTemp(2) = &H4E _
And bTemp(3) = &H47 Then
Get #iFN, 19, bWmsb
Get #iFN, 20, bWlsb
Get #iFN, 23, bHmsb
Get #iFN, 24, bHlsb
GetImageSize.Width = CombineBytes(bWlsb, bWmsb)
GetImageSize.Height = CombineBytes(bHlsb, bHmsb)
End If
'GIF 文件
If bTemp(0) = &H47 And bTemp(1) = &H49 And bTemp(2) = &H46 _
And bTemp(3) = &H38 Then
Get #iFN, 7, bWlsb
Get #iFN, 8, bWmsb
Get #iFN, 9, bHlsb
Get #iFN, 10, bHmsb
GetImageSize.Width = CombineBytes(bWlsb, bWmsb)
GetImageSize.Height = CombineBytes(bHlsb, bHmsb)
End If
'JPEG 文件
If bTemp(0) = &HFF And bTemp(1) = &HD8 And bTemp(2) = &HFF Then
Debug.Print "JPEG"
lPos = 3
Do
Do
Get #iFN, lPos, bBuf(1)
Get #iFN, lPos + 1, bBuf(2)
lPos = lPos + 1
Loop Until (bBuf(1) = &HFF And bBuf(2) <> &HFF) Or lPos > lFlen
For iCount = 0 To 7
Get #iFN, lPos + iCount, bBuf(iCount)
Next iCount
If bBuf(0) >= &HC0 And bBuf(0) <= &HC3 Then
bHmsb = bBuf(4)
bHlsb = bBuf(5)
bWmsb = bBuf(6)
bWlsb = bBuf(7)
bDone = 1
Else
lPos = lPos + (CombineBytes(bBuf(2), bBuf(1))) + 1
End If
Loop While lPos < lFlen And bDone = 0
GetImageSize.Width = CombineBytes(bWlsb, bWmsb)
GetImageSize.Height = CombineBytes(bHlsb, bHmsb)
End If
'BMP 文件
If bTemp(0) = &H42 And bTemp(1) = &H4D Then
Get #iFN, 19, bWlsb
Get #iFN, 20, bWmsb
Get #iFN, 23, bHlsb
Get #iFN, 24, bHmsb
GetImageSize.Width = CombineBytes(bWlsb, bWmsb)
GetImageSize.Height = CombineBytes(bHlsb, bHmsb)
End If
Close iFN
End FunctionPrivate Function CombineBytes(lsb As Byte, msb As Byte) As Long
CombineBytes = CLng(lsb + (msb * 256)) '把十六进制数换成十进制
End Function
Private Function fileImgSize(FileName As String) As LongDim Size As Long
On Error GoTo load_img_Error:
'打开文件 Open FileName For Binary Access Read As #1
'得到二进制数据的长度
Size = LOF(1)
fileImgSize = Size
'关闭文件
Close #1
Exit Function
load_img_Error:
MsgBox "打开文件错误,请检查文件是否存在或者是否已被打开"
' 避免错误
Exit FunctionEnd Function