Re: Pset and SetPixel Bug

whow! thanks

Martin


Mike Williams schrieb:
"Martin Enke" <m.enke@xxxxxxxxxx> wrote in message news:49abbc28$0$31880$9b4e6d93@xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

this is a very intresting idea, could you please provide some
code on how to point a byte array to a bitmap?

The method varies slightly depending on what kind of bitmap you are dealing with (screen compatible bitmap or device independent bitmap) and also where you are getting it from. If for example it is a device independent bitmap that you have created in code using CreateDIBSection then the CreateDIBSection function will return a pointer in the ppbits parameter telling you where in memory the bitmap bits are located, or if you have loaded a bmp file from disk using LoadImage then the LoadImage function is capable of telling you where the bitmap data is located in memory. Once you know the address you can then point a SAFEARRAY structure at that data and access it from the array. Perhaps a more flexible, albeit it slightly slower, method is to use GetDIBits to transfer the pixel data of an existing bitmap to an area of memory (an standard VB array of Bytes or perhaps Longs) in DIB format because this is easier to set up and will allow you to more easily deal with bitmaps that you commonly come across in VB6 (the Image bitmap of an Autoredraw PictureBox for example, the format of which varies depending on the colour depth of your display). This is slower than the previous method of pointing a SAFEARRAY structure at an existing block of bitmap data because it involves creating a new block of memory (the standard VB array of Bytes or Longs) and transferring the data of an existing bitmap into it, with the conversion that is required to convert the pixel data from screen compatible format to DIB format, but GetDIBits is surprisingly fast at converting and shifting such data so it is still a very useful technique.

As an example, the following code loads a jpg image and stretches it into a screen sized Autoredraw VB PictureBox so that it exactly fits (in this simple example I have not taken account of the original aspect ratio). However, if you wish, you can easily change the code so that the PictureBox sizes itself to the full original image size. When you run the code and click the displayed picture the GetDIBits function copies the pixel data in DIB format into a suitably sized VB array of UDTs, where each UDT contains 4 individual Bytes (I could have instead used an array of Longs, but in this case I wanted easy access to the individual rgb bytes of each pixel). The code then, just for test purposes, runs through the VB array setting the red component of each "pixel" to zero. Finally the SetDIBitstoDevice function is used to transfer the VB array data back to the PictureBox in the appropriate format. Note that it would have been possible to transfer the data as a "three bytes per pixel" DIB into a Byte array, but using four bytes per pixel (even though it uses a little more memory) is sometimes more appropriate.

Anyway, to try the code paste it into a VB Form containing a PictureBox and change the hard coded "c:\temp\jan1.jpg" to a picture that exists on your own system. When you run the project and click the displayed picture you will see the effect of the removal of the red element and the time taken will be displayed in a message box, showing separately the time taken by GetDIBits, the time to run through and modify the VB array data, the time taken by SetDIBitsToDevice and the overall total time. This time to deal with the array will be a lot quicker of course when run as a native code compiled exe than it will be when run in the IDE. Even though this particular method takes longer than the alternative of pointing an array at the existing image data (because it needs to actually copy blocks of memory data) it is still very quick when compared to SetPixel, typically hundreds of times faster.

Mike

Option Explicit
Private Declare Function timeBeginPeriod _
Lib "winmm.dll" (ByVal uPeriod As Long) As Long
Private Declare Function timeEndPeriod _
Lib "winmm.dll" (ByVal uPeriod As Long) As Long
Private Declare Function timeGetTime _
Lib "winmm.dll" () As Long
Private Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
End Type
Private Declare Function GetDIBits Lib "gdi32" _
(ByVal hdc As Long, ByVal hBitmap As Long, _
ByVal nStartScan As Long, ByVal nNumScans As Long, _
lpBits As Any, lpBI As BITMAPINFO, _
ByVal wUsage As Long) As Long
Private Declare Function SetDIBitsToDevice Lib "gdi32" _
(ByVal hdc As Long, ByVal x As Long, ByVal y As Long, _
ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, _
ByVal SrcY As Long, ByVal Scan As Long, _
ByVal NumScans As Long, Bits As Any, _
BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long
Private Const DIB_RGB_COLORS = 0
Private Const BI_RGB = 0


Private Sub Form_Load()
timeBeginPeriod 1
Me.WindowState = vbMaximized
Me.Show
Picture1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
Picture1.ScaleMode = vbPixels
Picture1.AutoRedraw = True
Picture1.PaintPicture LoadPicture("c:\temp\jan1.jpg"), _
0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight
End Sub

Private Sub Form_Unload(Cancel As Integer)
timeEndPeriod 1
End Sub

Private Sub Picture1_MouseDown(Button As Integer, _
Shift As Integer, x As Single, y As Single)
Dim bmapinfo As BITMAPINFO
Dim SourceArray() As RGBQUAD
Dim SourceWidth As Long, SourceHeight As Long
Dim x1 As Long, y1 As Long
Dim t1 As Long, t2 As Long
Dim t3 As Long, t4 As Long
SourceWidth = Picture1.ScaleWidth
SourceHeight = Picture1.ScaleHeight
With bmapinfo.bmiHeader
.biSize = Len(bmapinfo)
.biWidth = SourceWidth
.biHeight = SourceHeight
.biPlanes = 1
.biBitCount = 32
.biCompression = BI_RGB
End With
t1 = timeGetTime
ReDim SourceArray(1 To SourceWidth, 1 To SourceHeight)
GetDIBits Picture1.hdc, Picture1.Image, _
0, SourceHeight, SourceArray(1, 1), bmapinfo, _
DIB_RGB_COLORS
t2 = timeGetTime
' just some test code to set the red
' component of each pixel to zero
For y1 = 1 To SourceHeight
For x1 = 1 To SourceWidth
SourceArray(x1, y1).rgbRed = 0
Next x1
Next y1
'
t3 = timeGetTime
SetDIBitsToDevice Picture1.hdc, 0, 0, SourceWidth, _
SourceHeight, 0, 0, 0, SourceHeight, SourceArray(1, 1), _
bmapinfo, DIB_RGB_COLORS
t4 = timeGetTime
Picture1.Refresh
MsgBox t2 - t1 & " milliseconds to create array and GetDIBits." _
& vbCrLf & t3 - t2 & " milliseconds to modify pixels " _
& vbCrLf & t4 - t3 & " milliseconds to SetBits back to Image." _
& vbCrLf & vbCrLf & "total time is " & t4 - t1 & " milliseconds."
End Sub




.

Loading