[求助]求一个能够获取图像大小（如800*600）的api函数

FENGJUN

求一个能够获取图像大小（如800*600）的api函数

agstick

网上找的

//====================================================================
// 函数: of_getpicturesize()
//--------------------------------------------------------------------
// 描述: 获得图片文件的图像尺寸大小(支持GIF,JPG,BMP格式)
//--------------------------------------------------------------------
// 参数:
//value    stringas_FileName     图片文件名称
//referencelong  al_PictureWidth 返回图片宽度
//referencelong  al_PictureHeight返回图片高度
//--------------------------------------------------------------------
// 返回值:  integer1 - 成功,0 - 失败
//--------------------------------------------------------------------

Integer li_File, li_DataRead
Blob lb_Data
Long ll_FileLength,ll_PictureWidth,ll_PictureHeight
Long ll_DataLen,ll_DataPos,ll_FilePos
Boolean lb_LoopFlag = True
Char lc_Char1,lc_Char2

//文件不存在
If Not FileExists(as_FileName) Then Return 0

//取文件大小
ll_FileLength = FileLength(as_FileName)

//打开文件
li_File = FileOpen(as_FileName,StreamMode!)
If li_File = -1 Then Return 0

//读取文件
li_DataRead = FileRead(li_File,lb_Data)
If li_DataRead <= 0 Then
FileClose(li_File)
Return 0
End If

// GIF目前主要有两种类型
// 1. 标识为GIF87a, 只是用来存储单幅静止图像
// 2. 标识为GIF89a, 可以同时存储若干幅静止图像并进而形成连续的动画
// 文件的前 6 个字节为标识:GIF87a 或 GIF89a, 第 7,8 字节为图像宽度(width),
// 第 9,10 字节为图像高度(height), 注意两个字节中低位在前

// GIF 文件格式判断
If String(BlobMid(lb_Data,1,4)) = 'GIF8' Then
ll_PictureWidth = Asc(String(BlobMid(lb_Data,7,1))) + Asc(String(BlobMid(lb_Data,8,1))) *

256
ll_PictureHeight = Asc(String(BlobMid(lb_Data,9,1))) + Asc(String(BlobMid(lb_Data,10,1)))

* 256
If ll_PictureWidth > 0 And ll_PictureHeight > 0 Then
al_PictureWidth = ll_PictureWidth
al_PictureHeight = ll_PictureHeight
FileClose(li_File)
Return 1
Else
FileClose(li_File)
Return 0
End If
End If

// JPEG文件格式
// 前 3 个字节为标识: 0xFF,0xD8,0xFF
If String(BlobMid(lb_Data,1,3)) = Char(255) + Char(216) + Char(255) Then
ll_DataLen = Len(lb_Data)
ll_DataPos = 3
ll_FilePos = 3
Do While lb_LoopFlag
ll_DataPos = ll_DataPos + 1
ll_FilePos = ll_FilePos + 1
lc_Char1 = String(BlobMid(lb_Data,ll_DataPos,1))
lc_Char2 = String(BlobMid(lb_Data,ll_DataPos + 1,1))
If lc_Char1 = Char(255) And lc_Char2 <> Char(255) Then
If lc_Char2 >= Char(192) And lc_Char2 <= Char(195) Then
//找到尺寸数据
ll_PictureWidth = Asc(String(BlobMid(lb_Data,ll_DataPos + 7,1))) *

256 + Asc(String(BlobMid(lb_Data,ll_DataPos + 8,1)))
ll_PictureHeight = Asc(String(BlobMid(lb_Data,ll_DataPos + 5,1)))

* 256 + Asc(String(BlobMid(lb_Data,ll_DataPos + 6,1)))
lb_LoopFlag = False
Else
//没有找到尺寸数据,重新读取文件
ll_FilePos = ll_FilePos + Asc(String(BlobMid(lb_Data,ll_DataPos +

3,1))) * 256 + Asc(String(BlobMid(lb_Data,ll_DataPos + 2,1))) + 1
If ll_FilePos > ll_FileLength Then
FileClose(li_File)
Return 0
Else
FileSeek(li_File,ll_FilePos)
FileRead(li_File,lb_Data)
ll_DataLen = Len(lb_Data)
ll_DataPos = 0
End If
End If
End If
If ll_DataPos = ll_DataLen - 9 And lb_LoopFlag = True Then
ll_FilePos = ll_FilePos - 9
FileSeek(li_File,ll_FilePos)
FileRead(li_File,lb_Data)
ll_DataLen = Len(lb_Data)
ll_DataPos = 0
End If
If ll_FilePos >= ll_FileLength Then
lb_LoopFlag = False
End If
Loop
If ll_PictureWidth > 0 And ll_PictureHeight > 0 Then
al_PictureWidth = ll_PictureWidth
al_PictureHeight = ll_PictureHeight
FileClose(li_File)
Return 1
Else
FileClose(li_File)
Return 0
End If
End If

