如何将Image控件中的图片数据转为二进制数组?(已解决!封装PropertyBag对象)

学着用

在Image控件载入图片后如何将控件中的图片(Image.Picture的数据)转为二进制数组?(已解决!封装PropertyBag对象)

[ 本帖最后由 学着用 于 2009-2-26 22:09 编辑 ]

HHAAMM

弄了一个多小时才弄出这么个东东，不知行不
Sub test()
Dim arr() As Byte
Open "d:\1.bmp" For Binary As #1
H = LOF(1)
ReDim arr(1 To H)
For i = 1 To H
Get #1, i, arr(i)
Next
Close #1
End Sub

HHAAMM

怎样再将arr里的数据还原成图片呀，高手给讲讲！！

HHAAMM

Sub test()
Dim arr() As Byte, H&
Open "d:\1.bmp" For Binary As #1
H = LOF(1)
ReDim arr(1 To H)
For i = 1 To H
Get #1, i, arr(i)
Next
Close #1
dc arr, H
End Sub

Sub dc(arr() As Byte, H&)
Dim st$, x%
Open "d:\2.bmp" For Output As #1
For x = 1 To H
Print #1, arr(x)
Next x
Close #1
MsgBox "文件已在D盘，但不是图像！！"
End Sub

小fisher

1.用GetDC获取一个窗口或桌面的DC句柄
2.用CreateCompatibleDC创建一个内存DC
3. 用SelectObject(hDC, Image1.Picture.Handle)将image1中的图片选入内存DC中，之前必须用Loadpicture或通过属性窗口向Image1中载入一幅图片
4. 再定义一个三维数组arrBits(0 to 3, lWidth-1, lHeight-1) as byte，这里的lWidth和lHeight是图形的宽和高，以像素为单位，stdPicture的长度单位是Himetric，需要乘以一个常量96 / 2540将其转换为像素
5.然后用GetDIBits将每个像素的RGB颜色值放到数组中
这样就将每个像素的RGB颜色信息放入arrBits数组中了，arrBits(0,x,y)表示从图片左下角算起横向第x,纵向第y个像素的蓝色亮度值，arrBits(1,x,y)和arrBits(2,x,y)则分别代表该点的绿色和红色的亮度，arrBits(3,x,y)为保留字节

HHAAMM

楼上，知道你是fans的版主！！
写个完整的学习下！！

HHAAMM

ok

Sub test()
Dim arr() As Byte, H&
Open "d:\1.bmp" For Binary As #1
H = LOF(1)
ReDim arr(1 To H)
Get #1, , arr
Close #1
dc arr, H
End Sub

Sub dc(arr() As Byte, H&)
Dim st$, x%, y%
Open "d:\2.bmp" For Binary As #2
For x = 1 To H
Put #2, , arr(x)
Next x
Close #2
MsgBox "文件已在D盘！！"
End Sub

HHAAMM

哦，原来是不用循环的
Sub test()
Dim arr() As Byte, H&
Open "d:\1.bmp" For Binary As #1
H = LOF(1)
ReDim arr(1 To H)
Get #1, , arr
Close #1
dc arr
End Sub

Sub dc(arr() As Byte)
Dim st$, x%, y%
Open "d:\2.bmp" For Binary As #2
Put #2, , arr
Close #2
MsgBox "文件已在D盘！！"
End Sub

HHAAMM

Sub test()
Dim arr() As Byte, H&
Open "d:\1.jpg" For Binary As #1
H = LOF(1)
ReDim arr(1 To H)
Get #1, , arr
Close #1
dc arr
End Sub

Sub dc(arr() As Byte)
Dim st$, x%, y%
Open "d:\2.jpg" For Binary As #2
Put #2, , arr
Close #2
MsgBox "文件已在D盘！！"
End Sub

HHAAMM

Sub 图片文件的数据保存到EXCEL的A列中()
Dim arr() As Byte, H&, x&
Open "d:\1.jpg" For Binary As #1
H = LOF(1)
ReDim arr(1 To H)
Get #1, , arr
Close #1
For x = 1 To H
    Range("a" & x) = arr(x)
Next
End Sub


Sub 从EXCEL的A列提取数据生成图片()
Dim arr() As Byte, a&, x&
a = Range("a65536").End(xlUp).Row
ReDim arr(1 To a)
For x = 1 To a
    arr(x) = Range("a" & x)
Next
Open "d:\9.jpg" For Binary As #1
Put #1, , arr
Close #1
MsgBox "文件已在D盘！！"
End Sub

图片太大的话，因EXCEL只有65536行，会出错！！

[ 本帖最后由 HHAAMM 于 2009-2-25 04:20 编辑 ]