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

看见就非常 2015-05-05

展开全文

作者: 学着用 时间: 2009-2-24 23:09 标题: 如何将Image控件中的图片数据转为二进制数组?(已解决!封装PropertyBag对象)

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

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

作者: HHAAMM 时间: 2009-2-25 01:40

弄了一个多小时才弄出这么个东东，不知行不
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 时间: 2009-2-25 01:43

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

作者: HHAAMM 时间: 2009-2-25 01:55

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 时间: 2009-2-25 02:01

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 时间: 2009-2-25 02:26

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

作者: HHAAMM 时间: 2009-2-25 03:41

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 时间: 2009-2-25 03:46

哦，原来是不用循环的
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 时间: 2009-2-25 03:48

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 时间: 2009-2-25 04:06

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 编辑 ]

作者: fdd 时间: 2009-2-25 07:25

坐下来好好学习。

作者: 小fisher 时间: 2009-2-25 13:38

示例代码见附件

附件: 简单图片处理.rar (2009-2-25 13:38, 30.46 KB) / 下载次数 555
http://club./forum.php?mod=attachment&aid=NDY2MDg1fDllMjUzMTQyfDE0MzA3OTgxOTZ8MHww

附件: 未标题-1.jpg (2009-2-25 13:38, 58.05 KB) / 下载次数 22
http://club./forum.php?mod=attachment&aid=NDY2MDg2fDA4OTVhNmYwfDE0MzA3OTgxOTZ8MHww

作者: fdd 时间: 2009-2-25 17:44

原帖由 小fisher 于 2009-2-25 13:38 发表
示例代码见附件

小fisher好像对API函数特别了解啊！佩服佩服！

作者: 学着用 时间: 2009-2-25 19:38

谢谢HHAAMM和小fisher!!!!
HHAAMM的不是我想要的,还是谢谢你的帮忙..
小fisher的过于复杂我看不懂.

作者: HHAAMM 时间: 2009-2-25 19:51

偶在VB书里看到有pset方法，可以将一个相片框的图像读到另一个相片框中的示例，很简单，应该也可以装入二进制数组里！！
可excel的控件里没有这种相片框！！

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

作者: 学着用 时间: 2009-2-25 20:13

将一个相片框的图像读到另一个相片框中
Image1.Picture=Image2.Picture就可以了.

作者: HHAAMM 时间: 2009-2-25 20:20

不一样的
这种读入是根据x,y（坐标点）的值一个点一个点的读入！！

作者: HHAAMM 时间: 2009-2-25 20:32

以前写的请看这个
（是偶自己写的已经编译成exe文件，双击请放心[em07] ）

附件: 绘图.rar (2009-2-25 20:32, 7.12 KB) / 下载次数 198
http://club./forum.php?mod=attachment&aid=NDY2Mjg2fGE3MDU3N2FlfDE0MzA3OTgxOTZ8MHww

作者: coby001 时间: 2009-2-25 21:21

[em07] 牛人多多

作者: 学着用 时间: 2009-2-27 22:43

不知有谁知道同一张图片PropertyBag读出来的数组比OPEN读出来的数组多50个字节是什么意思??

作者: 学着用 时间: 2009-2-27 22:54 标题: 同一张图片PropertyBag读出来的数组比OPEN读出来的数组多50个字节是什么意思??

不知有谁知道同一张图片PropertyBag读出来的数组比OPEN读出来的数组多50个字节是什么意思??

作者: 上扬 时间: 2009-3-1 09:43

真是高手如云

作者: maxlt 时间: 2010-12-15 16:40

留个记号。

作者: goldowl2011 时间: 2012-8-6 22:07

Mark it.Thanks a lot.

作者: cumulonimbus 时间: 2012-8-25 22:04

HHAAMM 发表于 2009-2-25 04:06
Sub 图片文件的数据保存到EXCEL的A列中()
Dim arr() As Byte, H&, x&
Open "d:\1.jpg" For Binary As #1
...

