One of the easiest ways to speed up your graphics is to use the native API calls rather than the built in graphical methods. For example, using the API functions GetPixel and SetPixel is about 3x faster than using the built in methods PSet and Point. But while the the API is fast, you can get even better performance with direct memory access (DMA).
But wait! What about DirectX? Well, DirectX is great and is extremely fast for complex operations but most of its speed comes from its ability to interact with the coprocessor in your graphics card. If you don't have such a card (unlikely, true, but there it is) or if you are doing simple graphics (line and point stuff), then DMA is just as fast. Plus you don't need to distribute any particular version of DX.
Besides, I just like DMA. DX hides a lot of the logic of graphics which is great, but sometimes you can learn quite a bit from the algorithms behind a line, or a floodfill.
Anyway, here is how you do DMA.
The basic idea is that you access the actual bitmap that makes up the picture. You can do this indirectly by using the API functions GetDIBits and SetDIBits which extract a bitmap into an array and copy an array to a bitmap respectively, but you can do it directly if you had an array that pointed to the actual memory used by the bitmap.
To make such an array requires some API calls of course. Here they are:
Code:
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" _
(Ptr() As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(pDst 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
Private Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type
Private 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
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
The VarPtr function can get the actual memory address of a variable. In this case, we type the function in such a way that it works on arrays and we call it VarPtrArray. The CopyMemory function can copy data from one memory location to another. The GetObjectAPI function can retrieve information out of an object. In this case, we will use it to extract the BITMAP information from a stdPicture object, thus we need to define a BITMAP structure. Finally, we define a SAFEARRAY structure since this is the raw format behind an array and we need to mess with this to get this method to work.
So we start with a stdPicture object. We will assume that this object has a picture loaded. We also have a dynamic array of bytes, but this array has not yet had any memory assigned to it. We then use our API functions to assign the memory used by the picture object to the array, thus any changes we make to the array will show up in the picture.
Here is how we do it:
Code:
Dim SA As SAFEARRAY2D
Dim BMP As BITMAP
Dim mvarBytesPerPixel
Public Sub LoadPicArray(p As StdPicture,Data() As Byte)
If GetObjectAPI(p.Handle, Len(BMP), BMP) Then 'retrieve bitmap information about p
mvarBytesPerPixel = BMP.bmWidthBytes \ BMP.bmWidth
' make 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
' copy bitmap data into byte array
CopyMemory ByVal VarPtrArray(Data), VarPtr(SA), 4
End If
End Sub
So what happened? Well, first, we use the GetObjectAPI function to extract the BITMAP info. We then use this information to set up the SA SafeArray2D structure. In particular, notice the line:
.pvData = BMP.bmBits
which assigns the memory stored in the bitmap to the SA structure.
Now we simply make the Data array point to the SA structure with the CopyMemory function while using the VarPtr functions to get the actual memory addresses of the SA structure and the array.
Simple? Well, not exactly....there are some caveats...
1) The Picture object MUST have a picture preloaded. This will set up the objects BMP structure. Otherwise, it will be uninstantiated.
2) The SA object MUST persist for the life of the array. Remember, the array points to the SA structure so if you destroy SA before you terminate the array, the array will point to nothing.
3) Before you destroy the array, you MUST reset it to point to null, otherwise you can crash the program or get a memory leak.
4) A 256 color Bitmap has 1 byte per pixel, but this byte is a palette index, not a color. So you need to convert colors into palette indexs before setting the array. The same applies to 16bit HiColor bitmaps. Fortunately, TrueColor (24bit) images are the actual colors, although you need to set each RGB byte individually.
5) Oddly enough, the array is mapped from the bottom up. In other words, array point 0, 0 is the BOTTOM left corner.
After you are done, you must reset the array. Here is how you can do it:
Code:
Public Sub ReleaseData(a() As Byte)
CopyMemory ByVal VarPtrArray(a), 0&, 4
End Sub
So now how do you use the array?
Well, the array is now a 2D array of the form Data(X, Y) where X is the column and Y is the row. Each element of the array is a byte. For 256 color bitmaps, this byte is a palette index for that pixel. But for 24 bit images, each byte is a colour value (BGR) for a pixel, so each pixel consists of 3 consecutive bytes. eg a 100pixel by 100 pixel image would generate an array 300x100 in size.
Since the array can vary in size, you have to take that into account when making functions to set or read a pixel. For instance:
Code:
Public Sub DrawPixel(Data() As Byte, ByVal x&, ByVal y&, ByVal c&)
Select Case mvarBytesPerPixel
Case 1: Data(x, y) = c And &HFF
Case 2
Data(x + x, y) = (c \ 256) And &HFF
Data(x + x + 1, y) = c And &HFF
Case 3
Data(x * 3, y) = (c \ 65536) And &HFF
Data(x * 3 + 1, y) = (c \ 256) And &HFF
Data(x * 3 + 2, y) = c And &HFF
End Select
End Sub
Public Function ReadPixel(Data() As Byte, ByVal x&, ByVal y&) As Long
Select Case mvarBytesPerPixel
Case 1: ReadPixel = Data(x, y)
Case 2: ReadPixel = Data(x + x, y) * 256& + Data(x + x + 1, y)
Case 3: ReadPixel = ((Data(x * 3, y) * 256&) + Data(x * 3 + 1, y)) * 256& + Data(x * 3 + 2, y)
End Select
End Function
Here is a comparison of speed.
With a 100x100 24 bit bitmap loaded, I set each and every pixel to red using DMA, SetPixel and PSet. The time results were 5ms, 60ms and 550ms respectively. After compiling, the speeds were 4 ms, 50 ms and 70ms. So DMA was around 12x faster than SetPixel.
I've attached a class module to encapsulate the technique. Just compile the class into an ActiveX DLL and then reference it in your own projects. Here is my speed test program that demonstrates how to use this DLL:
Code:
Option Explicit
Private Declare Function GetPixel Lib "gdi32" _
(ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" _
(ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Dim pa As BCHPicArray.clsPicArray
Private Sub Command1_Click()
Dim x&, y&, t&
t = timeGetTime()
For y = 0 To Picture1.ScaleHeight - 1
For x = 0 To Picture1.ScaleWidth - 1
pa.DrawPixel x, y, vbRed
Next x
Next y
t = timeGetTime() - t
Picture1.Refresh
Me.Caption = "PicArray=" & t
t = timeGetTime()
For y = 0 To Picture1.ScaleHeight - 1
For x = 0 To Picture1.ScaleWidth - 1
SetPixel Picture1.hdc, x, y, vbRed
Next x
Next y
t = timeGetTime() - t
Picture1.Refresh
Me.Caption = Me.Caption & " SetPixel=" & t
t = timeGetTime()
For y = 0 To Picture1.ScaleHeight - 1
For x = 0 To Picture1.ScaleWidth - 1
Picture1.PSet (x, y), vbRed
Next x
Next y
t = timeGetTime() - t
Picture1.Refresh
Me.Caption = Me.Caption & " PSet=" & t
End Sub
Private Sub Form_Load()
Set pa = New clsPicArray
pa.LoadPicArray Picture1.Picture
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set pa = Nothing
End Sub
Good luck!
相关文件：(直接下)
http://www.visualbasicforum.com/attachment.php?attachmentid=1208
http://www.visualbasicforum.com/attachment.php?attachmentid=4452
