VB 获取图片的像素大小的问题

zhengjialon 2010-08-23 03:49:02
为了防止用户把像索超大的图片文件存到数据库中，所以以想在图片存入DB之前得到图片的像索大小加以提示，因为相同像索的图片会因为文件类型不一样（比如相同像索的BMP就会比GIF文件大小大），所以不能以图片大小来判断 。
...全文
808 17 打赏 收藏 转发到动态 举报
AI 作业
写回复
用AI写文章
17 条回复
切换为时间正序
请发表友善的回复…
发表回复
橘子皮... 2010-09-29
  • 打赏
  • 举报
 回复
a = imgInfo("c:\1.gif")
MsgBox a(1)

Private Function imgInfo(IMGPath) '若文件存在,返回imgInfo(0->3),其中1和2是宽和高,0是文件类型
Dim FSO,IMGFile,FileExt,Arr
Set FSO = CreateObject("Scripting.FileSystemObject")
If (FSO.FileExists(IMGPath)) Then
Set IMGFile = FSO.GetFile(IMGPath)
FileExt=FSO.GetExtensionName(IMGPath)
Select Case FileExt
Case "gif","bmp","jpg","png":
Arr=getImageSize(IMGFile.Path)
imgInfo = Arr
End Select
Set IMGFile=Nothing
Else
imgInfo = Split("文件不存在/文件不存在/文件不存在/文件不存在","/")
End If
Set FSO=Nothing
End Function

Private Function GetImageSize(filespec)
Set ASO=CreateObject("ADODB.Stream")
ASO.Mode=3
ASO.Type=1
ASO.Open

Dim bFlag
Dim Ret(3)
ASO.LoadFromFile(filespec)
bFlag=ASO.Read(3)
Select Case Hex(binVal(bFlag))
Case "4E5089":
ASO.Read(15)
ret(0)="PNG"
ret(1)=BinVal2(ASO.Read(2))
ASO.Read(2)
ret(2)=BinVal2(ASO.Read(2))
Case "464947":
ASO.read(3)
ret(0)="gif"
ret(1)=BinVal(ASO.Read(2))
ret(2)=BinVal(ASO.Read(2))
Case "535746":
ASO.read(5)
binData=ASO.Read(1)
sConv=Num2Str(ascb(binData),2 ,8)
nBits=Str2Num(left(sConv,5),2)
sConv=mid(sConv,6)
While(len(sConv)<nBits*4)
binData=ASO.Read(1)
sConv=sConv&Num2Str(AscB(binData),2 ,8)
Wend
ret(0)="SWF"
ret(1)=Int(Abs(Str2Num(Mid(sConv,1*nBits+1,nBits),2)-Str2Num(Mid(sConv,0*nBits+1,nBits),2))/20)

ret(2)=Int(Abs(Str2Num(Mid(sConv,3*nBits+1,nBits),2)-Str2Num(Mid(sConv,2*nBits+1,nBits),2))/20)

