A simple and fast method of gray-scale image processing

Because of their own program in the need for a form region frequently color grayscale processing, for this purpose wrote a function. The processing object is a dynamic region that is constantly changing, and is a part of a series of drawings, the speed is higher, the algorithm is simple, so the following two steps are adopted:

1, based on the DDB to write, although to the DIB, you do not have to face a variety of color depth, will unify the algorithm, but the conversion process will allow a lot of speed, moreover, this is only for screen bitmap functions, and there is no need to save.
Considering the actual situation, I only wrote 16, 24, 32-bit three color depth algorithm, in fact, 4, 82 kinds of bitmap is the fastest, no matter how large the figure only to handle 16 and 256 operations, but now which people's screen, but also using these two display mode? It's not necessary to think about it.
By contrast, the 32-bit fastest, 16-bit slowest, a little dissatisfied, but the speed is not slow. The gap is no more than 50%.

2, gray-scale algorithm is not complex, but I have done a simplification, normal processing of the general need for RGB weighted average, take a value to unify the three primary colors, but this needs to involve floating-point operations, speed does not go, the effect is not seen how good.
My method is very simple, is to take the value of one of the three primary colors, unified, considering the human eye on the most sensitive to green, so the algorithm becomes RGB to GGG. Strictly speaking, this is not called color turn ash, it is more suitable for green to turn ash. RGB arrangement G is in the middle, want to use high speed long operation, with B value the fastest, but has been simplified enough, and then Jane go on, they feel sorry. (with B-value 32-bit, speed can be faster 1/3)
This algorithm, of course, is flawed, mainly for some of the color map effect is not good, but fortunately this situation in the color-rich interface does not exist.

c2.4g 256M WinXP SP2 under test conditions
In the IDE environment
Bitmap for 1024 X 768
32-bit Screen 219 ms
16-bit Screen 314 ms

N code compilation, all optimized Open
Bitmap for 1024 X 768
32-bit Screen 62 ms
16-bit Screen 75 ms

Note: No 24-bit environment, so there is no test

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 Type MEMHDC
HDC as Long
BMP as Long
OBM as Long
End Type
Private Declare Function getobj Lib "gdi32" Alias "GetObjectA" (ByVal hobject as Long, ByVal ncount as Long, lpobject as A NY) as Long
Private Declare Function selectobject Lib "GDI32" (ByVal hdc as Long, ByVal hobject as long) as long
Private Declare Function deleteobject Lib "gdi32" (ByVal Hobject as long) as long
Private Declare Function deletedc Lib "GDI32" (ByVal hdc as long) as long
Private Declare Function BitBlt Lib "gdi32" (ByVal hdestdc as Long, ByVal x as Long, ByVal y as Long, ByVal nwidth as Long , ByVal nheight as Long, ByVal HSRCDC as Long, ByVal xsrc as Long, ByVal ysrc as Long, ByVal Dwrop as long) as long

Private Declare Function createcompatibledc Lib "GDI32" (ByVal hdc as long) as long
Private Declare Function createcompatiblebitmap Lib "GDI32" (ByVal hdc as Long, ByVal nwidth as Long, ByVal nheight as Lon g) as Long
Private Declare Function getbitmapbits Lib "gdi32" (ByVal hbitmap as Long, ByVal dwcount as Long, lpbits as any) as long
Private Declare Function setbitmapbits Lib "gdi32" (ByVal hbitmap as Long, ByVal dwcount as Long, lpbits as any) as long

Private Declare Function gettickcount Lib "kernel32" () as Long
Private Declare Sub copymemory Lib "kernel32" Alias "RtlMoveMemory" (pdest as any, psource as any, ByVal dwlength as Long)
"Usually do graphics processing, their own two common functions are also used on the
Private Function Newmyhdc (dhdc as Long, w as Long, h as long, Optional Bm as Long) as Memhdc
With NEWMYHDC
. HDC = CreateCompatibleDC (DHDC)
If Bm = 0 Then
. BMP = CreateCompatibleBitmap (DHDC, W, h)
Else
. BMP = Bm
End If
. OBM = SelectObject (. HDC,. BMP)
End With
End Function

Private Function Delmyhdc (myhdc as MEMHDC, Optional nobmp as Boolean) as Memhdc
With MYHDC
If. HDC <> 0 and. OBM <> 0 Then SelectObject. HDC,. OBM
If nobmp = False and. BMP <> 0 Then DeleteObject. Bmp
If. HDC <> 0 Then DeleteDC. HDC
End With
End Function

' Grayscale processing main function
Private Function graybmp (dhdc as Long, x as Long, y as Long, w as Long, h as long) as long
Dim TMPDC as Memhdc
Dim I as Long, j as long, m as long, K as Byte, L as Long
Dim Bm as BITMAP, allbytes as Long, linebytes as Long
Dim dbits () as Byte
Dim dBits1 () as Integer
Dim dBits2 () as Long
On Error GoTo Last
With TMPDC
TMPDC = Newmyhdc (DHDC, W, h)
Getobj. BMP, Len (BM), BM
If Bm.bmbitspixel < Then GoTo last
BitBlt. HDC, 0, 0, W, h, Dhdc, X, Y, vbsrccopy
Linebytes = Bm.bmwidthbytes
Allbytes = linebytes * H
Select Case Bm.bmbitspixel
Case 32
ReDim dBits2 (allbytes \ 4-1)
Getbitmapbits. BMP, Allbytes, dBits2 (0)
For i = 0 to allbytes \ 4-1
DBits2 (i) = ((DBits2 (i) and &HFF00&) \ &h100) * &h10101
' DBits2 (i) = (DBits2 (i) and &AMP;HFF) * &h10101 ' with B-value operation
Next
Setbitmapbits. BMP, Allbytes, dBits2 (0)
Graybmp = 32
Case 24
ReDim dbits (AllBytes-1)
Getbitmapbits. BMP, Allbytes, dbits (0)
For j = 0 to H-1
m = J * Linebytes
For i = m-M + w * 3-1 Step 3
Dbits (i) = dbits (i + 1)
Dbits (i + 2) = Dbits (i)
Next
Next
Setbitmapbits. BMP, Allbytes, dbits (0)
Graybmp = 24
Case 16
' Operation in 565 format
ReDim dBits1 (allbytes \ 2-1)
Getbitmapbits. BMP, Allbytes, dBits1 (0)
For j = 0 to H-1
m = J * linebytes \ 2
For i = m to M + w-1
L = dBits1 (i) and &H7C0&
L = L * + + L + L \ 64
CopyMemory DBits1 (i), L, 2 ' There is no way, do not copymemory, will overflow, inefficient from this
Next
Next
Setbitmapbits. BMP, Allbytes, dBits1 (0)
Graybmp = 16
End Select
BitBlt dhdc, X, Y, W, H,. HDC, 0, 0, vbsrccopy
End With
Last
DELMYHDC TMPDC
End Function
Private Sub Form_Load ()
ScaleMode = 3
AutoRedraw = True
Picture = LoadPicture ("f:\1.jpg")
Command1.Caption = "Test"
End Sub

' Test code
Private Sub form_resize ()
PaintPicture picture, 0, 0, ScaleWidth, ScaleHeight
End Sub

Private Sub Command1_Click ()
Dim T as long, s as String, S1 as String, I as Long
t = GetTickCount
Graybmp hdc, 0, 0, ScaleWidth, ScaleHeight
Refresh
MsgBox Gettickcount-t & S
End Sub