// BMP文件格式
// 前两个字节是标识:标识可能有很多种
// 第 19,20,21,22 字节为宽度(width), 第 23,24,25,26 字节为高度(height)
// 四个字节组成dword, 低位在前
If String(BlobMid(lb_Data,1,2)) = 'BM' Then
ll_PictureWidth = Asc(String(BlobMid(lb_Data,19,1))) + Asc(String(BlobMid(lb_Data,20,1)))

* 256 + Asc(String(BlobMid(lb_Data,21,1))) * 65536 + Asc(String(BlobMid(lb_Data,22,1))) * 16777216
ll_PictureHeight = Asc(String(BlobMid(lb_Data,23,1))) + Asc(String(BlobMid(lb_Data,24,1)))

* 256 + Asc(String(BlobMid(lb_Data,25,1))) * 65536 + Asc(String(BlobMid(lb_Data,26,1))) * 16777216
If ll_PictureWidth > 0 And ll_PictureHeight > 0 Then
al_PictureWidth = ll_PictureWidth
al_PictureHeight = ll_PictureHeight
////将图像的真实大小转换为PBUnit大小，并返回
//al_PictureWidth = PixelsToUnits(ll_PictureWidth,XPixelsToUnits!)
//al_PictureHeight = PixelsToUnits(ll_PictureHeight,YPixelsToUnits!)
FileClose(li_File)
Return 1
Else
FileClose(li_File)
Return 0
End If
End If

Return 0

sgrshh29

要试试看，先谢谢二楼版主

FENGJUN

QUOTE:

以下是引用agstick在2007-9-3 12:14:24的发言：

网上找的

//====================================================================
// 函数: of_getpicturesize()
//--------------------------------------------------------------------
// 描述: 获得图片文件的图像尺寸大小(支持GIF,JPG,BMP格式)
//--------------------------------------------------------------------
// 参数:
//value    stringas_FileName     图片文件名称
//referencelong  al_PictureWidth 返回图片宽度
//referencelong  al_PictureHeight返回图片高度
//--------------------------------------------------------------------
// 返回值:  integer1 - 成功,0 - 失败
//--------------------------------------------------------------------

Integer li_File, li_DataRead
Blob lb_Data
Long ll_FileLength,ll_PictureWidth,ll_PictureHeight
Long ll_DataLen,ll_DataPos,ll_FilePos
Boolean lb_LoopFlag = True
Char lc_Char1,lc_Char2

//文件不存在
If Not FileExists(as_FileName) Then Return 0

//取文件大小
ll_FileLength = FileLength(as_FileName)

//打开文件
li_File = FileOpen(as_FileName,StreamMode!)
If li_File = -1 Then Return 0

//读取文件
li_DataRead = FileRead(li_File,lb_Data)
If li_DataRead <= 0 Then
FileClose(li_File)
Return 0
End If

// GIF目前主要有两种类型
// 1. 标识为GIF87a, 只是用来存储单幅静止图像
// 2. 标识为GIF89a, 可以同时存储若干幅静止图像并进而形成连续的动画
// 文件的前 6 个字节为标识:GIF87a 或 GIF89a, 第 7,8 字节为图像宽度(width),
// 第 9,10 字节为图像高度(height), 注意两个字节中低位在前

// GIF 文件格式判断
If String(BlobMid(lb_Data,1,4)) = 'GIF8' Then
ll_PictureWidth = Asc(String(BlobMid(lb_Data,7,1))) + Asc(String(BlobMid(lb_Data,8,1))) *

256
ll_PictureHeight = Asc(String(BlobMid(lb_Data,9,1))) + Asc(String(BlobMid(lb_Data,10,1)))