Case "FFD8FF":
Do
Do: p1=binVal(ASO.Read(1)): Loop While p1=255 And Not ASO.EOS
If p1>191 And p1<196 Then Exit Do Else ASO.read(binval2(ASO.Read(2))-2)
Do:p1=binVal(ASO.Read(1)):Loop While p1<255 And Not ASO.EOS
Loop While True
ASO.Read(3)
ret(0)="JPG"
ret(2)=binval2(ASO.Read(2))
ret(1)=binval2(ASO.Read(2))
Case Else:
If left(Bin2Str(bFlag),2)="BM" Then
ASO.Read(15)
ret(0)="BMP"
ret(1)=binval(ASO.Read(4))
ret(2)=binval(ASO.Read(4))
Else
ret(0)=""
End If
End Select
ret(3)="width=""" & ret(1) &""" height=""" & ret(2) &""""
GetImageSize=ret
Set ASO = nothing
End Function


Private Function Bin2Str(Bin)
Dim I, Str
For I=1 To LenB(Bin)
clow=MidB(Bin,I,1)
If ASCB(clow)<128 Then
Str = Str & Chr(ASCB(clow))
Else
I=I+1
If I <= LenB(Bin) Then Str = Str & Chr(ASCW(MidB(Bin,I,1)&clow))
End If
Next
Bin2Str = Str
End Function

Private Function Num2Str(Num,Base,Lens)
Dim Ret
Ret = ""
While(Num>=Base)
Ret = (Num Mod Base) & Ret
Num = (Num - Num Mod Base)/Base
Wend
Num2Str = Right(String(Lens,"0") & Num & Ret,Lens)
End Function

Private Function Str2Num(Str,Base)
Dim Ret,I
Ret = 0
For I=1 To Len(Str)
Ret = Ret *base + Cint(Mid(Str,I,1))
Next
Str2Num=Ret
End Function

Private Function BinVal(Bin)
Dim Ret,I
Ret = 0
For I = LenB(Bin) To 1 Step -1
Ret = Ret *256 + AscB(MidB(Bin,I,1))
Next
BinVal=Ret
End Function

Private Function BinVal2(Bin)
Dim Ret,I
Ret = 0
For I = 1 To LenB(Bin)
Ret = Ret *256 + AscB(MidB(Bin,I,1))
Next
BinVal2=Ret
End Function
=====================================================================================================================
<%

IMGPath="pics/test.gif"
Set PP=New ImgWHInfo
W = PP.imgW(Server.Mappath(IMGPath))
H = PP.imgH(Server.Mappath(IMGPath))
Set pp=Nothing
Response.Write("<img src='"&IMGPath&"' border=0><br>宽:"&W&";高:"&H)

%>

<%
Class ImgWHInfo '获取图片宽度和高度的类，支持JPG，GIF，PNG，BMP
Dim ASO,p1
Private Sub Class_Initialize
Set ASO=Server.CreateObject("ADODB.Stream")
ASO.Mode=3
ASO.Type=1
ASO.Open
End Sub
Private Sub Class_Terminate
Err.Clear
Set ASO=Nothing
End Sub

Private Function Bin2Str(Bin)
Dim I, Str
For I=1 To LenB(Bin)
clow=MidB(Bin,I,1)
If ASCB(clow)<128 Then
Str = Str & Chr(ASCB(clow))
Else
I=I+1
If I <= LenB(Bin) Then Str = Str & Chr(ASCW(MidB(Bin,I,1)&clow))
End If
Next
Bin2Str = Str
End Function

Private Function Num2Str(Num,Base,Lens)
Dim Ret
Ret = ""
While(Num>=Base)
Ret = (Num Mod Base) & Ret
Num = (Num - Num Mod Base)/Base
Wend
Num2Str = Right(String(Lens,"0") & Num & Ret,Lens)
End Function

Private Function Str2Num(Str,Base)
Dim Ret,I
Ret = 0
For I=1 To Len(Str)
Ret = Ret *base + Cint(Mid(Str,I,1))
Next
Str2Num=Ret
End Function

Private Function BinVal(Bin)
Dim Ret,I
Ret = 0
For I = LenB(Bin) To 1 Step -1
Ret = Ret *256 + AscB(MidB(Bin,I,1))
Next
BinVal=Ret
End Function

Private Function BinVal2(Bin)
Dim Ret,I
Ret = 0
For I = 1 To LenB(Bin)
Ret = Ret *256 + AscB(MidB(Bin,I,1))
Next
BinVal2=Ret
End Function

Private Function GetImageSize(filespec)
Dim bFlag
Dim Ret(3)
ASO.LoadFromFile(filespec)
bFlag=ASO.Read(3)
Select Case Hex(binVal(bFlag))
Case "4E5089":
ASO.Read(15)
ret(0)="PNG"
ret(1)=BinVal2(ASO.Read(2))
ASO.Read(2)
ret(2)=BinVal2(ASO.Read(2))
Case "464947":
ASO.read(3)
ret(0)="gif"
ret(1)=BinVal(ASO.Read(2))
ret(2)=BinVal(ASO.Read(2))
Case "535746":
ASO.read(5)
binData=ASO.Read(1)
sConv=Num2Str(ascb(binData),2 ,8)
nBits=Str2Num(left(sConv,5),2)
sConv=mid(sConv,6)
While(len(sConv)<nBits*4)
binData=ASO.Read(1)
sConv=sConv&Num2Str(AscB(binData),2 ,8)
Wend
ret(0)="SWF"
ret(1)=Int(Abs(Str2Num(Mid(sConv,1*nBits+1,nBits),2)-Str2Num(Mid(sConv,0*nBits+1,nBits),2))/20)


ret(2)=Int(Abs(Str2Num(Mid(sConv,3*nBits+1,nBits),2)-Str2Num(Mid(sConv,2*nBits+1,nBits),2))/20)


Case "FFD8FF":
Do
Do: p1=binVal(ASO.Read(1)): Loop While p1=255 And Not ASO.EOS
If p1>191 And p1<196 Then Exit Do Else ASO.read(binval2(ASO.Read(2))-2)
Do:p1=binVal(ASO.Read(1)):Loop While p1<255 And Not ASO.EOS
Loop While True
ASO.Read(3)
ret(0)="JPG"
ret(2)=binval2(ASO.Read(2))
ret(1)=binval2(ASO.Read(2))
Case Else:
If left(Bin2Str(bFlag),2)="BM" Then
ASO.Read(15)
ret(0)="BMP"
ret(1)=binval(ASO.Read(4))
ret(2)=binval(ASO.Read(4))
Else
ret(0)=""
End If
End Select
ret(3)="width=""" & ret(1) &""" height=""" & ret(2) &""""
getimagesize=ret
End Function

Public Function imgW(IMGPath)
Dim FSO,IMGFile,FileExt,Arr
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
If (FSO.FileExists(IMGPath)) Then
Set IMGFile = FSO.GetFile(IMGPath)
FileExt=FSO.GetExtensionName(IMGPath)
Select Case FileExt
Case "gif","bmp","jpg","png":
Arr=GetImageSize(IMGFile.Path)
imgW = Arr(1)
End Select
Set IMGFile=Nothing
Else
imgW = 0
End If
Set FSO=Nothing
End Function

Public Function imgH(IMGPath)
Dim FSO,IMGFile,FileExt,Arr
Set FSO = server.CreateObject("Scripting.FileSystemObject")
If (FSO.FileExists(IMGPath)) Then
Set IMGFile = FSO.GetFile(IMGPath)
FileExt=FSO.GetExtensionName(IMGPath)
Select Case FileExt
Case "gif","bmp","jpg","png":
Arr=getImageSize(IMGFile.Path)
imgH = Arr(2)
End Select
Set IMGFile=Nothing
Else
imgH = 0
End If
Set FSO=Nothing
End Function
End Class
%>
jhone99 2010-09-29
  • 打赏
  • 举报
 回复 1 
'在模块中写如下代码: 

'*************************************************************************************************** 

Public   Type   ImageSize 

      Width   As   Long 

      Height   As   Long 

End   Type 



Public   Function   GetImageSize(sFileName   As   String)   As   ImageSize 

      On   Error   Resume   Next 

      Dim   bTemp(3)   As   Byte,   lPos   As   Long,   lFlen   As   Long 

      Open   sFileName   For   Binary   As   #1 

              lFlen   =   LOF(1) 

              Get   #1,   1,   bTemp() 

              

              If   bTemp(0)   =   &H89   And   bTemp(1)   =   &H50   And   bTemp(2)   =   &H4E   And   bTemp(3)   =   &H47   Or   bTemp(0)   =   &H42   And   bTemp(1)   =   &H4D   Then 

              Debug.Print   "\PNG   OR   BMP\ " 

                      Get   #1,   19,   bTemp 

                      GetImageSize.Width   =   byte2long(bTemp(0),   bTemp(1)) 

                      Get   #1,   23,   bTemp 

                      GetImageSize.Height   =   byte2long(bTemp(0),   bTemp(1)) 

              End   If 

              

              'JPG   

              If   bTemp(0)   =   &HFF   And   bTemp(1)   =   &HD8   And   bTemp(2)   =   &HFF   Then 

                      Debug.Print   "\JPEG\ " 

                      lPos   =   4 

                      Do 

                              Do 

                                      Get   #1,   lPos,   bTemp 

                                      lPos   =   lPos   +   1 

                              Loop   Until   (bTemp(0)   =   &HFF   And   bTemp(1)   <>   &HFF)   Or   lPos   >   lFlen 

                      

                              Get   #1,   lPos,   bTemp 

                                      

                              If   bTemp(0)   > =   &HC0   And   bTemp(0)   <=   &HC3   Then 

                                      Get   #1,   lPos   +   4,   bTemp 

                                      Exit   Do 

                              Else 

                                      lPos   =   lPos   +   (byte2long(bTemp(2),   bTemp(1)))   +   1 

                              End   If 

                      Loop   While   lPos   <   lFlen 

                      GetImageSize.Width   =   byte2long(bTemp(3),   bTemp(2)) 

                      GetImageSize.Height   =   byte2long(bTemp(1),   bTemp(0)) 

              End   If 



              'GIF   file 

              If   bTemp(0)   =   &H47   And   bTemp(1)   =   &H49   And   bTemp(2)   =   &H46   And   bTemp(3)   =   &H38   Then 

                      Debug.Print   "\GIF\ " 

                      Get   #1,   7,   bTemp 

                      GetImageSize.Width   =   byte2long(bTemp(0),   bTemp(1)) 

                      GetImageSize.Height   =   byte2long(bTemp(2),   bTemp(3)) 

              End   If 

                      

              'PSD   

              If   bTemp(0)   =   &H38   And   bTemp(1)   =   &H42   And   bTemp(2)   =   &H50   And   bTemp(3)   =   &H53   Then 

                      Debug.Print   "\PSD\ " 

                      Get   #1,   17,   bTemp 

                      GetImageSize.Width   =   byte2long(bTemp(1),   bTemp(0)) 

                      Get   #1,   21,   bTemp 

                      GetImageSize.Height   =   byte2long(bTemp(1),   bTemp(0)) 

              End   If 

              

              'TIF   

              If   bTemp(0)   =   &H4D   And   bTemp(1)   =   &H4D   And   bTemp(2)   =   &H0   And   bTemp(3)   =   &H2A   Then 

                      Debug.Print   "\TIF1\ " 

                      Get   #1,   31,   bTemp 

                      GetImageSize.Width   =   byte2long(bTemp(1),   bTemp(0)) 

                      Get   #1,   43,   bTemp 

                      GetImageSize.Height   =   byte2long(bTemp(1),   bTemp(0)) 

              End   If 

              

              If   bTemp(0)   =   &H49   And   bTemp(1)   =   &H49   And   bTemp(2)   =   &H2A   And   bTemp(3)   =   &H0   Then 

                      Get   #1,   5,   bTemp 

                      If   bTemp(0)   =   &H8   And   bTemp(1)   =   &H0   And   bTemp(2)   =   &H0   And   bTemp(3)   =   &H0   Then 

                              'TIF   

                              Debug.Print   "\TIF2-1\ " 

                              Get   #1,   31,   bTemp 

                              GetImageSize.Width   =   byte2long(bTemp(0),   bTemp(1)) 

                              Get   #1,   43,   bTemp 

                              GetImageSize.Height   =   byte2long(bTemp(0),   bTemp(1)) 

                      Else 

                              'TIF   

                              Debug.Print   "\TIF2-2\ " 

                              lPos   =   byte2long(bTemp(0),   bTemp(1))   +   byte2long(bTemp(2),   bTemp(3))   *   65536   +   11 

                              Get   #1,   lPos,   bTemp 

                              GetImageSize.Width   =   byte2long(bTemp(0),   bTemp(1)) 

                              Get   #1,   lPos   +   12,   bTemp 

                              GetImageSize.Height   =   byte2long(bTemp(0),   bTemp(1)) 

                      End   If 

              End   If 



      Close   #1 

End   Function 



Public   Function   byte2long(ByVal   lsb   As   Long,   ByVal   msb   As   Long)   As   Long   

      byte2long   =   lsb   +   (msb   *   256) 

End   Function 



'****************************************************************************************************** 


'窗口中的代码: 

Private   Sub   Command1_Click() 

    Dim   a   As   ImageSize 

    a   =   GetImageSize( "D:\2.jpg ") 

    Text1.Text=   a.Height     &   "像素 " 

    Text2.Text   =   a.Width   &   "像素 " 

End   Sub
zhengjialon 2010-09-17
  • 打赏
  • 举报
 回复
[Quote=引用 12 楼 chenjl1031 的回复:]

直接用纯API获得图片尺寸，无需Picturebox控件。:)
[/Quote]请问如何用API取像索？
东方之珠 2010-09-14
  • 打赏
  • 举报
 回复
直接用纯API获得图片尺寸，无需Picturebox控件。:)
getemail 2010-09-13
  • 打赏
  • 举报
 回复
放到PictureBox里面，PictureBox的AutoSize设置为True
然后在判断PictureBox高度和宽度不就可以了？
zhengjialon 2010-09-13
  • 打赏
  • 举报
 回复
[Quote=引用 8 楼 wallescai 的回复:]

引用楼主 zhengjialon 的回复:
为了防止用户把像索超大的图片文件存到数据库中，所以以想在图片存入DB之前得到图片的像索大小加以提示，因为相同像索的图片会因为文件类型不一样（比如相同像索的BMP就会比GIF文件大小大），所以不能以图片大小来判断 。

如果楼主只是为了防止撑爆数据库的话,只需要限定保存到数据库的图片文件大小就可以了,随便它什么格式,只要文件尺寸不超过限定就可以了.……
[/Quote]不仅仅要限制大小，还要图片的像素达到一个标准，比如800*600
熊孩子开学喽 2010-08-30
  • 打赏
  • 举报
 回复
[Quote=引用楼主 zhengjialon 的回复:]
为了防止用户把像索超大的图片文件存到数据库中，所以以想在图片存入DB之前得到图片的像索大小加以提示，因为相同像索的图片会因为文件类型不一样（比如相同像索的BMP就会比GIF文件大小大），所以不能以图片大小来判断 。
[/Quote]
如果楼主只是为了防止撑爆数据库的话,只需要限定保存到数据库的图片文件大小就可以了,随便它什么格式,只要文件尺寸不超过限定就可以了. 这样就比较简单了, 很多论坛也都是这么干的. 至于这个图片文件显示尺寸不是你的事了, 谁让用户自己不用压缩格式的呢? 就像发电子邮件,只会限定你附件的大小,而不会来规定附件的格式.
tubo_true 2010-08-24
  • 打赏
  • 举报
 回复
柯达的那个控件imgedit.ocx就什么都解决了
bcrun 2010-08-24
  • 打赏
  • 举报
 回复
[Quote=引用 3 楼 laviewpbt 的回复:]
2楼的回答太有损星星的名誉了。
[/Quote]

2楼是楼主在问啊,不想把图片读到Picture中的话,那就要根据各种图片类型的文件的格式,读取文件头中有关图片宽和高的定义的数据了.:)
chinaboyzyq 2010-08-23
  • 打赏
  • 举报
 回复 


Private Sub Form_Load()

   

   Dim p As Picture, x, y

   Set p = LoadPicture("c:\1.jpg")

   'ScaleMode = 3 '可以加这句，就不用除15了，根据需要选。

   x = ScaleX(p.Width) \ 15

   y = ScaleY(p.Height) \ 15

   Debug.Print x, y

   Set p = Nothing

   

End Sub
zhengjialon 2010-08-23
  • 打赏
  • 举报
 回复
我使用以下的方法：
Public Function GetPicSize(FileName As String, lngH As Long, lngW As Long) As Boolean
Dim pic As stdole.IPictureDisp
Set pic = LoadPicture(FileName) ' SysCmd(712, Me.Image0)
lngH = pic.Height
lngW = pic.Width
Set pic = Nothing
End Function
这样得到的数据正确吗？
laviewpbt 2010-08-23
  • 打赏
  • 举报
 回复
2楼的回答太有损星星的名誉了。
zhengjialon 2010-08-23
  • 打赏
  • 举报
 回复
有没有不用Picture控件实现的方法？
孤独剑_LPZ 2010-08-23
  • 打赏
  • 举报
 回复
1. 加一个Picture1
Picture1和form1的scaleMode 选 3 - pixel
Picture1的autosize = true
代码:
Private Sub Form_Load()
picture1.picture=loadpicture("*******图像的具体文件名********") '例如 "c:\lyer\liu.jpg"
msgbox "长:" & picture1.width & "宽:" & picture1.height
End Sub

2. 用api
图片框的.ScaleMode =0 ，是自定义类型
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Sub Command1_Click()
Dim cxy As RECT
Label8 = GetWindowRect(Picture1.hwnd, cxy)
Label6 = cxy.Right
Label7 = cxy.Bottom
End Sub
Vb获取图片尺寸大小
在VB（Visual Basic）编程中，获取图片的尺寸大小，包括长度、宽度以及彩色位数，是常见的操作，尤其在处理图像数据时。这涉及到对图像文件的读取和解析，以便获取其元数据。以下将详细介绍如何在VB中实现这一功能。...
VB获取图片大小.rar
这个压缩包“VB获取图片大小.rar”提供了一个示例程序，它能够帮助开发者检测图像文件的大小，并实时显示这些信息。下面将详细解释如何在VB中实现这一功能，以及涉及的相关知识点。 首先，我们需要理解“图像大小”...
vb 对图像进行二值化处理 获取图片信息
至于获取图片信息，这通常包括图像的尺寸（宽度和高度）、颜色模式、位深度、文件大小等。在VB中，我们可以使用`Image`类的属性来获取这些信息。例如，`Width`和`Height`属性返回图像的像素宽度和高度，`Format`属性...
VB图片放大动作 VB图片放大动作
另外，放大图片可能会导致像素化，为了保持图片质量，可以选择合适的插值算法，如Bicubic或Bilinear Interpolation。 综上所述，VB中的图片放大可以通过创建`Graphics`对象，设置放大比例，计算新尺寸，以及使用`...
基于VB的图片查看器
【描述】中提到的“获取图片的相关信息”可能包括图片的元数据，如文件大小、分辨率、创建日期、作者信息以及图片的宽高比等。元数据是关于图像的非视觉信息，对于理解和管理图片文件非常有用。而“将图片由24位转换...
多媒体

808

社区成员

8,274

社区内容

发帖
与我相关
我的任务
社区描述
VB 多媒体
社区管理员
  • 多媒体
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章