Bitmap wird nicht richtig bearbeitet

Nud3l

Mitglied
Hi

ich habe da ein problem mit den beiden Methoden die 2 Funktioniert so wie sie soll die erste nicht und ich verstehe nicht wieso die erste nicht lauft sie macht alles richt bis zum schluss da ueber schreibt sie das bild wieder.

zur funktions beschreibeung beide funktionen finden auf einem bild die ecken eines schachfeldes

einmal wenn man in der naeh der ecke klickt und das ander soll automatsche alle ecken erkennen
ich habe vorher mit get und set pixel gearbeitet was sich aber als sehr langsam raus gestellt hat daher arbeite ich jetzt mit get bitmap aber irgenwie zeigt er mir nicht die ecken an


fals jemand dur den algorithmus duc steigt haetter er ne idee wie man ihn weiter optiemiern koennte


MFG


Erste methode autoerkennung
Code:
Private Sub Command1_Click()

Dim start_time As Single


Dim i, j As Integer
Dim NewColor As Long
Dim x, y As Integer
Dim r, g, b As Integer

start_time = Timer
For i = 0 To Picture1.ScaleWidth
    For j = 0 To Picture1.ScaleHeight
        'NewColor = GetPixel(Picture1.hDC, i, j)
        SetPixelV Picture1.hDC, i, j, RGB(0, 200, 0)
        
    Next j
    If i Mod 10 = 0 Then Picture1.Refresh
Next i
Text2.Text = Format$(Timer - start_time, "0.000")
End Sub








Private Sub detect_Click()
Dim start_time As Single
Dim x, y As Integer

Dim i, j, k, l As Integer
Dim point_upper_left, point_upper_right, point_lower_left, point_lower_right As Byte


Dim findpoint(4), row((findarea * 2 + 9), 4) As Integer
Dim diviceresult((findarea * 2 + 1), 4), biggest(4), toaddx, toaddy, tempx((findarea * 2 + 1)), tempy((findarea * 2 + 1)) As Double
Dim pp As Long
Dim Point(2, 2), NewColor As Integer
Dim middlesave() As Integer
Dim num_of_point As Integer
Dim Go_on As Boolean
Dim iArray() As Byte
Dim fDraw As New FastDrawing
'scanarea = Combo1
pp = 1
scanarea = 10

start_time = Timer

    fDraw.GetImageData Picture1, iArray()

num_of_point = 0


For x = scanarea To Picture1.ScaleWidth - scanarea * 2
    For y = scanarea To Picture1.ScaleHeight - scanarea * 2
        Go_on = True
        l = 1
        For k = 1 To num_of_point / 2
            If (((middlesave(l) - findarea) < x) And ((middlesave(l) + findarea) > x) And ((middlesave(l + 1) - findarea) < y) And ((middlesave(l + 1) + findarea) > y)) Then
                Go_on = False
            End If
            l = l + 2
        Next
        
        If Go_on = True Then
            
            pp = pp + 1


        point_upper_left = iArray(1, x, y)
         point_upper_right = iArray(1, x + scanarea, y)
            point_lower_left = iArray(1, x, y + scanarea)
            point_lower_right = iArray(1, x + scanarea, y + scanarea)
  
            If (point_upper_left < 100) And (point_upper_right > 200) And (point_lower_left > 200) And (point_lower_right < 100) Then

            For i = 1 To (findarea * 2 + 8)
            
            
        row(i, 1) = iArray(1, x + ((findarea + 5) - i), y - findarea)
        row(i, 2) = iArray(1, x - findarea, y + (findarea + 5) - i)
        row(i, 3) = iArray(1, x + (i - (findarea + 5)), y + findarea)
        row(i, 4) = iArray(1, x + findarea, y + i - (findarea + 5))
 
            Next
            For j = 1 To 4
              biggest(j) = 0
              For i = 1 To (findarea * 2 + 1)
              diviceresult(i, j) = (row(i, j) + row(i + 1, j) + row(i + 2, j) + row(i + 3, j)) / (row(i + 5, j) + row(i + 6, j) + row(i + 7, j) + row(i + 8, j))
        
                
              If diviceresult(i, j) > biggest(j) Then
                biggest(j) = diviceresult(i, j)
                findpoint(j) = i - (findarea + 1)
        
              End If
              Next
            Next
            
            Point(1, 1) = x - findpoint(1)
            Point(1, 2) = y - findarea
            Point(2, 1) = x - findarea
            Point(2, 2) = y - findpoint(2)
       
        toaddx = (Point(1, 1) - (x + findpoint(3))) / (findarea * 2)
        toaddy = (Point(2, 2) - (y + findpoint(4))) / (findarea * 2)
       
       
        tempx(1) = toaddx
        For i = 1 To (findarea * 2)
       
            tempx(i + 1) = tempx(i) + toaddx
        Next
        
        tempy(1) = toaddy
        For i = 1 To (findarea * 2)
       
            tempy(i + 1) = tempy(i) + toaddy
            For j = 1 To (findarea * 2)
                If Point(2, 1) + i = Point(1, 1) - Int(tempx(j)) And Point(1, 2) + j = Point(2, 2) - Int(tempy(i)) Then
           
                        num_of_point = num_of_point + 2
                        ReDim Preserve middlesave(num_of_point)
                        middlesave(num_of_point - 1) = Point(2, 1) + i
                        middlesave(num_of_point) = Point(1, 2) + j
                        
                        j = (findarea * 2)
                
                    End If
                Next
            Next

            

            
            ElseIf (point_upper_left > 200) And (point_upper_right < 100) And (point_lower_left < 100) And (point_lower_right > 200) Then
