AimPoint: Kính ngắm

Các mẹo vặt linh tinh khác, không thuộc nhóm nào
Đăng trả lời
Hình đại diện của thành viên
truongphu
VIP
VIP
Bài viết: 4785
Ngày tham gia: Chủ nhật 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 531 times

AimPoint: Kính ngắm

Gửi bài by truongphu »

Thủ thuật: AimPoint: Kính ngắm
Tác giả: truongphu
Mô tả: Hình như trên mạng thế giới chưa có bài nầy nên tôi viết bổ sung
  1.   ' Always on top
  2. Private Declare Sub SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
  3. Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
  4. Private Declare Function SetPixel Lib "gdi32.dll" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
  5. Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As Long, ByVal bErase As Long) As Long
  6. Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
  7. 'Code truongphu
  8. Dim WinDC&, Ax&, Ay&, BB As Boolean
  9.  
  10. Private Sub Command3_Click()
  11.     InvalidateRect 0&, 0&, False
  12. End Sub
  13.  
  14. Private Sub DieuKhien_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  15. BB = True Dim i&
  16. Do DoEvents
  17. If BB = False Then Exit Do
  18. If i = 1000000 Then i = 1
  19.     If i Mod 5000 = 0 Then
  20.         XóaChuThâp
  21.         Select Case Index
  22.             Case 0         Ax = Ax - 10
  23.             Case 1         Ax = Ax + 10
  24.             Case 2         Ay = Ay - 10
  25.             Case 3         Ay = Ay + 10
  26.         End Select
  27.         ChuThâp
  28.     End If
  29.     i = i + 1
  30. Loop
  31. End Sub
  32.  
  33. Private Sub DieuKhien_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  34.     BB = False
  35. End Sub
  36.  
  37. Private Sub Form_Load()
  38.      WinDC = GetDC(0)
  39.     SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 1  ' Always on top
  40.    Ax = Screen.Width \ 30
  41.     Ay = Screen.Height \ 30
  42. End Sub
  43.  
  44. Private Sub ChuThâp()
  45. Dim ii&
  46.      WinDC = GetDC(0)
  47.     For ii = Ax - 10 To Ax + 10
  48.         SetPixel WinDC, ii, Ay, vbRed
  49.     Next
  50.     For ii = Ay - 10 To Ay + 10
  51.         SetPixel WinDC, Ax, ii, vbRed
  52.     Next
  53. End Sub
  54.  
  55. Private Sub XóaChuThâp()
  56. Dim ii&, CC&
  57.      CC = GetPixel(WinDC, Ax - 1, Ay - 1)
  58.     For ii = Ax - 10 To Ax + 10
  59.         SetPixel WinDC, ii, Ay, CC
  60.     Next
  61.     For ii = Ay - 10 To Ay + 10
  62.         SetPixel WinDC, Ax, ii, CC
  63.     Next
  64. End Sub
Tập tin đính kèm
AimPoint.rar
(1.79 KiB) Đã tải về 961 lần
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh
Phuc Vinh
Thành viên chính thức
Thành viên chính thức
Bài viết: 15
Ngày tham gia: Thứ 3 11/11/2008 3:50 pm
Đến từ: Thành Phố Vĩnh Long
Tiếp xúc:

Re: AimPoint: Kính ngắm

Gửi bài by Phuc Vinh »

HÀng nay khi Move Form vào thì nó mất tiu => khi vào game hay cái gì khác thì nó bị xóa mất chữ thập !
Có cách khác không bác
Học Thì Phải Hỏi Không Hỏi Không Biết Đường Học
Hình đại diện của thành viên
truongphu
VIP
VIP
Bài viết: 4785
Ngày tham gia: Chủ nhật 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 531 times

Re: AimPoint: Kính ngắm

Gửi bài by truongphu »

Bạn có để ý tôi dùng hàm:
WinDC = GetDC(0)

GetDC sẽ nhận đối số là hWnd của cửa sổ nào đó, đó là một số Long. Ở đây tôi cho nó là 0 cho gọn

Để hoạt động tốt, bạn có thể tìm hwnd đích thực với các hàm (tùy yêu cầu mà dùng 1 trong các hàm sau):
* GetForegroundWindow tìm hWnd của cửa sổ nền đang hoạt động
* GetActiveWindow tìm hWnd của cửa sổ đang Active
* FindWindow: Đây là hàm tìm chính xác, đích thực nhất, chỉ chạy trên một cửa sổ có Title cố định

Nói thêm hàm SetPixel: chúng vẽ màu yêu cầu lên một mặt vẽ (hdc) của cửa sổ.
Nếu cửa sổ ấy Refresh thì các màu vẽ sẽ biến mất
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh
Đăng trả lời

Quay về