* 256
If ll_PictureWidth > 0 And ll_PictureHeight > 0 Then
al_PictureWidth = ll_PictureWidth
al_PictureHeight = ll_PictureHeight
FileClose(li_File)
Return 1
Else
FileClose(li_File)
Return 0
End If
End If

// JPEG文件格式
// 前 3 个字节为标识: 0xFF,0xD8,0xFF
If String(BlobMid(lb_Data,1,3)) = Char(255) + Char(216) + Char(255) Then
ll_DataLen = Len(lb_Data)
ll_DataPos = 3
ll_FilePos = 3
Do While lb_LoopFlag
ll_DataPos = ll_DataPos + 1
ll_FilePos = ll_FilePos + 1
lc_Char1 = String(BlobMid(lb_Data,ll_DataPos,1))
lc_Char2 = String(BlobMid(lb_Data,ll_DataPos + 1,1))
If lc_Char1 = Char(255) And lc_Char2 <> Char(255) Then
If lc_Char2 >= Char(192) And lc_Char2 <= Char(195) Then
//找到尺寸数据
ll_PictureWidth = Asc(String(BlobMid(lb_Data,ll_DataPos + 7,1))) *

256 + Asc(String(BlobMid(lb_Data,ll_DataPos + 8,1)))
ll_PictureHeight = Asc(String(BlobMid(lb_Data,ll_DataPos + 5,1)))

* 256 + Asc(String(BlobMid(lb_Data,ll_DataPos + 6,1)))
lb_LoopFlag = False
Else
//没有找到尺寸数据,重新读取文件
ll_FilePos = ll_FilePos + Asc(String(BlobMid(lb_Data,ll_DataPos +

3,1))) * 256 + Asc(String(BlobMid(lb_Data,ll_DataPos + 2,1))) + 1
If ll_FilePos > ll_FileLength Then
FileClose(li_File)
Return 0
Else
FileSeek(li_File,ll_FilePos)
FileRead(li_File,lb_Data)
ll_DataLen = Len(lb_Data)
ll_DataPos = 0
End If
End If
End If
If ll_DataPos = ll_DataLen - 9 And lb_LoopFlag = True Then
ll_FilePos = ll_FilePos - 9
FileSeek(li_File,ll_FilePos)
FileRead(li_File,lb_Data)
ll_DataLen = Len(lb_Data)
ll_DataPos = 0
End If
If ll_FilePos >= ll_FileLength Then
lb_LoopFlag = False
End If
Loop
If ll_PictureWidth > 0 And ll_PictureHeight > 0 Then
al_PictureWidth = ll_PictureWidth
al_PictureHeight = ll_PictureHeight
FileClose(li_File)
Return 1
Else
FileClose(li_File)
Return 0
End If
End If

// BMP文件格式
// 前两个字节是标识:标识可能有很多种
// 第 19,20,21,22 字节为宽度(width), 第 23,24,25,26 字节为高度(height)
// 四个字节组成dword, 低位在前
If String(BlobMid(lb_Data,1,2)) = 'BM' Then
ll_PictureWidth = Asc(String(BlobMid(lb_Data,19,1))) + Asc(String(BlobMid(lb_Data,20,1)))

* 256 + Asc(String(BlobMid(lb_Data,21,1))) * 65536 + Asc(String(BlobMid(lb_Data,22,1))) * 16777216
ll_PictureHeight = Asc(String(BlobMid(lb_Data,23,1))) + Asc(String(BlobMid(lb_Data,24,1)))

* 256 + Asc(String(BlobMid(lb_Data,25,1))) * 65536 + Asc(String(BlobMid(lb_Data,26,1))) * 16777216
If ll_PictureWidth > 0 And ll_PictureHeight > 0 Then
al_PictureWidth = ll_PictureWidth
al_PictureHeight = ll_PictureHeight
////将图像的真实大小转换为PBUnit大小，并返回
//al_PictureWidth = PixelsToUnits(ll_PictureWidth,XPixelsToUnits!)
//al_PictureHeight = PixelsToUnits(ll_PictureHeight,YPixelsToUnits!)
FileClose(li_File)
Return 1
Else
FileClose(li_File)
Return 0
End If
End If

Return 0

版主：这是个PowerBuilder的函数啊，能否改写成Vba的？

agstick

那个太罗唆了，换这个把

Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
   