'            Label7.Caption = "Ha ah!! find a corner white black"
'            Label7.BackColor = &H80C0FF
            For i = 1 To (findarea * 2 + 8)
                
                row(i, 1) = iArray(1, x + (i - (findarea + 5)), y - findarea)
                row(i, 2) = iArray(1, x - findarea, y + i - (findarea + 5))
                row(i, 3) = iArray(1, x + ((findarea + 5) - i), y + findarea)
                row(i, 4) = iArray(1, x + findarea, y + (findarea + 5) - i)
  Next
                    
            For j = 1 To 4
                biggest(j) = 0
              For i = 1 To (findarea * 2 + 1)
              diviceresult(i, j) = (row(i, j) + row(i + 1, j) + row(i + 2, j) + row(i + 3, j)) / (row(i + 5, j) + row(i + 6, j) + row(i + 7, j) + row(i + 8, j))
        

                
              If diviceresult(i, j) > biggest(j) Then
              biggest(j) = diviceresult(i, j)
              findpoint(j) = i - (findarea + 1)

              End If
              Next
            Next
'
            Point(1, 1) = x + findpoint(1)
            Point(1, 2) = y - findarea
            Point(2, 1) = x - findarea
            Point(2, 2) = y + findpoint(2)
'
            
        toaddx = (Point(1, 1) - (x - findpoint(3))) / (findarea * 2)
        toaddy = (Point(2, 2) - (y - findpoint(4))) / (findarea * 2)
       
        tempx(1) = toaddx
        For i = 1 To (findarea * 2)
          '  SetPixelV Picture1.hDC, Point(1, 1) - Int(tempx(i)), Point(1, 2) + i, RGB(Pointsave(1), 200, 0)
            tempx(i + 1) = tempx(i) + toaddx
        Next
        
        tempy(1) = toaddy
        For i = 1 To (findarea * 2)
        '    SetPixelV Picture1.hDC, Point(2, 1) + i, Point(2, 2) - Int(tempy(i)), RGB(Pointsave(2), 200, 0)
            tempy(i + 1) = tempy(i) + toaddy
            For j = 1 To (findarea * 2)
                If Point(2, 1) + i = Point(1, 1) - Int(tempx(j)) And Point(1, 2) + j = Point(2, 2) - Int(tempy(i)) Then
                        
                        num_of_point = num_of_point + 2
                        ReDim Preserve middlesave(num_of_point)
                        middlesave(num_of_point - 1) = Point(2, 1) + i
                        middlesave(num_of_point) = Point(1, 2) + j
                        
                        j = (findarea * 2)

                    End If
                Next
            Next
            
            Else
                
                y = y + 2
                
            End If
     
        End If
        
    Next y
    
    
Next x

l = 1

