VB原创纯代码全屏找图找色（支持色偏，透明图）

szg9999

N年前初识VB时写的代码，乱了点，各位将就看看把，如果有需求下次发上GDI后台的图色，等同于大漠GDI后台（某位大牛逆向大漠插件得到的方法，我有空就写了出来）
VB开发的图色识别速度上与C++开发的其实相差并不是很大，1440*900扫描一张图，都在稳定100MS内完成，只有在找透明图
时，遇到非透明色的颜色和待找大图中大部分颜色相同时，效率会远远低于C++，貌似循环套嵌效率没C++高。
（透明图指的是图片四个角颜色相同，默认图片中该色为透明图，忽略该种颜色的对比）

管理可精否？

找色部分

1. 
   
2. Option Explicit
   
3. 
   
4. '====================================================
   
5. Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC 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
   
6. Private Declare Function SetDIBits 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
   
7. '====================================================
   
8. 
   
9. '====================================================
   
10. Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long '获取句柄
    
11. 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 '获取图片数据
    
12. 
    
13. Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal HDC As Long) As Long '释放DC
    
14. 
    
15. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal HDC As Long) As Long
    
16. Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal HDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
    
17. Private Declare Function DeleteDC Lib "gdi32" (ByVal HDC As Long) As Long
    
18. Private Declare Function SelectObject Lib "gdi32" (ByVal HDC As Long, ByVal hObject As Long) As Long
    
19. Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
    
20. 
    
21. Dim intX As Long
    
22. Dim intY As Long
    
23. Dim intZ As Long
    
24. 
    
25. '颜色表
    
26. Private Type RGBQUAD
    
27.     rgbBlue As Byte
    
28.     rgbGreen As Byte
    
29.     rgbRed As Byte
    
30.     rgbAlpha As Byte   '透明通道
    
31. End Type
    
32. 
    
33. Private Type BITMAPINFOHEADER
    
34.     biSize As Long          '位图大小
    
35.     biWidth As Long
    
36.     biHeight As Long
    
37.     biPlanes As Integer
    
38.     biBitCount As Integer   '信息头长度
    
39.     biCompression As Long   '压缩方式
    
40.     biSizeImage As Long
    
41.     biXPelsPerMeter As Long
    
42.     biYPelsPerMeter As Long
    
43.     biClrUsed As Long
    
44.     biClrImportant As Long
    
45. End Type
    
46. 
    
47. Private Type BITMAPINFO
    
48.     bmiHeader As BITMAPINFOHEADER
    
49.     bmiColors As RGBQUAD
    
50. End Type
    
51. 
    
52. '图片文件头
    
53. Dim BI As BITMAPINFO
    
54. Dim BI1 As BITMAPINFO
    
55. 
    
56. Public Function FindColorEx(Left As Long, Top As Long, Right As Long, Bottom As Long, color As String) As String
    
57. Dim l() As String
    
58. Dim ld As Long
    
59. Dim W As Long, H As Long, i As Long, j As Long
    
60. Dim RGB(3) As Long
    
61. Dim fPic() As Byte
    
62. l = Split(color, "|")
    
63. Dim m As Long
    
64. W = Right
    
65. H = Bottom
    
66. With BI1.bmiHeader
    
67.     .biSize = Len(BI1.bmiHeader)
    
68.     .biWidth = W
    
69.     .biHeight = -H
    
70.     .biBitCount = 32
    
71.     .biPlanes = 1
    
72. End With
    
73. 
    
74. ReDim fPic(3, W - 1, H - 1)
    
75. 
    
76.      Dim hBMPhDC
    
77.      Dim hDCmem As Long
    
78.      Dim Pic1Handle As Long
    
79.      Dim hBmpPrev As Long
    
80.      hBMPhDC = GetDC(0)
    
81.      hDCmem = CreateCompatibleDC(hBMPhDC)
    
82.      Pic1Handle = CreateCompatibleBitmap(hBMPhDC, Right, Bottom)
    
83.      hBmpPrev = SelectObject(hDCmem, Pic1Handle)
    
84.      BitBlt hDCmem, 0, 0, Right, Bottom, hBMPhDC, Left, Top, SRCCOPY
    
85.      DeleteDC hDCmem
    
86. 
    
87. i = GetDIBits(hBMPhDC, Pic1Handle, 0, H, fPic(0, 0, 0), BI1, 0)
    
88. 
    
89. ReleaseDC 0, hBMPhDC
    
90. For ld = 0 To UBound(l)
    
91. For m = 0 To 2
    
92.     RGB(m) = CLng("&H" & Mid(l(ld), m * 2 + 1, 2))
    
93. Next
    
94. '分析查找
    
95. For j = 0 To H - 1
    
96.     For i = 0 To W - 1
    
97.                 If fPic(2, i, j) <> RGB(0) Then GoTo ExitLine:   'R
    
98.                 If fPic(1, i, j) <> RGB(1) Then GoTo ExitLine:   'G
    
99.                 If fPic(0, i, j) <> RGB(2) Then GoTo ExitLine:   'B
    
100.         If FindColorEx = "" Then
     
101.         FindColorEx = ld & "," & i & "," & j
     
102.         Else
     
103.         FindColorEx = FindColorEx & "|" & ld & "," & i & "," & j
     
104.         End If
     
105. ExitLine:
     
106.     Next i
     
107. Next j
     
