国产一级a片免费看高清,亚洲熟女中文字幕在线视频,黄三级高清在线播放,免费黄色视频在线看

作者: 學(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)則分別代表該點的綠色和紅色的亮度，arrBits(3,x,y)為保留字節(jié)

---

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

樓上，知道你是fans的版主?。?br>寫個完整的學(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行，會出錯！！

[ 本帖最后由 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.excelhome.net/forum.php?mod=attachment&aid=NDY2MDg1fDllMjUzMTQyfDE0MzA3OTgxOTZ8MHww

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

---

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



小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的控件里沒有這種相片框??！

[ 本帖最后由 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)點）的值一個點一個點的讀入！！

---

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

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

附件: 繪圖.rar (2009-2-25 20:32, 7.12 KB) / 下載次數(shù) 198
http://club.excelhome.net/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é)是什么意思??

---

作者: 上揚    時間: 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


我把圖片文件的數(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.excelhome.net/forum.php?mod=attachment&aid=MTIzMDU5MnwwMDg0M2RhZXwxNDMwNzk4MTk2fDB8MA%3D%3D

---

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

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

---

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


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

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




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

---

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


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

---

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

謝謝額。厲害啊

---

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


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

---

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


將樓上的代碼稍作改動，以方便自已調(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 編輯


附件：

圖片與數(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.excelhome.net/forum.php?mod=attachment&aid=MTY5ODc2NXwyYWQ1YzE2ZnwxNDMwNzk4MTk2fDB8MA%3D%3D

---

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


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