For k = 1 To num_of_point / 2

    List1.AddItem " Hit " & middlesave(l) & "  " & middlesave(l + 1)
   
   
    iArray(2, middlesave(l) - 1, middlesave(l + 1) - 1) = 250
    iArray(2, middlesave(l) - 1, middlesave(l + 1)) = 250
    iArray(2, middlesave(l) - 1, middlesave(l + 1) + 1) = 250
    iArray(2, middlesave(l), middlesave(l + 1) - 1) = 250
    iArray(2, middlesave(l), middlesave(l + 1)) = 250
    iArray(2, middlesave(l), middlesave(l + 1) + 1) = 250
    iArray(2, middlesave(l) + 1, middlesave(l + 1) - 1) = 250
    iArray(2, middlesave(l) + 1, middlesave(l + 1)) = 250
    iArray(2, middlesave(l) + 1, middlesave(l + 1) + 1) = 250
    
    iArray(2, middlesave(l) - 1, middlesave(l + 1) - 1) = 0
    iArray(2, middlesave(l) - 1, middlesave(l + 1)) = 0
    iArray(2, middlesave(l) - 1, middlesave(l + 1) + 1) = 0
    iArray(2, middlesave(l), middlesave(l + 1) - 1) = 0
    iArray(2, middlesave(l), middlesave(l + 1)) = 0
    iArray(2, middlesave(l), middlesave(l + 1) + 1) = 0
    iArray(2, middlesave(l) + 1, middlesave(l + 1) - 1) = 0
    iArray(2, middlesave(l) + 1, middlesave(l + 1)) = 0
    iArray(2, middlesave(l) + 1, middlesave(l + 1) + 1) = 0
    
    iArray(2, middlesave(l) - 1, middlesave(l + 1) - 1) = 0
    iArray(2, middlesave(l) - 1, middlesave(l + 1)) = 0
    iArray(2, middlesave(l) - 1, middlesave(l + 1) + 1) = 0
    iArray(2, middlesave(l), middlesave(l + 1) - 1) = 0
    iArray(2, middlesave(l), middlesave(l + 1)) = 0
    iArray(2, middlesave(l), middlesave(l + 1) + 1) = 0
    iArray(2, middlesave(l) + 1, middlesave(l + 1) - 1) = 0
    iArray(2, middlesave(l) + 1, middlesave(l + 1)) = 0
    iArray(2, middlesave(l) + 1, middlesave(l + 1) + 1) = 0
   
    l = l + 2
Next

fDraw.SetImageData Picture1, iArray()

List1.AddItem " passes " & pp

Text2.Text = Format$(Timer - start_time, "0.000")
End Sub
2 methode click erkennung
Code:
Sub Form_Load()

'Dim findarea As Integer


Dim NewColor As Long
Dim point1, point2, point3, point4 As Long
Dim r, g, b As Integer
Dim r1, r2, r3, r4, g1, g2, g3, g4, b1, b2, b3, b4 As Integer
Dim red_save As Integer
Dim i, j As Integer

Dim dwMilliseconds As Long

Dim findpoint(4), Pointsave(4) As Integer
Dim diviceresult((findarea * 2 + 1), 4), biggest(4), toaddx, toaddy, tempx((findarea * 2 + 1)), tempy((findarea * 2 + 1)) As Double
Dim row((findarea * 2 + 9), 4) As Long
Dim Point(5, 2) As Integer

Dim iArray() As Byte
Dim MousePoint As POINTAPI
'Show and refresh the form
Me.Show
Me.Refresh
'Instantiate a FastDrawing class
    Dim fDraw As New FastDrawing
    'Get the image information
    fDraw.GetImageData Picture1, iArray()

Do 'Dalam 1 saat click... Do Loop ini akan ulang lebih dari 10kali

