如何將Image控件中的圖片數(shù)據(jù)轉(zhuǎn)為二進(jìn)制數(shù)組?(已解決!封裝PropertyBag對象)

看見就非常 2015-05-05

展開全文

作者: 學(xué)著用 時間: 2009-2-24 23:09 標(biāo)題: 如何將Image控件中的圖片數(shù)據(jù)轉(zhuǎn)為二進(jìn)制數(shù)組?(已解決!封裝PropertyBag對象)

在Image控件載入圖片后如何將控件中的圖片(Image.Picture的數(shù)據(jù))轉(zhuǎn)為二進(jìn)制數(shù)組?(已解決!封裝PropertyBag對象)

[ 本帖最后由學(xué)著用于 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里的數(shù)據(jù)還原成圖片呀，高手給講講??！

作者: 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創(chuàng)建一個內(nèi)存DC
3. 用SelectObject(hDC, Image1.Picture.Handle)將image1中的圖片選入內(nèi)存DC中，之前必須用Loadpicture或通過屬性窗口向Image1中載入一幅圖片
4. 再定義一個三維數(shù)組arrBits(0 to 3, lWidth-1, lHeight-1) as byte，這里的lWidth和lHeight是圖形的寬和高，以像素為單位，stdPicture的長度單位是Himetric，需要乘以一個常量96 / 2540將其轉(zhuǎn)換為像素
5.然后用GetDIBits將每個像素的RGB顏色值放到數(shù)組中
這樣就將每個像素的RGB顏色信息放入arrBits數(shù)組中了，arrBits(0,x,y)表示從圖片左下角算起橫向第x,縱向第y個像素的藍(lán)色亮度值，arrBits(1,x,y)和arrBits(2,x,y)則分別代表該點(diǎn)的綠色和紅色的亮度，arrBits(3,x,y)為保留字節(jié)

作者: HHAAMM 時間: 2009-2-25 02:26

樓上，知道你是fans的版主??！
寫個完整的學(xué)習(xí)下?。?hr noshade="" size="2" width="100%" color="#808080"> 作者: 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

哦，原來是不用循環(huán)的
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 圖片文件的數(shù)據(jù)保存到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列提取數(shù)據(jù)生成圖片()
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行，會出錯?。?br>
[ 本帖最后由 HHAAMM 于 2009-2-25 04:20 編輯 ]

作者: fdd 時間: 2009-2-25 07:25

坐下來好好學(xué)習(xí)。

作者: 小fisher 時間: 2009-2-25 13:38

示例代碼見附件

附件: 簡單圖片處理.rar (2009-2-25 13:38, 30.46 KB) / 下載次數(shù) 555
http://club./forum.php?mod=attachment&aid=NDY2MDg1fDllMjUzMTQyfDE0MzA3OTgxOTZ8MHww

附件: 未標(biāo)題-1.jpg (2009-2-25 13:38, 58.05 KB) / 下載次數(shù) 22
http://club./forum.php?mod=attachment&aid=NDY2MDg2fDA4OTVhNmYwfDE0MzA3OTgxOTZ8MHww

作者: fdd 時間: 2009-2-25 17:44

原帖由 小fisher 于 2009-2-25 13:38 發(fā)表
示例代碼見附件

小fisher好像對API函數(shù)特別了解啊！佩服佩服！

作者: 學(xué)著用 時間: 2009-2-25 19:38

謝謝HHAAMM和小fisher!!!!
HHAAMM的不是我想要的,還是謝謝你的幫忙..
小fisher的過于復(fù)雜我看不懂.

作者: HHAAMM 時間: 2009-2-25 19:51

偶在VB書里看到有pset方法，可以將一個相片框的圖像讀到另一個相片框中的示例，很簡單，應(yīng)該也可以裝入二進(jìn)制數(shù)組里??！
可excel的控件里沒有這種相片框?。?br>
[ 本帖最后由 HHAAMM 于 2009-2-25 19:54 編輯 ]

作者: 學(xué)著用 時間: 2009-2-25 20:13

將一個相片框的圖像讀到另一個相片框中
Image1.Picture=Image2.Picture就可以了.

作者: HHAAMM 時間: 2009-2-25 20:20

不一樣的
這種讀入是根據(jù)x,y（坐標(biāo)點(diǎn)）的值一個點(diǎn)一個點(diǎn)的讀入??！

作者: HHAAMM 時間: 2009-2-25 20:32

以前寫的請看這個
（是偶自己寫的已經(jīng)編譯成exe文件，雙擊請放心[em07] ）

附件: 繪圖.rar (2009-2-25 20:32, 7.12 KB) / 下載次數(shù) 198
http://club./forum.php?mod=attachment&aid=NDY2Mjg2fGE3MDU3N2FlfDE0MzA3OTgxOTZ8MHww

作者: coby001 時間: 2009-2-25 21:21

[em07] 牛人多多

作者: 學(xué)著用 時間: 2009-2-27 22:43

不知有誰知道同一張圖片PropertyBag讀出來的數(shù)組比OPEN讀出來的數(shù)組多50個字節(jié)是什么意思??

作者: 學(xué)著用 時間: 2009-2-27 22:54 標(biāo)題: 同一張圖片PropertyBag讀出來的數(shù)組比OPEN讀出來的數(shù)組多50個字節(jié)是什么意思??

不知有誰知道同一張圖片PropertyBag讀出來的數(shù)組比OPEN讀出來的數(shù)組多50個字節(jié)是什么意思??

作者: 上揚(yáng) 時間: 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 發(fā)表于 2009-2-25 04:06
Sub 圖片文件的數(shù)據(jù)保存到EXCEL的A列中()
Dim arr() As Byte, H&, x&
Open "d:\1.jpg" For Binary As #1
...

我把圖片文件的數(shù)據(jù)保存到EXCEL的A列中（數(shù)據(jù)共有1254個），然后從EXCEL的A列提取數(shù)據(jù)生成圖片。奇怪的是，我如果不想生成整個圖片，從A列提取數(shù)據(jù)少于1254個，生成的圖片卻顯示繪圖失敗。請教版主這是怎么回事？有何解決之道？
我只想提取部分的圖片。
Sub 圖片文件的數(shù)據(jù)保存到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列提取數(shù)據(jù)生成圖片()
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 & "\復(fù)件.bmp" For Binary As #1
Put #1, , arr
Close #1
MsgBox "文件已在D盤??！"
End Sub

附件: 為什么會繪圖失敗.rar (2012-8-25 22:03, 15.66 KB) / 下載次數(shù) 30
http://club./forum.php?mod=attachment&aid=MTIzMDU5MnwwMDg0M2RhZXwxNDMwNzk4MTk2fDB8MA%3D%3D

作者: fzkoko 時間: 2012-8-25 22:29

有創(chuàng)意，都是高手。

作者: okok7845 時間: 2013-1-20 22:55

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

代碼很簡單，又精彩。
請問有沒有辦法，將附件，這些字節(jié)編入一個字典里，方便調(diào)用。

截圖00.zip (2.74 KB, 下載次數(shù): 40)

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

作者: 莫悠悠 時間: 2013-9-12 14:54

小fisher 發(fā)表于 2009-2-25 13:38
示例代碼見附件

提示找不到驅(qū)動哦，找不到工程

作者: gengasterisk 時間: 2014-3-5 22:42

謝謝額。厲害啊

作者: VBA萬歲 時間: 2014-7-23 08:49

小fisher 發(fā)表于 2009-2-25 13:38
示例代碼見附件

正學(xué)習(xí)這個，多謝分享！

作者: VBA萬歲 時間: 2014-12-17 16:18

HHAAMM 發(fā)表于 2009-2-25 04:06
Sub 圖片文件的數(shù)據(jù)保存到EXCEL的A列中()
Dim arr() As Byte, H&, x&
Open "d:\1.jpg" For Binary As #1
...

將樓上的代碼稍作改動，以方便自已調(diào)用：
Sub 將圖片轉(zhuǎn)換為數(shù)組()
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列提取數(shù)據(jù)生成圖片()
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萬歲發(fā)表于 2014-12-17 16:18
將樓上的代碼稍作改動，以方便自已調(diào)用：
Sub 將圖片轉(zhuǎn)換為數(shù)組()
Dim fn, f

附件：

圖片與數(shù)組相互轉(zhuǎn)換.zip (528.57 KB, 下載次數(shù): 11)

附件: 圖片與數(shù)組相互轉(zhuǎn)換.zip (2014-12-19 15:13, 528.57 KB) / 下載次數(shù) 11
http://club./forum.php?mod=attachment&aid=MTY5ODc2NXwyYWQ1YzE2ZnwxNDMwNzk4MTk2fDB8MA%3D%3D

作者: renahu 時間: 2014-12-28 14:38

HHAAMM 發(fā)表于 2009-2-25 03:41
ok

Sub test()

For x = 1 To H 循環(huán)就提示 “溢出” ，下面的不循環(huán)就OK了

本站是提供個人知識管理的網(wǎng)絡(luò)存儲空間，所有內(nèi)容均由用戶發(fā)布，不代表本站觀點(diǎn)。請注意甄別內(nèi)容中的聯(lián)系方式、誘導(dǎo)購買等信息，謹(jǐn)防詐騙。如發(fā)現(xiàn)有害或侵權(quán)內(nèi)容，請點(diǎn)擊一鍵舉報(bào)。

轉(zhuǎn)藏 分享

QQ空間 QQ好友新浪微博微信

獻(xiàn)花（0） +1

來自：看見就非常 > 《tip》

舉報(bào)/認(rèn)領(lǐng)