• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 294
  • Last Modified:

Testing the pixels of a BMP in memory

My app reads a BMP file from the Hard drive and has to test the color of each pixel. I used to read byte after byte from the bmp file but the result is very very slow. I think I should load the bmp into the memory and test the pixels in it but how to load the file quickly enough and how to access to the properties of each pixel ? Thanks for your help.
0
Pleinpopossum
Asked:
Pleinpopossum
  • 3
1 Solution
 
VbmasterCommented:
You can read a chunk of bytes at the same time using code like this

ReDim ByteArray(10)

Open filename For Binary As #1
Get #1, , ByteArray()
Close #1

This will read 11 bytes (if you have 0-based arrays (default)).
0
 
watyCommented:
This is for setting, but you can access each pixel

' #VBIDEUtils#************************************************************
' * Programmer Name  : Waty Thierry
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : waty.thierry@usa.net
' * Date             : 28/06/99
' * Time             : 12:26
' **********************************************************************
' * Comments         : Changing a VB Picture Object Pixel by Pixel
' *
' *
' **********************************************************************

Public Type SAFEARRAYBOUND
   cElements  As Long
   lLbound    As Long
End Type

Public Type SAFEARRAY1D
   cDims          As Integer
   fFeatures      As Integer
   cbElements     As Long
   cLocks         As Long
   pvData         As Long
   Bounds(0 To 0) As SAFEARRAYBOUND
End Type

Public Type SAFEARRAY2D
   cDims          As Integer
   fFeatures      As Integer
   cbElements     As Long
   cLocks         As Long
   pvData         As Long
   Bounds(0 To 1) As SAFEARRAYBOUND
End Type

Public Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Ptr() As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Public 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

Public Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Then you can transform your stdPicture variable in a array variable like this:

Private Sub MySub()

   ' these are used to address the pixel using matrices
   Dim pict() As Byte
   Dim MyPictureVar as stdPicture

   Dim sa As SAFEARRAY2D, bmp As BITMAP

   MyPictureVar=LoadPicture(app.path & "\MyImage.BMP")
   ' get bitmap info
   GetObjectAPI Pictbox.Picture, Len(bmp), bmp 'dest
   ' exit if not a supported bitmap
   If bmp.bmPlanes <> 1 Or bmp.bmBitsPixel <> 8 Then
      MsgBox " 256-color bitmaps only", vbCritical
      Exit Sub
   End If

   ' have the local matrix point to bitmap pixels
   With sa
      .cbElements = 1
      .cDims = 2
      .Bounds(0).lLbound = 0
      .Bounds(0).cElements = bmp.bmHeight
      .Bounds(1).lLbound = 0
      .Bounds(1).cElements = bmp.bmWidthBytes
      .pvData = bmp.bmBits
   End With
   CopyMemory ByVal VarPtrArray(pict), VarPtr(sa), 4

   For c = 0 To UBound(pict, 1)
      'make this column black
      For r = 0 To UBound(pict, 2)
         pict(c, r) = 0 'Black Color
      Next
   Next

   ' clear the temporary array descriptor
   ' without destroying the local temporary array
   CopyMemory ByVal VarPtrArray(pict), 0&, 4

End Sub


0
 
watyCommented:
Also this one
' #VBIDEUtils#************************************************************
' * Programmer Name  : Waty Thierry
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : waty.thierry@usa.net
' * Date             : 26/04/99
' * Time             : 11:07
' **********************************************************************
' * Comments         : Change color of a pixel in a picturebox
' *
' *
' **********************************************************************

Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Longg

' Place this code in Picture1_MouseDown(Button As...)

' This will replace the pixel at x:10, y:10 with a red pixel.
Dim s As Long
s = setpixel(Picture1.hDC, 10, 10, rgb(255,0,0))
Picture1.Refresh

0
 
watyCommented:
0
 
PleinpopossumAuthor Commented:
Thanks a lot ! I'll do my best to apply these new knowleges.

  Hope to be able to help you anyday...
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now