'Ada cara lain yg x guna Do Loop
'Sila lihat how to highlight control


    'Get the position of the cursor
    GetCursorPos MousePoint
    'Convert the point to our forms coordinates
    ScreenToClient Me.hwnd, MousePoint
    'Show the position
    lblXPosition.Caption = "X: " & MousePoint.x
    lblYposition.Caption = "Y: " & MousePoint.y
       
    
    'See if there are any mouse clicks
    
    
    
    If (GetKeyState(vbKeyLButton) And KEY_DOWN And MousePoint.x < Picture1.ScaleWidth And MousePoint.y < Picture1.ScaleHeight And MousePoint.y > 0 And MousePoint.x > 0) Then
        List1.Clear
           
      
        lblLeftClick.Caption = "Left Mouse Button Clicked"
        r = iArray(2, MousePoint.x, MousePoint.y - findarea)
        b = iArray(1, MousePoint.x, MousePoint.y - findarea)
        g = iArray(0, MousePoint.x, MousePoint.y - findarea)
        Label4.Caption = "Red: " & r
        Label5.Caption = "Blue: " & b
        Label6.Caption = "Green: " & g
                    
        
        r1 = iArray(2, MousePoint.x - findarea, MousePoint.y - findarea)
        b1 = iArray(1, MousePoint.x - findarea, MousePoint.y - findarea)
        g1 = iArray(0, MousePoint.x - findarea, MousePoint.y - findarea)
        point1_R.Caption = "Red: " & r1
        point1_G.Caption = "Blue: " & b1
        point1_B.Caption = "Green: " & g1
        point1X.Caption = "X: " & MousePoint.x - findarea
        point1Y.Caption = "Y: " & MousePoint.y - findarea
        'SetPixelV Picture1.hDC, MousePoint.X - 20, MousePoint.Y - 20, RGB(0, 200, 0)
        
         r2 = iArray(2, MousePoint.x + findarea, MousePoint.y - findarea)
        b2 = iArray(1, MousePoint.x + findarea, MousePoint.y - findarea)
        g2 = iArray(0, MousePoint.x + findarea, MousePoint.y - findarea)
        point2_R.Caption = "Red: " & r2
        point2_G.Caption = "Blue: " & b2
        point2_B.Caption = "Green: " & g2
        point2X.Caption = "X: " & MousePoint.x + findarea
        point2Y.Caption = "Y: " & MousePoint.y - findarea
        'SetPixelV Picture1.hDC, MousePoint.X + 20, MousePoint.Y - 20, RGB(0, 200, 0)
        
        r3 = iArray(2, MousePoint.x - findarea, MousePoint.y + findarea)
        b3 = iArray(1, MousePoint.x - findarea, MousePoint.y + findarea)
        g3 = iArray(0, MousePoint.x - findarea, MousePoint.y + findarea)
        point3_R.Caption = "Red: " & r3
        point3_G.Caption = "Blue: " & b3
        point3_B.Caption = "Green: " & g3
        point3X.Caption = "X: " & MousePoint.x - findarea
        point3Y.Caption = "Y: " & MousePoint.y + findarea
        'SetPixelV Picture1.hDC, MousePoint.X - 20, MousePoint.Y + 20, RGB(0, 200, 0)
        
        r4 = iArray(2, MousePoint.x + findarea, MousePoint.y + findarea)
        b4 = iArray(1, MousePoint.x + findarea, MousePoint.y + findarea)
        g4 = iArray(0, MousePoint.x + findarea, MousePoint.y + findarea)
        point4_R.Caption = "Red: " & r4
        point4_G.Caption = "Blue: " & b4
        point4_B.Caption = "Green: " & g4
        point4X.Caption = "X: " & MousePoint.x + findarea
        point4Y.Caption = "Y: " & MousePoint.y + findarea
        'SetPixelV Picture1.hDC, MousePoint.X + 20, MousePoint.Y + 20, RGB(0, 200, 0)
        
        If (r1 < 100) And (r2 > 200) And (r3 > 200) And (r4 < 100) Then
        Label7.Caption = "Ha ah!! find a corner black white"
        Label7.BackColor = &H80C0FF
         
        For i = 1 To (findarea * 2 + 8)
        row(i, 1) = iArray(1, MousePoint.x + ((findarea + 5) - i), MousePoint.y - findarea)
        row(i, 2) = iArray(1, MousePoint.x - findarea, MousePoint.y + (findarea + 5) - i)
        row(i, 3) = iArray(1, MousePoint.x + (i - (findarea + 5)), MousePoint.y + findarea)
        row(i, 4) = iArray(1, MousePoint.x + findarea, MousePoint.y + i - (findarea + 5))
