seit 2007 ist meine rasenrobo nun im Einsatz. Als letztes habe ich nochmal die Aufzeichnung seiner Route mit einer wlan-Camera verbessert. Anbei 3 Screenshots von heute nachmittag. Der erste kurz nach dem Start, der zweite nach getaner Arbeit, 1h und 45 min später. Das 3. Bild ist ein Ausschnitt kurz nach dem Start. Die Erkennung des rasenrobos ist ziemlich robust, z.B. sowohl im Schatten als auch direkten Sonnenschein. Programmiert ist die Bildverarbeitung mit Visual Basic 6. Rechts ist auf dem Screenshot das Programm mit dem die Telemetrie-Daten vom rasenrobo angezeigt werden (Spannung, Motorstrom, Drehzahl vom Rasenmähermotor, die 4 Schleifensensoren, Kurs, Kurssoll, Uhrzeit und graphisch die Fahrstecke vom rasenobo nach Odometrie(leider mit Drift)). Der rasenrobo wendet an der Begrenzungsschleife im wesentlichen nach dem Zufallsprinzip. Es ist aber auch möglich ihm ein bestimmtes Kurssoll vom Computer aus vorzugeben.
Für den den´s interessiert, der Code für die Auswertung der wlan-Camera. Das wesentliche findet sich in der Sub Bildanalyse:
Code:
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 Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Dim PicBits() As Byte, PicInfo As BITMAP, PicBits2() As Byte
Dim Cnt As Long, BytesPerLine As Long
Dim x As Long, Y As Long, M1 As Long
Dim rot As Integer, grün As Integer, blau As Integer, rotalt As Integer, grünalt As Integer, blaualt As Integer
Dim ErgebnisIR As Long
Dim smax As Integer, xmax As Integer, ymax As Integer, smin As Integer, xmin As Integer, ymin As Integer, xminalt As Integer, yminalt As Integer, xmaxalt As Integer, ymaxalt As Integer, mousex As Integer, mousey As Integer, xmitalt As Integer, ymitalt As Integer
Dim Pic(600, 600) As Integer, picalt(600, 600) As Integer, i As Integer, k As Integer, ii As Integer, kk As Integer
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Sub Command1_Click()
Picture2.Cls
End Sub
Private Sub Command2_Click()
SavePicture Picture3.Image, "C:\efilm\picture" + Str(Int(Timer)) + ".bmp"
End Sub
Private Sub Command3_Click()
On Error Resume Next
Close #1: Open "C:\efilm\roboter2.txt" For Input As #2:
Do
Input #2, A$: i1 = InStr(A$, vbTab): xmit = Left(A$, i1 - 1): ymit = Mid(A$, i1 + 1)
If i1 > 0 And xmit > 0 And ymit > 0 Then
If Abs(ymit - ymitalt) < 10 And Abs(xmit - xmitalt) < 10 Then
Picture2.Circle (xmit, ymit), 1, vbGreen
Picture2.Line (xmit, ymit)-(xmitalt, ymitalt), vbGreen
End If: xmitalt = xmit: ymitalt = ymit
End If
Loop Until EOF(2): Close #2: Open "C:\efilm\roboter2.txt" For Append As #1: Print #1, "Start" & Date
End Sub
Private Sub Command4_Click()
If MsgBox("Löschen?", vbOKCance) = vbOK Then Close: Kill ("C:\efilm\roboter2.txt")
Open "C:\efilm\roboter2.txt" For Append As #1: Print #1, "Start" & Date
End Sub
Private Sub Form_Load()
Set fs = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
'WebBrowser1.Navigate2 "http:\\www.t-online.de"
WebBrowser1.Navigate2 "http://192.168.1.20/img/main.cgi?next_file=main.htm"
GetObject Picture1.Image, Len(PicInfo), PicInfo
BytesPerLine = (PicInfo.bmWidth * 2 + 3) And &HFFFFFFFC
ReDim PicBits(1 To BytesPerLine * PicInfo.bmHeight) As Byte
ReDim PicBits2(1 To UBound(PicBits)) As Byte
Picture2.FillColor = vbGreen: Picture2.FillStyle = vbFSSolid
Open "C:\efilm\roboter2.txt" For Append As #1: Print #1, "Start" & Date
If Err.Number <> 0 Then MsgBox "Error :" & Err.Description 'Display error message
Timer1.Interval = 200: Timer1.Enabled = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
Close #1
End Sub
Private Sub Picture3_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
mousex = x: mousey = Y
End Sub
Private Sub Timer1_Timer()
Bildanalyse
End Sub
Sub Bildanalyse()
t = Timer: DoEvents
ErgebnisIR = FindWindow(0&, "Form2")
Set Picture1.Picture = CaptureWindow(ErgebnisIR, False, 5, 25, 500, 330)
GetBitmapBits Picture1.Image, UBound(PicBits), PicBits(1)
Dim S1(600, 600) As Integer, s2(600, 600) As Integer, S3(600, 600) As Integer, S4(600, 600) As Integer, S5(600, 600) As Integer
smax = 0: xmax = 1: ymax = 1: smin = 0: xmin = 1: ymin = 1: xmit = -1: ymit = -1
On Error Resume Next
For k = 0 To PicInfo.bmHeight - 1: For i = 0 To (PicInfo.bmWidth - 1)
blau = PicBits((k * (PicInfo.bmWidth) + i) * 2 + 1) And 31 ' 1+2+4+8+16
rot = Int(PicBits((k * (PicInfo.bmWidth) + i) * 2 + 2) / 8) '128+64+32+16+8
grün = (PicBits((k * (PicInfo.bmWidth) + i) * 2 + 2) And 7) * 4 + Int(PicBits((k * (PicInfo.bmWidth) + i) * 2 + 1) / 64) '1+2+4+128+64
rotalt = Int(picalt(i, k) / &H400): grünalt = Int(picalt(i, k) / &H20) And &H1F: blaualt = picalt(i, k) And &H1F
picalt(i, k) = rot * &H400 + grün * &H20 + blau
If mousex = i And mousey = k Then Text1.Text = mousex & " " & mousey: Text3.Text = rot: Text4.Text = blau: Text5.Text = grün
S5(i, k) = 3 * blau - (rot + grün) - 3 * blaualt + (rotalt + grünalt)
Next i: Next k
For k = 0 To PicInfo.bmHeight - 1: For i = 0 To (PicInfo.bmWidth - 1)
If S5(i, k) <> 0 Then S1(i, k) = S5(i, k) + (S1(i - 1, k) + S1(i, k - 1)) / 9 * 4
ii = PicInfo.bmWidth - i - 1: kk = PicInfo.bmHeight - k - 1:
If S5(ii, kk) <> 0 Then s2(ii, kk) = S5(ii, kk) + (s2(ii + 1, kk) + s2(ii, kk + 1)) / 9 * 4
Next i: Next k
For k = 0 To PicInfo.bmHeight - 1: For i = 0 To (PicInfo.bmWidth - 1)
S1(i, k) = S1(i, k) + s2(i, k)
If smax < S1(i, k) Then smax = S1(i, k): xmax = i: ymax = k
If smin > S1(i, k) Then smin = S1(i, k): xmin = i: ymin = k
Next i: Next k
If smax < 25 Then xmax = -100: ymax = -300
If smin > -25 Then xmin = -200: ymin = -400
If Abs(ymax - ymin) < 30 And Abs(xmax - xmin) < 30 Then
ymit = (ymax + ymin) / 2: xmit = (xmax + xmin) / 2
x = 0: Y = 0: M1 = 0
For i = xmit - 15 To xmit + 15: For k = ymit - 15 To ymit + 15
x = x + i * CLng(Abs(S1(i, k))): Y = Y + k * CLng(Abs(S1(i, k)))
M1 = M1 + CLng(Abs(S1(i, k)))
Next: Next: xmit = CInt(x / M1): ymit = CInt(Y / M1)
xx4:
End If
Text2 = xmax & " " & ymax & " " & xmit & " " & ymit & " " & smax & " " & smin: Text2.Refresh
If Abs(ymit - ymitalt) < 10 And Abs(xmit - xmitalt) < 10 Then
Picture2.Circle (xmit, ymit), 1, vbGreen
Picture2.Line (xmit, ymit)-(xmitalt, ymitalt), vbGreen
If xmit > 0 And ymit > 0 Then Print #1, xmit & vbTab & ymit
End If: xmitalt = xmit: ymitalt = ymit
GetBitmapBits Picture2.Image, UBound(PicBits2), PicBits2(1)
For Cnt = 1 To UBound(PicBits)
If PicBits2(Cnt) = 7 Or PicBits2(Cnt) = 224 Then PicBits(Cnt) = PicBits2(Cnt)
Next
SetBitmapBits Picture3.Image, UBound(PicBits), PicBits(1): Picture3.Refresh
End Sub
Zitieren
Zitat von homedom
.
Berechtigungen
Lesezeichen