vb二进制转换为图片,图片转换为二进制
15 个解决方案
#1
1.bmp本来就是二进制数据啊。。。你的意思是转化为字符串形式表示的二进制数据，比如 "00 37 2B 4D"这样的么？
#2
对,就是转化为字符串形式表示的二进制数据
#3
呵呵，以前写过一个，但是效率不怎么高。对付1MB以下的文件还成。
#4
Option Explicit
Private Sub Command1_Click()
Dim b() As Byte
'读文件
Open "z:\11.bmp" For Binary As #1
ReDim b(LOF(1) - 1)
Get #1, , b
Close #1
'专成txt
Dim i As Long
Dim strTmp As String
For i = LBound(b) To UBound(b)
DoEvents
strTmp = strTmp & Format(Hex(b(i)), "00") & " "
Next
'再转成二进制数据保存
ReDim b(Len(strTmp) / 3 - 1)
For i = 0 To Len(strTmp) / 3 - 1
DoEvents
b(i) = Val("&H" & Mid(strTmp, i * 3 + 1, 2))
Next
Open "z:\22.bmp" For Binary As #2
Put #2, , b
Close #2
End Sub
#5
#4楼的朋友,z:\22.bmp这张图片加载不上,麻烦您,再多写两句把z:\22.bmp这张图片加载到窗体的Picture控件上
#6
用Z:\是因为我有一个ramdisk定义成Z盘，你如果没有这个盘符当然不行啦
#7
#6楼朋友,没有z这个盘符,把z改成d不是一样吗?
#8
#6楼朋友,您的这段代码的意思,就是把22.bmp这张图片,保存到了z盘,是不是啊?
#9
#6楼朋友,您能解释一下"ramdisk定义成Z盘"这句是什么意思吗?谢谢了!!
#10
Private Function FileToHexStr(ByVal strFileName As String, Optional blockStartPos As Long = 1, Optional blockLen As Long = 131072, Optional bDebug As Boolean = False) As String
Dim strReturn As String
Dim i As Long
Dim lpBuffer() As Byte
strReturn = ""
On Error GoTo ErrProc:
Open strFileName For Binary As #1
If LOF(1) = 0 Then
Close #1
Exit Function
End If
If blockStartPos <= 0 Or blockStartPos > LOF(1) Or blockLen <= 0 Then
Close #1
Exit Function
End If
If LOF(1) < blockLen + blockStartPos - 1 Then
blockLen = LOF(1) - blockStartPos + 1
End If
ReDim lpBuffer(blockLen - 1) As Byte
Get 1, blockStartPos, lpBuffer
Close #1
If bDebug Then
strReturn = "$$$Debug info - " & "File: " & strFileName
For i = 0 To UBound(lpBuffer)
If i Mod 16 = 0 Then
strReturn = strReturn & vbCr + vbLf & FixString(Hex(i), 8, "0") & "H "
End If
strReturn = strReturn & " " & IIf(CLng(lpBuffer(i)) > 15, Hex(lpBuffer(i)), "0" & Hex(lpBuffer(i)))
Next
Else
Dim sb As New clsCFXStrBuilder
For i = 0 To UBound(lpBuffer)
sb.Append IIf(CLng(lpBuffer(i)) > 15, Hex(lpBuffer(i)), "0" & Hex(lpBuffer(i)))
Next
FileToHexStr = sb.FullString
Exit Function
End If
FileToHexStr = strReturn
Exit Function
ErrProc:
FileToHexStr = ""
Debug.Print Err.Description
End Function
Private Function FixString(ByVal strSrc As String, ByVal nLen As String, ByVal strFill As String) As String
FixString = String(nLen - Len(strSrc), strFill) & strSrc
End Function
Private Sub HexStrToFile(ByVal strFileName As String, ByVal strContent As String, Optional ByVal BlockPos As Long = 1)
Dim lpBuffer() As Byte
Dim i As Long
On Error GoTo ErrProc:
If BlockPos < 1 Then
Exit Sub
End If
If Len(strContent) Mod 2 <> 0 Then
Exit Sub
End If
If BlockPos = 1 Then
Open strFileName For Output As #1
Close #1
End If
If strContent = "" Then
Exit Sub
End If
ReDim lpBuffer(Len(strContent) / 2 - 1)
For i = 0 To UBound(lpBuffer)
lpBuffer(i) = Val("&H" & Mid(strContent, i * 2 + 1, 2))
Next
Open strFileName For Binary As #1
Put 1, BlockPos, lpBuffer
Close #1
Exit Sub
ErrProc:
Debug.Print Err.Description
End Sub
#11
为了解决字符串相加效率低的问题，模仿.NET 的StringBuilder写了个 clsCFXStringBuilder
呵呵。
我的函数支持分块读写。
Option Explicit
Private m_content As String
Private m_buffer As String
Private m_sbuffer As String
Private m_bufferlen As Long
Private m_sbufferlen As Long
Public Sub Append(ByVal str As String)
m_sbuffer = m_sbuffer & str
m_sbufferlen = m_sbufferlen + 1
If m_sbufferlen > 128 Then
m_buffer = m_buffer & m_sbuffer
m_bufferlen = m_bufferlen + 1
m_sbuffer = ""
m_sbufferlen = 0
End If
If m_bufferlen > 128 Then
m_content = m_content & m_buffer
m_buffer = ""
m_bufferlen = 0
End If
End Sub
Public Property Get FullString() As String
FullString = m_content & m_buffer & m_sbuffer
End Property
呵呵。
我的函数支持分块读写。
#12
哎，就是说我的机器上有一个z:盘专门用来做测试用的，所以我的代码里面读写文件全部在z:盘上，如果你的系统中没有这个逻辑驱动器，那么我的代码直接运行肯定出错啊。
你只要把我代码中的z:改成C:就没有问题了嘛。
#13
非常感谢两位大哥,可是我试了一遍,又试了一遍,还是不行啊!!!
#14
caozhy大哥,您能具体说明吗?我不会用啊?
#15
给邮箱，发给你。
注意！
本站转载的文章为个人学习借鉴使用，本站对版权不负任何法律责任。如果侵犯了您的隐私权益，请联系我们删除。