'            row(i, 1) = GetPixel(Picture1.hDC, MousePoint.x + ((findarea + 5) - i), MousePoint.y - findarea) Mod 256
'            row(i, 2) = GetPixel(Picture1.hDC, MousePoint.x - findarea, MousePoint.y + (findarea + 5) - i) Mod 256
'            row(i, 3) = GetPixel(Picture1.hDC, MousePoint.x + (i - (findarea + 5)), MousePoint.y + findarea) Mod 256
'            row(i, 4) = GetPixel(Picture1.hDC, MousePoint.x + findarea, MousePoint.y + i - (findarea + 5)) Mod 256
        Next
        For j = 1 To 4
          biggest(j) = 0
          For i = 1 To (findarea * 2 + 1)
          diviceresult(i, j) = (row(i, j) + row(i + 1, j) + row(i + 2, j) + row(i + 3, j)) / (row(i + 5, j) + row(i + 6, j) + row(i + 7, j) + row(i + 8, j))
    
          List1.AddItem i - (findarea + 1) & " " & row(i + 4, j) & " " & diviceresult(i, j)
            
          If diviceresult(i, j) > biggest(j) Then
            biggest(j) = diviceresult(i, j)
            findpoint(j) = i - (findarea + 1)
            Pointsave(j) = row(i + 4, j)
          End If
          Next
        Next
        
        Point(1, 1) = MousePoint.x - findpoint(1)
        Point(1, 2) = MousePoint.y - findarea
        Point(2, 1) = MousePoint.x - findarea
        Point(2, 2) = MousePoint.y - findpoint(2)
        Point(3, 1) = MousePoint.x + findpoint(3)
        Point(3, 2) = MousePoint.y + findarea
        Point(4, 1) = MousePoint.x + findarea
        Point(4, 2) = MousePoint.y + findpoint(4)
        
        iArray(1, Point(1, 1), Point(1, 2)) = 200
        iArray(1, Point(2, 1), Point(2, 2)) = 200
        iArray(1, Point(3, 1), Point(3, 2)) = 200
        iArray(1, Point(4, 1), Point(4, 2)) = 200
           
'
'        SetPixelV Picture1.hDC, Point(1, 1), Point(1, 2), RGB(Pointsave(1), 200, 0)
'        SetPixelV Picture1.hDC, Point(2, 1), Point(2, 2), RGB(Pointsave(2), 200, 0)
'        SetPixelV Picture1.hDC, Point(3, 1), Point(3, 2), RGB(Pointsave(3), 200, 0)
'        SetPixelV Picture1.hDC, Point(4, 1), Point(4, 2), RGB(Pointsave(4), 200, 0)
       
         toaddx = (Point(1, 1) - Point(3, 1)) / (findarea * 2)
        toaddy = (Point(2, 2) - Point(4, 2)) / (findarea * 2)
       
        tempx(1) = toaddx
        For i = 1 To (findarea * 2)
          iArray(1, Point(1, 1) - Int(tempx(i)), Point(1, 2) + i) = 200
           ' SetPixelV Picture1.hDC, Point(1, 1) - Int(tempx(i)), Point(1, 2) + i, RGB(Pointsave(1), 200, 0)
            tempx(i + 1) = tempx(i) + toaddx
        Next
        
        tempy(1) = toaddy
        For i = 1 To (findarea * 2)
        iArray(1, Point(2, 1) + i, Point(2, 2) - Int(tempy(i))) = 200
           ' SetPixelV Picture1.hDC, Point(2, 1) + i, Point(2, 2) - Int(tempy(i)), RGB(Pointsave(2), 200, 0)
            tempy(i + 1) = tempy(i) + toaddy
            For j = 1 To (findarea * 2)
                If Point(2, 1) + i = Point(1, 1) - Int(tempx(j)) And Point(1, 2) + j = Point(2, 2) - Int(tempy(i)) Then
                    Point(5, 1) = Point(2, 1) + i
                    Point(5, 2) = Point(1, 2) + j
                    List1.AddItem " Hit " & Point(5, 1) & "  " & Point(5, 2)
                    iArray(2, Point(5, 1) - 1, Point(5, 2) - 1) = 250
                    iArray(2, Point(5, 1) - 1, Point(5, 2)) = 250
                    iArray(2, Point(5, 1) - 1, Point(5, 2) + 1) = 250
                    iArray(2, Point(5, 1), Point(5, 2) - 1) = 250
                    iArray(2, Point(5, 1), Point(5, 2)) = 250
                    iArray(2, Point(5, 1), Point(5, 2) + 1) = 250
                    iArray(2, Point(5, 1) + 1, Point(5, 2) - 1) = 250
                    iArray(2, Point(5, 1) + 1, Point(5, 2)) = 250
                    iArray(2, Point(5, 1) + 1, Point(5, 2) + 1) = 250
                    
                    iArray(1, Point(5, 1) - 1, Point(5, 2) - 1) = 0
                    iArray(1, Point(5, 1) - 1, Point(5, 2)) = 0
                    iArray(1, Point(5, 1) - 1, Point(5, 2) + 1) = 0
                    iArray(1, Point(5, 1), Point(5, 2) - 1) = 0
                    iArray(1, Point(5, 1), Point(5, 2)) = 0
                    iArray(1, Point(5, 1), Point(5, 2) + 1) = 0
                    iArray(1, Point(5, 1) + 1, Point(5, 2) - 1) = 0
                    iArray(1, Point(5, 1) + 1, Point(5, 2)) = 0
                    iArray(1, Point(5, 1) + 1, Point(5, 2) + 1) = 0
                    
                    iArray(0, Point(5, 1) - 1, Point(5, 2) - 1) = 0
                    iArray(0, Point(5, 1) - 1, Point(5, 2)) = 0
                    iArray(0, Point(5, 1) - 1, Point(5, 2) + 1) = 0
                    iArray(0, Point(5, 1), Point(5, 2) - 1) = 0
                    iArray(0, Point(5, 1), Point(5, 2)) = 0
                    iArray(0, Point(5, 1), Point(5, 2) + 1) = 0
                    iArray(0, Point(5, 1) + 1, Point(5, 2) - 1) = 0
                    iArray(0, Point(5, 1) + 1, Point(5, 2)) = 0
                    iArray(2, Point(5, 1) + 1, Point(5, 2) + 1) = 0
