首页
学习
活动
专区
圈层
工具
发布
社区首页 >问答首页 >如何使用VB6将PNG (图像)文件打开为RGB数组或R、G、B数组

如何使用VB6将PNG (图像)文件打开为RGB数组或R、G、B数组
EN

Stack Overflow用户
提问于 2008-10-30 17:14:02
回答 3查看 7.9K关注 0票数 2

如何使用VB6打开PNG格式的图像文件?理想情况下,我(也就是我的客户)希望打开PNG文件并将其放入独立的R(ed)、G(reen)和B(lue)数组中。

VB6不是我的首选工具(因为缺乏知识),如果有人能为我指出VB6解决方案的正确方向,我会很兴奋。

EN

回答 3

Stack Overflow用户

回答已采纳

发布于 2008-10-30 18:59:07

感谢你的链接,虽然不是一个流利的VB家伙(更多的是C& ASM风格),但代码似乎非常以BMP为中心;而不是PNG。

如果是这样的话,我不得不相信你推荐了链接,因为让代码可PNG‘’able是一件很简单的事情,但我不知道该怎么做。

票数 0
EN

Stack Overflow用户

发布于 2008-11-03 18:50:10

您可以尝试使用开源的FreeImage project

票数 0
EN

Stack Overflow用户

发布于 2012-11-14 22:31:47

代码语言:javascript
复制
'1 form with :
'    1 picturebox : name=Picture1
'    1 commandbutton : name=Command1
Option Explicit

Private Type BITMAP
  bmType As Long
  bmWidth As Long
  bmHeight As Long
  bmWidthBytes As Long
  bmPlanes As Integer
  bmBitsPixel As Integer
  bmBits As Long
End Type

Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, ByRef lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, ByRef lpBits As Any) As Long

Private mbmpBits() As Byte
Private mudtBmp As BITMAP

Private Sub Command1_Click()
  ShowRed
'  ShowGreen
'  ShowBlue
End Sub

Private Sub Form_Load()
  Picture1.Picture = LoadPicture("c:\temp\pic.bmp")
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Set Form1 = Nothing
End Sub

Private Sub ShowRed()
  Dim lngX As Long, lngY As Long
  ReadBits
  For lngX = 0 To mudtBmp.bmWidth - 1
    For lngY = 0 To mudtBmp.bmHeight - 1
      mbmpBits(0, lngX, lngY) = 0
      mbmpBits(1, lngX, lngY) = 0
    Next lngY
  Next lngX
  ShowBits
End Sub

Private Sub ShowGreen()
  Dim lngX As Long, lngY As Long
  ReadBits
  For lngX = 0 To mudtBmp.bmWidth - 1
    For lngY = 0 To mudtBmp.bmHeight - 1
      mbmpBits(0, lngX, lngY) = 0
      mbmpBits(2, lngX, lngY) = 0
    Next lngY
  Next lngX
  ShowBits
End Sub

Private Sub ShowBlue()
  Dim lngX As Long, lngY As Long
  ReadBits
  For lngX = 0 To mudtBmp.bmWidth - 1
    For lngY = 0 To mudtBmp.bmHeight - 1
      mbmpBits(1, lngX, lngY) = 0
      mbmpBits(2, lngX, lngY) = 0
    Next lngY
  Next lngX
  ShowBits
End Sub

Private Sub ReadBits()
  GetObject Picture1.Picture.Handle, Len(mudtBmp), mudtBmp
  With mudtBmp
    ReDim mbmpBits(0 To (.bmBitsPixel \ 8) - 1, 0 To .bmWidth - 1, 0 To .bmHeight - 1) As Byte
    GetBitmapBits Picture1.Picture.Handle, .bmWidthBytes * .bmHeight, mbmpBits(0, 0, 0)
  End With 'mudtBmp
End Sub

Private Sub ShowBits()
  SetBitmapBits Picture1.Picture.Handle, mudtBmp.bmWidthBytes * mudtBmp.bmHeight, mbmpBits(0, 0, 0)
  Erase mbmpBits
  Picture1.Refresh
End Sub
票数 0
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/250980

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档