Pixel Color 1

[Serban]

Hi

I load a picture (bmp) into a picture control.
The picture control have AutoSize on true and the picture is bigger then the screen.
I need to check the color of every pixel.
With picture.point (x,y) I have access only to the region on the screen (otherwise return -1)
How can I check the color of all pixels?

Thanks

Mircea Serban

 

[hardkor1001110]

Is this a 24-bit bmp or palletted? If it's 24bit it's pretty easy, you could do it as easy as this:


Dim bmp(WhatevertheWidth, WhatevertheHeight) as Long
Dim scLine(WhatevertheWidth * 3) as Byte

Open "bitmap.bmp" for Binary as #1

For Y = WhatevertheHeight - 1 to 0 Step -1
Get #1,, scLine
For X = 0 to WhatevertheWidth * 3 Step 3
bmp(X/3, Y) = _
RGB (scLine(X), scLine(X+1), scLine(X+2))
Next
Next

That should work as long as the Width is evenly divisible by 0. Otherwise you need padding bits which I could help you with later if that's a problem.

If it's palletted here's a bmp rotation function which shows you how to get at the bmpBits in the picture. Keep in mind that the image in the bmp array is upside down and the values you read from it are the values for the pallette entry if it's an 8 bit bmp. If its 24 bit you must read 3 bytes and convert them to a Long.

I know you might be thinking there should be an easier way but I have worked a lot with the picturebox control and I have not come across one yet. Well gotta run hope that helps.



' This structure holds Bitmap information
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

' This structure holds SAFEARRAY info
Private Type SafeArray2
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
cElements1 As Long
lLbound1 As Long
cElements2 As Long
lLbound2 As Long
End Type

' API declares
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As _
Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal _
hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

' Rotate a 256-color bitmap by any angle:
' sourcePB is the source PictureBox control (may be hidden)
' destPB is the destination PictureBox control
' XC, YC are the coordinates of the rotation center
' ANGLE is the rotation angle in degrees
'
' IMPORTANT: the source and destination PictureBox control must initially
' contain the *same* bitmap, to ensure that size and color palette
' are correctly initialized.

' Example:
' 'Load the same image in both source (hidden) and destination controls
' Picture1.Picture = LoadPicture("d:\winnt\gone fishing.bmp&quot
' Picture2.Picture = LoadPicture("d:\winnt\gone fishing.bmp&quot
' ' Rotate by 360°
' Dim a As Single
' For a = 0 To 360 Step 5
' RotatePicture Picture1, Picture2, 50, 50, a
' Next


Sub RotatePicture(sourcePB As PictureBox, destPB As PictureBox, xc As Long, _
yc As Long, degrees As Single)
Const PI As Single = 3.141592653
Dim pict1() As Byte
Dim pict2() As Byte
Dim p1 As SafeArray2, p2 As SafeArray2
Dim bmp1 As BITMAP, bmp2 As BITMAP

Dim radians As Single
Dim angle As Single, angle0 As Single
Dim distance As Single
Dim deltaX As Long, deltaY As Long
Dim x As Long, y As Long
Dim x0 As Long, y0 As Long

' get bitmap info
GetObjectAPI sourcePB.Picture, Len(bmp1), bmp1
GetObjectAPI destPB.Picture, Len(bmp2), bmp2

If bmp1.bmPlanes <> 1 Or bmp1.bmBitsPixel <> 8 Or bmp2.bmPlanes <> 1 Or _
bmp2.bmBitsPixel <> 8 Then
MsgBox &quot;This routine supports 256-color bitmaps only&quot;, vbCritical
Exit Sub
End If

' have the local matrices point to bitmap pixels
With p1
.cbElements = 1
.cDims = 2
.lLbound1 = 0
.cElements1 = bmp1.bmHeight
.lLbound2 = 0
.cElements2 = bmp1.bmWidthBytes
.pvData = bmp1.bmBits
End With
CopyMemory ByVal VarPtrArray(pict1), VarPtr(p1), 4

With p2
.cbElements = 1
.cDims = 2
.lLbound1 = 0
.cElements1 = bmp2.bmHeight
.lLbound2 = 0
.cElements2 = bmp2.bmWidthBytes
.pvData = bmp2.bmBits
End With
CopyMemory ByVal VarPtrArray(pict2), VarPtr(p2), 4

' convert the angle into radians
radians = degrees / (180 / PI)

' rotate the picture

