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

2010-08-23 03:49:02 892 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

高光谱目标检测论文学习（1）—— Hyperspectral Target Detection:Hypothesis Testing,SNR and SA Theories 前言从这篇开始，将会学习一些高光谱目标检测的论文，我仍然把这篇文章放到了读论文专栏里，但是不对其进行顺序编号了，因为这个方向是比较小众的。今天来学习这篇TGRS2021的最新论文，讲的比较详细，相对比较适合初学者入门。我之前也写过一些有关目标检测的论文，但是高光谱目标检测（HTD）和之前的我们学的目标检测是不同的，因为其检测的对象不是普通摄像头得来的数字图像，而是高光谱遥感图像。其包含了很多光谱信息，而光谱信息本身经过处理后就可以作为特征，因此很多情况下就无需使用广义的目标检测问题中的卷积神经网络等方式去阅读详情

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

...全文

手把手教你用光耦搭建安全隔离电路：从洗衣机控制板到PLC输入模块实战本文通过洗衣机控制板驱动高压电机和PLC输入模块采集现场信号两个实战场景，手把手教你使用光耦搭建安全隔离电路。文章详细解析了电路架构、关键器件选型、参数计算、仿真验证及PCB布局避坑技巧，并对比了光耦与数字隔离器的适用场景，帮助电子工程师掌握这门保障系统稳定与安全的必备技能。阅读详情

zhengjialon

多媒体 807 成员 8,274 内容

+ 关注 + 加入社区

切换为时间正序

橘子皮... 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

打赏
举报

'在模块中写如下代码: 

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

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 获取图片的像素大小的问题

相关推荐