108. Next
     
109. 
     
110. End Function
     
111. 
     
112. 
     
113. Public Function FindColor(Left As Long, Top As Long, Right As Long, Bottom As Long, color As String) As String
     
114. Dim l() As String
     
115. Dim W As Long, H As Long, i As Long, j As Long
     
116. Dim RGB(3) As Byte
     
117. Dim fPic() As Byte
     
118. Dim m As Long
     
119. W = Right
     
120. H = Bottom
     
121. With BI1.bmiHeader
     
122.     .biSize = Len(BI1.bmiHeader)
     
123.     .biWidth = W
     
124.     .biHeight = -H
     
125.     .biBitCount = 32
     
126.     .biPlanes = 1
     
127. End With
     
128. ReDim fPic(3, W - 1, H - 1)
     
129.      Dim hBMPhDC
     
130.      Dim hDCmem As Long
     
131.      Dim Pic1Handle As Long
     
132.      Dim hBmpPrev As Long
     
133.      hBMPhDC = GetDC(0)
     
134.      hDCmem = CreateCompatibleDC(hBMPhDC)
     
135.      Pic1Handle = CreateCompatibleBitmap(hBMPhDC, Right, Bottom)
     
136.      hBmpPrev = SelectObject(hDCmem, Pic1Handle)
     
137.      BitBlt hDCmem, 0, 0, Right, Bottom, hBMPhDC, Left, Top, SRCCOPY
     
138.      DeleteDC hDCmem
     
139. 
     
140. i = GetDIBits(hBMPhDC, Pic1Handle, 0, H, fPic(0, 0, 0), BI1, 0)
     
141. 
     
142. ReleaseDC 0, hBMPhDC
     
143. For m = 0 To 2
     
144.     RGB(m) = CLng("&H" & Mid(color, m * 2 + 1, 2))
     
145. Next
     
146. '分析查找
     
147. For j = 0 To H - 1
     
148.     For i = 0 To W - 1
     
149.                 If fPic(2, i, j) <> RGB(0) Then GoTo ExitLine:   'R
     
150.                 If fPic(1, i, j) <> RGB(1) Then GoTo ExitLine:   'G
     
151.                 If fPic(0, i, j) <> RGB(2) Then GoTo ExitLine:   'B
     
152.         FindColor = i & "," & j
     
153.         Exit Function
     
154. 
     
155. ExitLine:
     
156.     Next i
     
157. Next j
     
158. 
     
159. End Function
     
160. 
     
161. 
     
162. Public Function FindColorE(Left As Long, Top As Long, Right As Long, Bottom As Long, color As String, sim As Double) As String
     
163. Dim l() As String
     
164. Dim W As Long, H As Long, i As Long, j As Long
     
165. Dim RGB(3) As Byte
     
166. Dim fPic() As Byte
     
167. Dim m As Long
     
168. sim = (1 - (1 - sim) * 0.65)
     
169. W = Right
     
170. H = Bottom
     
171. With BI1.bmiHeader
     
172.     .biSize = Len(BI1.bmiHeader)
     
173.     .biWidth = W
     
174.     .biHeight = -H
     
175.     .biBitCount = 32
     
176.     .biPlanes = 1
     
177. End With
     
178. ReDim fPic(3, W - 1, H - 1)
     
179.      Dim hBMPhDC
     
180.      Dim hDCmem As Long
     
181.      Dim Pic1Handle As Long
     
182.      Dim hBmpPrev As Long
     
183.      hBMPhDC = GetDC(0)
     
184.      hDCmem = CreateCompatibleDC(hBMPhDC)
     
185.      Pic1Handle = CreateCompatibleBitmap(hBMPhDC, Right, Bottom)
     
186.      hBmpPrev = SelectObject(hDCmem, Pic1Handle)
     
187.      BitBlt hDCmem, 0, 0, Right, Bottom, hBMPhDC, Left, Top, SRCCOPY
     
188.      DeleteDC hDCmem
     
189. 
     
190. i = GetDIBits(hBMPhDC, Pic1Handle, 0, H, fPic(0, 0, 0), BI1, 0)
     
191. 
     
192. ReleaseDC 0, hBMPhDC
     
193. For m = 0 To 2
     
194.     RGB(m) = CLng("&H" & Mid(color, m * 2 + 1, 2))
     
195. Next
     
196. '分析查找
     
197. For j = 0 To H - 1
     
198.     For i = 0 To W - 1
     
199.                 If fPic(2, i, j) < CLng(RGB(0) * sim) Or fPic(2, i, j) > CLng(RGB(0) * (2 - sim)) Then GoTo ExitLine: 'R
     
200.                 If fPic(1, i, j) < CLng(RGB(1) * sim) Or fPic(1, i, j) > CLng(RGB(1) * (2 - sim)) Then GoTo ExitLine:   'G
     
201.                 If fPic(0, i, j) < CLng(RGB(2) * sim) Or fPic(0, i, j) > CLng(RGB(2) * (2 - sim)) Then GoTo ExitLine:   'B
     
202.         FindColorE = i & "," & j
     
203.         Exit Function
     
204. 
     
205. ExitLine:
     
206.     Next i
     
207. Next j
     
208. 
     
209. End Function

复制代码

hapi

vb找图找色源代码出于何处？

liuyh7788

回帖支持楼主分享精神！

citong001

这个如果做好比按键强多了