2008-10-30 5 views
2

Как открыть файл изображений в формате PNG с помощью VB6? В идеале я (то есть мой клиент) хотел бы, чтобы файл PNG был открыт и помещен в отдельные массивы R (ed), G (reen) и B (lue).Как можно открыть файл PNG (изображения) с помощью VB6 в массив RGB или массивы R, G, B

VB6 не является моим инструментом выбора (из-за недостатка знаний), и я взволнован, если кто-то может указать мне в правильном направлении для решения VB6.

ответ

0

Благодарим за ссылку, хотя она не является свободным парнем VB (более C & ASM-ароматизаторы), код выглядит очень BMP-ориентированным; не PNG.

Если это так, я должен полагать, что вы предложили ссылку, потому что было бы просто сделать код PNG'able, но я не знал бы, как подойти к этому.

0
'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

Yikes! 4 года спустя! У меня больше нет исходного кода, чтобы проверить это, хотелось бы, чтобы у меня были отбивные VB, чтобы осветить все усилия, которые вы здесь поставили. – Jamie 2012-11-14 16:54:39