我把图片文件的数据保存到EXCEL的A列中（数据共有1254个），然后从EXCEL的A列提取数据生成图片。奇怪的是，我如果不想生成整个图片，从A列提取数据少于1254个，生成的图片却显示绘图失败。请教版主这是怎么回事？有何解决之道？
我只想提取部分的图片。
Sub 图片文件的数据保存到EXCEL的A列中()
Dim arr() As Byte, H&, x&
Open ThisWorkbook.Path & "\DV_getcode.bmp" 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 = 174
ReDim arr(1 To a)
For x = 1 To a
arr(x) = Range("a" & x)
Next
Open ThisWorkbook.Path & "\复件.bmp" For Binary As #1
Put #1, , arr
Close #1
MsgBox "文件已在D盘！！"
End Sub

附件: 为什么会绘图失败.rar (2012-8-25 22:03, 15.66 KB) / 下载次数 30
http://club./forum.php?mod=attachment&aid=MTIzMDU5MnwwMDg0M2RhZXwxNDMwNzk4MTk2fDB8MA%3D%3D

作者: fzkoko 时间: 2012-8-25 22:29

有创意，都是高手。

作者: okok7845 时间: 2013-1-20 22:55

HHAAMM 发表于 2009-2-25 03:48
Sub test()
Dim arr() As Byte, H&
Open "d:\1.jpg" For Binary As #1

代码很简单，又精彩。
请问有没有办法，将附件，这些字节编入一个字典里，方便调用。

截图00.zip (2.74 KB, 下载次数: 40)

附件: 截图00.zip (2013-1-20 22:55, 2.74 KB) / 下载次数 40
http://club./forum.php?mod=attachment&aid=MTMzNDc2NXwwNjIzMzlhYXwxNDMwNzk4MTk2fDB8MA%3D%3D

作者: 莫悠悠 时间: 2013-9-12 14:54

小fisher 发表于 2009-2-25 13:38
示例代码见附件

提示找不到驱动哦，找不到工程

作者: gengasterisk 时间: 2014-3-5 22:42

谢谢额。厉害啊

作者: VBA万岁 时间: 2014-7-23 08:49

小fisher 发表于 2009-2-25 13:38
示例代码见附件

正学习这个，多谢分享！

作者: VBA万岁 时间: 2014-12-17 16:18

HHAAMM 发表于 2009-2-25 04:06
Sub 图片文件的数据保存到EXCEL的A列中()
Dim arr() As Byte, H&, x&
Open "d:\1.jpg" For Binary As #1
...

将楼上的代码稍作改动，以方便自已调用：
Sub 将图片转换为数组()
Dim fn, f
Dim arr() As Byte, H, i
fn = Application.GetOpenFilename("图像文件,*.jpg", , "请选文件", , MultiSelect:=True)
If Not IsArray(fn) Then Exit Sub
For Each f In fn
Open f For Binary As #1
H = LOF(1)
ReDim arr(1 To H)
Get #1, , arr
Close #1
For i = 1 To UBound(arr)
Cells(i, 1) = arr(i)
Next i
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 ThisWorkbook.Path & "\1.jpg" For Binary As #1
Put #1, , arr
Close #1

Dim myObj As Shape
For Each myObj In ActiveSheet.Shapes
If myObj.Name Like "Rectangle*" Then myObj.Select
Next
Selection.ShapeRange.Fill.UserPicture ThisWorkbook.Path & "\1.jpg"

Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Fso.DeleteFile (ActiveWorkbook.Path & "\1.jpg")
End Sub

作者: VBA万岁 时间: 2014-12-17 16:19

本帖最后由 VBA万岁于 2014-12-19 15:13 编辑

VBA万岁发表于 2014-12-17 16:18
将楼上的代码稍作改动，以方便自已调用：
Sub 将图片转换为数组()
Dim fn, f

附件：

图片与数组相互转换.zip (528.57 KB, 下载次数: 11)

附件: 图片与数组相互转换.zip (2014-12-19 15:13, 528.57 KB) / 下载次数 11
http://club./forum.php?mod=attachment&aid=MTY5ODc2NXwyYWQ1YzE2ZnwxNDMwNzk4MTk2fDB8MA%3D%3D

作者: renahu 时间: 2014-12-28 14:38