Keskustelu: Ohjelmointikysymykset: VB6: [vb6] Type mismatch

Private Sub miner_Timer()
If Not Clicked = 26 Then
   Dim tmpPoint As PointAPI
'Virhe tulee tätä alempana olevassa rivissä
    tmpPoint = FindColorSpiral(vbcolor.Caption, SelWnd, 259, 175, 7, 7, 511, 334)

Clicked = Clicked + 1
SetCursor tmopoint.x, tmpPoint.y
Waitms 100
LeftClick
SendKeys "{UP}"
Else
movemousetocolor.Enabled = False
Clicked = 0
miner.Enabled = False
DropAll
End If

End Sub

'Etkö tiedä mikä on "selwnd"?:
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Me.MousePointer = 0
Me.Show
Picture1.Visible = True
TimSpy.Enabled = False
Me.WindowState = 0
Unload Form2
Waitms 50
Dim mousexy As PointAPI
GetCursorPos mousexy

SelWnd = WindowFromPoint(mousexy.x, mousexy.y)

'Tässä
SelWnd = WindowFromPoint(mousexy.x, mousexy.y)

picColor.ToolTipText = "Color code: " & vbcolor.Caption

End Sub

'MODUULI
Option Explicit
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRGN As Long, ByVal bRedraw As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
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
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function 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) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As PointAPI) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Type PointAPI
    x As Long
    y As Long
End Type
Dim mousexy As PointAPI


Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Dim SelWnd As Long
Private Const SWP_NOMOVE = 2
Private Const SWP_NOSIZE = 1
Private Const flags = SWP_NOMOVE Or SWP_NOSIZE
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
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 BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type
Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type
Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD
End Type
Private Const DIB_RGB_COLORS = 0&
Private Const BI_RGB = 0&

Public Function FindColor(window As Long, colortofind As Long)
Dim wndRect As RECT
Dim x As Long, y As Long, test As Long
Dim nappi As Integer
Randomize
nappi = (3 * Rnd) + 1
If nappi = 1 Then
SendKeys "{left}"
Else
If nappi = 2 Then
SendKeys "{up}"
Else
If nappi = 3 Then
SendKeys "{right}"
End If
End If
End If

GetWindowRect window, wndRect
test = GetDC(window)
For y = 0 To (wndRect.Bottom - wndRect.Top)
  For x = 0 To (wndRect.Right - wndRect.Left)
   If GetPixel(test, x, y) = colortofind Then
     SetCursorPos x + wndRect.Left, y + wndRect.Top
     Exit Function
    End If
  Next x
Next y
End Function


Public Sub Wait(ABC!)
Dim secs As Variant
secs = Timer
Do
DoEvents
If Timer < secs Then ABC = ABC - 86400
   Sleep (50)
    Loop Until (Timer - secs > ABC)
End Sub

Public Function GetCursor()
Dim wndRect As RECT
Dim mousexy As PointAPI
GetWindowRect SelWnd, wndRect
GetCursorPos mousexy
GetCursor = (mousexy.x - wndRect.Left) & "," & (mousexy.y - wndRect.Top)
End Function


Public Function FindColorSpiral(color, hdc, x, y, x1, y1, x2, y2 As Long) As PointAPI
    Dim direction, length, i As Integer
    direction = 0: length = 1
    If color = GetPixel(hdc, x, y) Then GoTo Done
    Do 'Cruels.net owns me kthx...
        For i = 1 To length
            Select Case direction
                Case 0: y = y - 1
                Case 1: x = x + 1
                Case 2: y = y + 1
                Case 3: x = x - 1
            End Select
            If color = GetPixel(hdc, x, y) Then GoTo Done
        Next i
        direction = (direction + 1) Mod 4
        If (direction Mod 2) = 0 Then length = length + 1
    Loop While Not ((x < x1) Or (y < y1) Or (x > x2) Or (y > y2))
    If (color <> GetPixel(hdc, x, y)) Then x = -1: y = -1
Done:
    FindColorSpiral.x = x
    FindColorSpiral.y = y
End Function