For x = 0 To bmp1.bmWidth - 1
For y = 0 To bmp1.bmHeight - 1
deltaX = x - xc
deltaY = y - yc
If deltaX > 0 Then
angle = Atn(deltaY / deltaX)
ElseIf deltaX < 0 Then
angle = PI + Atn(deltaY / deltaX)
Else
If deltaY > 0 Then angle = PI / 2 Else angle = PI * 3 / 2
End If
angle0 = angle - radians
distance = Sqr(deltaX * deltaX + deltaY * deltaY)

x0 = xc + distance * Cos(angle0)
y0 = yc + distance * Sin(angle0)

If x0 >= 0 And x0 <= UBound(pict1, 1) And y0 >= 0 And y0 <= UBound _
(pict1, 2) Then
pict2(x, y) = pict1(x0, y0)
Else
pict2(x, y) = 0
End If

Next
Next

' release arrays
CopyMemory ByVal VarPtrArray(pict1), 0&, 4
CopyMemory ByVal VarPtrArray(pict2), 0&, 4

' show the rotated bitmap
destPB.Refresh
End Sub

' Support routine

Private Function VarPtrArray(arr As Variant) As Long
CopyMemory VarPtrArray, ByVal VarPtr(arr) + 8, 4
End Function

 

[hardkor1001110]

sorry I've got to get going but I have a correction for the code it should be


fl = LOF(1)

fl = fl - WhatevertheWidth * 3


For Y = WhatevertheHeight - 1 to 0 Step -1
Get #1, fp , scLine
fl = fl - WhatevertheWidth * 3
For X = 0 to WhatevertheWidth * 3 Step 3
bmp(X/3, Y) = _
RGB (scLine(X), scLine(X+1), scLine(X+2))
Next
Next

 

[strongm]

Here's what I believe is an easier way (and it doesn't care what type of bitmap the source is).
For the example you need a form with a picturebox (autoredraw set to true), and a command button. Then drop in the following code:
[tt]
Option Explicit

Private Declare Function GetPixel Lib &quot;gdi32&quot; (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function CreateCompatibleDC Lib &quot;gdi32&quot; (ByVal hdc As Long) As Long
Private Declare Function GetObject Lib &quot;gdi32&quot; Alias &quot;GetObjectA&quot; (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetDesktopWindow Lib &quot;user32&quot; () As Long
Private Declare Function GetDC Lib &quot;user32&quot; (ByVal hwnd As Long) As Long
Private Declare Function SelectObject Lib &quot;gdi32&quot; (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib &quot;gdi32&quot; (ByVal hdc As Long) As Long

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 Sub Command1_Click()
vbGetPixels Picture1.Picture.Handle
End Sub

Private Sub vbGetPixels(hBitmap As Long)
Dim MemDC As Long
Dim OldBMP As Long
Dim result As Long
Dim testBMP As BITMAP

Dim xLoop As Long
Dim yLoop As Long

' Check we've really been passed bitmap handle
result = GetObject(Picture1.Picture.Handle, Len(testBMP), testBMP)
If result <> 0 And testBMP.bmType = 0 Then

' Create a memory DC compatible with the desktop
MemDC = CreateCompatibleDC(GetDC(GetDesktopWindow()))
' Select our bitmap into it
OldBMP = SelectObject(MemDC, Picture1.Picture.Handle)
' Now use GetPixel to peek at the image in the memory DC
' In this example we loop through every pixel and dump it's value to the immediate window
For yLoop = 0 To testBMP.bmHeight - 1
For xLoop = 0 To testBMP.bmWidth - 1
Debug.Print Hex(GetPixel(MemDC, xLoop, yLoop))
Next
Next
' Clean up a bit
DeleteDC MemDC
End If
End Sub

 

[PowerChamp]

here is the very very simple solution to get each and every pixel in the picture contol

picture1.picture = loadpicture (&quot;c:\yourpic.jpg&quot;
' set the pixel mode
' ************************
Picture1.ScaleMode = 3
For X = 1 To Picture1.ScaleWidth
For Y = 1 To Picture1.ScaleHeight
Col = Picture1.Point(X, Y)

' ***************
' do you caluclation on the pixel that you want
' **************
Col = Col Xor 65 'i changed the color with xor
Picture1.PSet (X, Y), Col
Next
Next

 

[strongm]

Powerchamp, if you read the question you'll see that the technique you propose is exactly the technique that serban explains doesn't work (for pixels that are not on the screen; or, more accurately, for pixels that are outside the picturebox control). Hence the alternatives presented here.

 

[Serban]

Thanks STRONGM!

Your solution is great!!!!!

 

[hardkor1001110]

you should give the man a star for that one.

thanks here too strong... I can use that too. I'll still just read the bytes from disk for 24 bit bmps though.