Cursor Distinguishing and Comparing (VB6)

[redcrusher]

Here is the VB6 Code that i came up with, so that i could tell when the cursor changed.

It also says when the cursor if the same as the cursor you save.

This is a "Form1.frm" file.

expandcollapse popup

VERSION 5.00
Begin VB.Form Form1 
   Caption       =   "Cursor Compair"
   ClientHeight =   2985
   ClientLeft     =   60
   ClientTop       =   345
   ClientWidth   =   2310
   LinkTopic       =   "Form1"
   ScaleHeight   =   2985
   ScaleMode       =   0  'User
   ScaleWidth     =   19.347
   StartUpPosition =   3  'Windows Default
   Begin VB.PictureBox picContainer3 
      AutoRedraw      =   -1  'True
      Height          =   885
      Left          =   1200
      ScaleHeight    =   825
      ScaleWidth      =   855
      TabIndex      =   5
      TabStop        =   0   'False
      Top            =   120
      Width        =   915
      Begin VB.PictureBox PicFish 
         AutoRedraw   =   -1  'True
         BorderStyle     =   0  'None
         Height       =   540
         Left           =   0
         ScaleHeight     =   540
         ScaleWidth   =   540
         TabIndex       =   6
         TabStop         =   0   'False
         Top             =   0
         Width         =   540
      End
   End
   Begin VB.PictureBox PicContainer2 
      AutoRedraw      =   -1  'True
      Height          =   885
      Left          =   1200
      ScaleHeight    =   825
      ScaleWidth      =   855
      TabIndex      =   3
      TabStop        =   0   'False
      Top            =   1200
      Width        =   915
      Begin VB.PictureBox PicBlank 
         AutoRedraw   =   -1  'True
         BorderStyle     =   0  'None
         Height       =   660
         Left           =   0
         ScaleHeight     =   660
         ScaleWidth   =   660
         TabIndex       =   4
         TabStop         =   0   'False
         Top             =   0
         Width         =   660
      End
   End
   Begin VB.Timer TCapture 
      Interval      =   50
      Left          =   480
      Top            =   1320
   End
   Begin VB.PictureBox PicContainer 
      AutoRedraw      =   -1  'True
      Height          =   885
      Left          =   120
      ScaleHeight    =   825
      ScaleWidth      =   855
      TabIndex      =   1
      TabStop        =   0   'False
      Top            =   120
      Width        =   915
      Begin VB.PictureBox PicCapture 
         AutoRedraw   =   -1  'True
         BorderStyle     =   0  'None
         Height       =   540
         Left           =   0
         ScaleHeight     =   540
         ScaleWidth   =   540
         TabIndex       =   2
         TabStop         =   0   'False
         Top             =   0
         Width         =   540
      End
   End
   Begin VB.Label lblYAY 
      Caption        =   "0"
      Height          =   495
      Left          =   360
      TabIndex      =   7
      Top            =   2280
      Width        =   1455
   End
   Begin VB.Label lblTimes 
      Caption        =   "0"
      Height          =   375
      Left          =   240
      TabIndex      =   0
      Top            =   1200
      Width        =   855
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim au3 As New AutoItX3
Dim iResult As Integer

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type PCURSORINFO
    cbSize As Long
    flags As Long
    hCursor As Long
    ptScreenPos As POINTAPI
End Type
'To grab cursor shape -require at least win98 as per Microsoft documentation...
Private Declare Function GetCursorInfo Lib "user32.dll" (ByRef pci As PCURSORINFO) As Long
'To get a Handle to the cursor
Private Declare Function GetCursor Lib "USER32" () As Long
'To draw cursor shape on bitmap
Private Declare Function DrawIcon Lib "USER32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
     
'to get the cursor position
Private Declare Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long
'to end a waiting loopp
Dim GotIt As Boolean
'To use the scrollbars
Dim lngVer As Long
Dim lngHor As Long
Const iconSize As Integer = 9
Dim TxtPathName As String
Dim TxtPathName2 As String


Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long 'use GetPixel API
'used to indicate pixel location
Dim Pix1 As Long
Dim Pix2 As Long





Private Sub Form_Load()
    Set PicFish.Picture = LoadPicture(App.Path & "\test.bmp")
End Sub

Private Sub TCapture_Timer()
   
   'disable timer
   TCapture.Enabled = False
   
   Set PicCapture.Picture = PicBlank.Image
   
   
   'now to get the icon of mouse and paint on form the mouse
   Dim pcin As PCURSORINFO
   pcin.hCursor = GetCursor
   pcin.cbSize = Len(pcin)
   Dim ret
   ret = GetCursorInfo(pcin)
   DrawIcon PicCapture.hdc, 12 - iconSize, 12 - iconSize, pcin.hCursor
   'The following paint only mouse shape for this app
   'DrawIcon PicCapture.hdc, Point.x - iconSize, Point.y - iconSize, CopyIcon(GetCursor)
   'assign to picture the image
   Set PicCapture.Picture = PicCapture.Image
   'clear clipboard here if you can
   On Error Resume Next
   Clipboard.Clear
   'signal you've done to exit the waiting loop
   GotIt = True
   
   Pix1 = GetPixel(PicCapture.hdc, 5, 5) 'get pixel at (5 x 5 y) 'Pixle to check on cursor. Change if needed
   Pix2 = GetPixel(PicFish.hdc, 5, 5) 'get pixel at (5 x 5 y) 'Pixle to check on cursor. Change if needed
   
   If Pix1 = Pix2 Then
        lblYAY = lblYAY.Caption + 1
        Dim mousex As Double
        Dim mousey As Double
        mousex = au3.MouseGetPosX
        mousey = au3.MouseGetPosY
        iResult = au3.IniWrite(App.Path & "\test.ini", "Vars", "Pos_X", mousex)
        iResult = au3.IniWrite(App.Path & "\test.ini", "Vars", "Pos_Y", mousey)
        iResult = au3.IniWrite(App.Path & "\test.ini", "Vars", "Cursor", "1")
   ElseIf Pix1 <> Pix2 Then
        iResult = au3.IniWrite(App.Path & "\test.ini", "Vars", "Pos_X", "0")
        iResult = au3.IniWrite(App.Path & "\test.ini", "Vars", "Pos_Y", "0")
        iResult = au3.IniWrite(App.Path & "\test.ini", "Vars", "Cursor", "0")
   End If

   lblTimes = lblTimes.Caption + 1
   TCapture.Enabled = True
   

   'Take there comment markers to save the images.  this is how you get the cursor image to compair
   'Make sure to slow down the speed of the timer wh n using this.
   'TxtPathName = "./" & lblTimes.Caption & "aaScreen.bmp"
   'SavePicture PicCapture.Image, TxtPathName
   
End Sub