Private Type BITMAP
    bmType   As Long
    bmWidth   As Long
    bmHeight   As Long
    bmWidthBytes   As Long
    bmPlanes   As Integer
    bmBitsPixel   As Integer
    bmBits   As Long
End Type

Public Sub psize()

    Dim bm As BITMAP
    Dim picPicture As IPictureDisp

    Set picPicture = stdole.LoadPicture("e:\gta.bmp")
   

    Call GetObjectAPI(picPicture, Len(bm), bm)
    MsgBox "大小  :  " & bm.bmWidth & "×" & bm.bmHeight

End Sub

[此贴子已经被作者于2007-9-3 14:29:37编辑过]

northwolves

QUOTE:

以下是引用agstick在2007-9-3 14:27:39的发言：

那个太罗唆了，换这个把

Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
   
Private Type BITMAP
    bmType   As Long
    bmWidth   As Long
    bmHeight   As Long
    bmWidthBytes   As Long
    bmPlanes   As Integer
    bmBitsPixel   As Integer
    bmBits   As Long
End Type

Public Sub psize()

    Dim bm As BITMAP
    Dim picPicture As IPictureDisp

    Set picPicture = stdole.LoadPicture("e:\gta.bmp")
   

    Call GetObjectAPI(picPicture, Len(bm), bm)
    MsgBox "大小  :  " & bm.bmWidth & "×" & bm.bmHeight

End Sub

Excellent!!!!

我一直是用image对象来获取的,太麻烦了.

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
  ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, _
  ByVal nIndex As Long) As Long

Sub getpicsize(ByVal picpath As String)
Dim Image1 As OLEObject, d As Long
Application.ScreenUpdating = False
d = GetDC(0)
Set Image1 = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1")
Image1.Object.AutoSize = True
Image1.Object.BorderStyle = 0
Image1.Object.Picture = LoadPicture(picpath)
MsgBox Image1.Width * GetDeviceCaps(d, 88) / 72 & "*" & Image1.Height * GetDeviceCaps(d, 90) / 72
ReleaseDC 0, d
Image1.Delete
Application.ScreenUpdating = True
End Sub

Sub Macro1()
getpicsize "e:\001.gif"
End Sub

ldy888

前面刚回了一帖，就在这找到了

两位版主能不能 简单介绍 stdole 对象 是VBA 还是 windows 自带的吗 ？

不需要引用吗？

分辩率多少 就得不到了，精通API 的高手 也许可以得到

'引用Microsoft Shell Controls And Automation
Sub ldygetFSO()
Dim shl As New Shell32.Shell
Dim shfd As Shell32.Folder
Dim Fsn$, s1$, s2$, s3$, s4$, s$, i&
Fsn = Application.GetOpenFilename
If Fsn = "False" Then Exit Sub
s1 = Split(Fsn, "\")(UBound(Split(Fsn, "\")))
s2 = Replace(Fsn, "\" & s1, "")
Set shfd = shl.Namespace(s2)
s3 = "go"
Do While s3 <> ""
s3 = shfd.GetDetailsOf(0, i)
s4 = shfd.GetDetailsOf(shfd.Items.Item(s1), i)
If s3 <> "" And s4 <> "" Then s = s & s3 & ": " & s4 & Chr(10)
i = i + 1
Loop
Debug.Print s
End Sub

打印结果：

名称: 002.jpg
大小: 293 KB
类型: JPEG 图像
修改日期: 2007-8-8 3:58
创建日期: 2007-8-8 3:58
访问日期: 2007-9-3 14:57
属性: A
状态: 在线
所有者: LDY\DY
页数: 1
尺寸: 1600 x 1200

[此贴子已经被作者于2007-9-3 15:50:44编辑过]

FENGJUN

QUOTE:

以下是引用agstick在2007-9-3 14:27:39的发言：

那个太罗唆了，换这个把

Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
   
Private Type BITMAP
    bmType   As Long
    bmWidth   As Long
    bmHeight   As Long
    bmWidthBytes   As Long
    bmPlanes   As Integer
    bmBitsPixel   As Integer
    bmBits   As Long
End Type

Public Sub psize()

    Dim bm As BITMAP
    Dim picPicture As IPictureDisp

    Set picPicture = stdole.LoadPicture("e:\gta.bmp")
   

    Call GetObjectAPI(picPicture, Len(bm), bm)
    MsgBox "大小  :  " & bm.bmWidth & "×" & bm.bmHeight

End Sub

Cool!