'                    SetPixelV Picture1.hDC, Point(5, 1) - 1, Point(5, 2) - 1, RGB(250, 0, 0)
'                    SetPixelV Picture1.hDC, Point(5, 1) - 1, Point(5, 2), RGB(250, 0, 0)
'                    SetPixelV Picture1.hDC, Point(5, 1) - 1, Point(5, 2) + 1, RGB(250, 0, 0)
'                    SetPixelV Picture1.hDC, Point(5, 1), Point(5, 2) - 1, RGB(250, 0, 0)
'                    SetPixelV Picture1.hDC, Point(5, 1), Point(5, 2), RGB(250, 0, 0)
'                    SetPixelV Picture1.hDC, Point(5, 1), Point(5, 2) + 1, RGB(250, 0, 0)
'                    SetPixelV Picture1.hDC, Point(5, 1) + 1, Point(5, 2) - 1, RGB(250, 0, 0)
'                    SetPixelV Picture1.hDC, Point(5, 1) + 1, Point(5, 2), RGB(250, 0, 0)
'                    SetPixelV Picture1.hDC, Point(5, 1) + 1, Point(5, 2) + 1, RGB(250, 0, 0)
            fDraw.SetImageData Picture1, iArray()
                End If
            Next
        Next
        
        End If
        
        If (r1 > 200) And (r2 < 100) And (r3 < 100) And (r4 > 200) Then
        Label7.Caption = "Ha ah!! find a corner white black"
        Label7.BackColor = &H80C0FF
        For i = 1 To (findarea * 2 + 8)
        row(i, 1) = iArray(1, MousePoint.x + (i - (findarea + 5)), MousePoint.y - findarea)
        row(i, 2) = iArray(1, MousePoint.x - findarea, MousePoint.y + i - (findarea + 5))
        row(i, 3) = iArray(1, MousePoint.x + ((findarea + 5) - i), MousePoint.y + findarea)
        row(i, 4) = iArray(1, MousePoint.x + findarea, MousePoint.y + (findarea + 5) - i)
'        row(i, 1) = GetPixel(Picture1.hDC, MousePoint.x + (i - (findarea + 5)), MousePoint.y - findarea) Mod 256
'        row(i, 2) = GetPixel(Picture1.hDC, MousePoint.x - findarea, MousePoint.y + i - (findarea + 5)) Mod 256
'        row(i, 3) = GetPixel(Picture1.hDC, MousePoint.x + ((findarea + 5) - i), MousePoint.y + findarea) Mod 256
'        row(i, 4) = GetPixel(Picture1.hDC, MousePoint.x + findarea, MousePoint.y + (findarea + 5) - i) Mod 256
        Next
                
        For j = 1 To 4
            biggest(j) = 0
          For i = 1 To (findarea * 2 + 1)
          diviceresult(i, j) = (row(i, j) + row(i + 1, j) + row(i + 2, j) + row(i + 3, j)) / (row(i + 5, j) + row(i + 6, j) + row(i + 7, j) + row(i + 8, j))
    
          List1.AddItem i - (findarea + 1) & " " & row(i + 4, j) & " " & diviceresult(i, j)
            
          If diviceresult(i, j) > biggest(j) Then
          biggest(j) = diviceresult(i, j)
          findpoint(j) = i - (findarea + 1)
          Pointsave(j) = row(i + 4, j)
          End If
          Next
        Next
        
        Point(1, 1) = MousePoint.x + findpoint(1)
        Point(1, 2) = MousePoint.y - findarea
        Point(2, 1) = MousePoint.x - findarea
        Point(2, 2) = MousePoint.y + findpoint(2)
        Point(3, 1) = MousePoint.x - findpoint(3)
        Point(3, 2) = MousePoint.y + findarea
        Point(4, 1) = MousePoint.x + findarea
        Point(4, 2) = MousePoint.y - findpoint(4)
        
                iArray(1, Point(1, 1), Point(1, 2)) = 200
        iArray(1, Point(2, 1), Point(2, 2)) = 200
        iArray(1, Point(3, 1), Point(3, 2)) = 200
        iArray(1, Point(4, 1), Point(4, 2)) = 200
'
'        SetPixelV Picture1.hDC, Point(1, 1), Point(1, 2), RGB(Pointsave(1), 200, 0)
'        SetPixelV Picture1.hDC, Point(2, 1), Point(2, 2), RGB(Pointsave(2), 200, 0)
'        SetPixelV Picture1.hDC, Point(3, 1), Point(3, 2), RGB(Pointsave(3), 200, 0)
'        SetPixelV Picture1.hDC, Point(4, 1), Point(4, 2), RGB(Pointsave(4), 200, 0)
'
        toaddx = (Point(1, 1) - Point(3, 1)) / (findarea * 2)
        toaddy = (Point(2, 2) - Point(4, 2)) / (findarea * 2)
       
        tempx(1) = toaddx
        For i = 1 To (findarea * 2)
                      iArray(1, Point(1, 1) - Int(tempx(i)), Point(1, 2) + i) = 200

            'SetPixelV Picture1.hDC, Point(1, 1) - Int(tempx(i)), Point(1, 2) + i, RGB(Pointsave(1), 200, 0)
            tempx(i + 1) = tempx(i) + toaddx
        Next
        
        tempy(1) = toaddy
        For i = 1 To (findarea * 2)
         iArray(1, Point(2, 1) + i, Point(2, 2) - Int(tempy(i))) = 200
           
           ' SetPixelV Picture1.hDC, Point(2, 1) + i, Point(2, 2) - Int(tempy(i)), RGB(Pointsave(2), 200, 0)
            tempy(i + 1) = tempy(i) + toaddy
            For j = 1 To (findarea * 2)
                If Point(2, 1) + i = Point(1, 1) - Int(tempx(j)) And Point(1, 2) + j = Point(2, 2) - Int(tempy(i)) Then
                    Point(5, 1) = Point(2, 1) + i
                    Point(5, 2) = Point(1, 2) + j
                    List1.AddItem " Hit " & Point(5, 1) & "  " & Point(5, 2)
'                    SetPixelV Picture1.hDC, Point(5, 1) - 1, Point(5, 2) - 1, RGB(250, 0, 0)
'                    SetPixelV Picture1.hDC, Point(5, 1) - 1, Point(5, 2), RGB(250, 0, 0)
'                    SetPixelV Picture1.hDC, Point(5, 1) - 1, Point(5, 2) + 1, RGB(250, 0, 0)
'                    SetPixelV Picture1.hDC, Point(5, 1), Point(5, 2) - 1, RGB(250, 0, 0)
'                    SetPixelV Picture1.hDC, Point(5, 1), Point(5, 2), RGB(250, 0, 0)
'                    SetPixelV Picture1.hDC, Point(5, 1), Point(5, 2) + 1, RGB(250, 0, 0)
'                    SetPixelV Picture1.hDC, Point(5, 1) + 1, Point(5, 2) - 1, RGB(250, 0, 0)
'                    SetPixelV Picture1.hDC, Point(5, 1) + 1, Point(5, 2), RGB(250, 0, 0)
'                    SetPixelV Picture1.hDC, Point(5, 1) + 1, Point(5, 2) + 1, RGB(250, 0, 0)
                    iArray(2, Point(5, 1) - 1, Point(5, 2) - 1) = 250
                    iArray(2, Point(5, 1) - 1, Point(5, 2)) = 250
                    iArray(2, Point(5, 1) - 1, Point(5, 2) + 1) = 250
                    iArray(2, Point(5, 1), Point(5, 2) - 1) = 250
                    iArray(2, Point(5, 1), Point(5, 2)) = 250
                    iArray(2, Point(5, 1), Point(5, 2) + 1) = 250
                    iArray(2, Point(5, 1) + 1, Point(5, 2) - 1) = 250
                    iArray(2, Point(5, 1) + 1, Point(5, 2)) = 250
                    iArray(2, Point(5, 1) + 1, Point(5, 2) + 1) = 250
                    
                    iArray(1, Point(5, 1) - 1, Point(5, 2) - 1) = 0
                    iArray(1, Point(5, 1) - 1, Point(5, 2)) = 0
                    iArray(1, Point(5, 1) - 1, Point(5, 2) + 1) = 0
                    iArray(1, Point(5, 1), Point(5, 2) - 1) = 0
                    iArray(1, Point(5, 1), Point(5, 2)) = 0
                    iArray(1, Point(5, 1), Point(5, 2) + 1) = 0
                    iArray(1, Point(5, 1) + 1, Point(5, 2) - 1) = 0
                    iArray(1, Point(5, 1) + 1, Point(5, 2)) = 0
                    iArray(1, Point(5, 1) + 1, Point(5, 2) + 1) = 0
                    
                    iArray(0, Point(5, 1) - 1, Point(5, 2) - 1) = 0
                    iArray(0, Point(5, 1) - 1, Point(5, 2)) = 0
                    iArray(0, Point(5, 1) - 1, Point(5, 2) + 1) = 0
                    iArray(0, Point(5, 1), Point(5, 2) - 1) = 0
                    iArray(0, Point(5, 1), Point(5, 2)) = 0
                    iArray(0, Point(5, 1), Point(5, 2) + 1) = 0
                    iArray(0, Point(5, 1) + 1, Point(5, 2) - 1) = 0
                    iArray(0, Point(5, 1) + 1, Point(5, 2)) = 0
                    iArray(2, Point(5, 1) + 1, Point(5, 2) + 1) = 0
                    
                    fDraw.SetImageData Picture1, iArray()
                End If
            Next
        Next
        End If
        
        Text2.Text = "The time is " & Time$   ' display the current time
        Sleep 250 ' 250 milliseconds = 0.25 seconds to delay
        Text1.Text = "The time is " & Time$ ' this time will be 0.25 seconds later
    Else
        lblLeftClick.Caption = ""
        Label7.Caption = ""
        Label7.BackColor = &H8000000B
    End If
    
    'get the right button
    If (GetKeyState(vbKeyRButton) And KEY_DOWN) Then
        lblRightClick.Caption = "Right Mouse Button Clicked"
    Else
        lblRightClick.Caption = ""
    End If
    'Get the middle button
    If (GetKeyState(vbKeyMButton) And KEY_DOWN) Then
        lblMButton.Caption = "Middle Button Clicked"
    Else
        lblMButton.Caption = ""
    End If
    
      fDraw.SetImageData Picture1, iArray()
    DoEvents

Loop Until TimeToEnd
End Sub
 
ich habe den Fehler gefunden

ich habe in der 2. Funktion das Bitmap jedesmal noch mal gesetzt obwohl der mauszeiger aus der reichweite des bildes war und so wurde beim druecken des buttons das bild neu geschrieben

MFG
 

Neue Beiträge

Zurück