Rasenrobo mit Induktionsschleife, Schaltbilder, Hallsensor

Wenn der Blitz in etwa 10-100 m Umkreis einschlägt hat man vermutlich schon duch die Elektrische Kopplung Probleme und dafür ist es auch sinnvoll den Stecker zu ziehen. Bei einem Einschlag bis etwa 1 km, oder auch nur einem Wolke-Wolke Blitz in der direkten Umgebeung besteht die Gefahr das die Sendespule sich eine hohe Induktionsspannung einfängt und den Generator zerstört.
So oft kommt das aber nicht vor, und da man die Schaltung ja kennt sollte die Reperatur auch nicht so schlimm sein. Sockel für die ICs sollte bei solchen Schaltungen ohnehin selbstverständlich sein.

Moin moin.

Ich habe zwei echte Blitzeinschläge kennengelernt, den einen
sogar aus ca. 25 m Entferhrnung bei offener Terrrassentür
bewundern dürfen.

Dort war ein Blitz in einen Baum eingeschlagen und dann
unten vom Baum in einen Betonzaunpfahl (mit Eisenbewährung
drinne) gewechselt. Neben dem Zaunpfahl verliefen unterirdisch
die Sromversorgungsleitungen einiger Häuser.

Vom Zaunpfahl sind nur die Bewärungseisen geblieben, der Beton
war wech...Die Stromversorgung natürlich auch.

Im 2. Fall Biltz > Baum > Hauswand. Das war ein Bankfialneubau
mit noch nicht voll ausgetrockneten Wänden......Da hat es um die
Stomleitungen herum den Putz von den Wänden geholt. Alle
Leitungen, Steckdosen u.s.w. lagen im Umkreis von ca. 40 cm frei.
Da IBM die AKT`s, Kassen und EDV genau wie wier die
Sicherheitstechnik am Tag vorher dem Kunden übergeben hatten
war das ein sehr schwarzer Tag für die Versicherung.

Wenn so ein Blitz unmittelbar in so eine Inducktionsschleife
schlägt, gräbt der dieselbe extrem schnell aus!

Das wird auch ähnlich technisch genutzt, wenn Erdkabel eine
Beschädigung haben und der genaue Ort nicht geortet werden
kann. Ordentlich Spannung auf die Leitung und die Gehwegplatten
über dem Erdschluss fliegen gut einen 1/2 m hoch. :-) Durfte ich mal bewundern, viel Graben um ne neue Muffe zu setzen, mußten die
Männer nicht mehr!

Gruß Richard

Fehler in Kabeln lassen sich recht gut lokalisieren. Wenns nicht zu lang ist, über die Kapazität: Wenn man das Kabel nicht kennt, sind 100 pF je Meter ein überraschend guter Wert.
Alternativ, vor allem für längere Kabel geht das auch über die Laufzeit von Reflexionen einen HF Signals. Da kann man sogar schon Fehler Erkennen die sonst noch nicht stören.

Joah, für die Laufzeitmessung reicht ein normaler Rechteck- oder Impulsgenerator plus 2-Kanal-Oszi schon aus.

Sigo

Moin moin,

So ein Gerät haben wir in der 4ma, damit machen wir
das Kabel Aufmaß.

Beide Arten eignen sich allerdings besser zur Kablelängen
Messung. Das Kabel müßte an der Schadensstelle also
idialerweise voll durchtrennt sein. Bei einen z.B. Riss und
Fehlerstrom durch Feuchtigkeit wird das schwieriger. Da
ist es oft besser das Kabel an der Schadensstelle durch
Überspannung voll zu kappen und danach die Länge bis
zum "Bruch" zu messen.

Gruß Richard

ich hab mch mal durch den thread hier gewühlt und bin begeistert, wie zuverlässig eure induktionsschleife funktioniert.

ich habe eine frage an euch, die an verschiedenen stellen immer wieder auftaucht, die ich mir aber nicht erklären kann:

welche rolle spielt die hangneigung für die funktion einer induktionschleife?

lassen sich auch flächen mit annähernd 100% steigung mit einer iduktionschleife begrenzen?

viele grüße
dude

Hallo an alle Roboterbastler, mit einem speziellen Gruß an die Rasenmähroboterbauer,

nach längerer Abstinenz mit eigenen Beiträgen (ich schau aber fast täglich ins Forum) möchte ich mal meinen Rasenrobo wieder vorführen. Er ist noch immer, etwa 1 mal pro Woche, im Einsatz, dann natürlich ohne Telemetrie. Für das Video wollte ich aber nicht auf die Telemetrie verzichten.

http://www.youtube.com/watch?v=rW3eaOzx1Oc

Die aufgezeichnete Strecke basiert nur auf Odometrie. Die Bahn des Rasenrobo driftet deshalb nach einiger Zeit aus dem Bild. Die Positionsbestimmung mit Ultraschall ist mir auf Dauer zu aufwendig, war zu Beginn aber eine schöne Spielerei. Hierüber findet sich einiges in dem thread
https://www.roboternetz.de/phpBB2/ze...174&highlight=
screenshot2.jpg zeigt die Bahn des Rasenrobo mit US-Lokalisation.



Viele Grüße

Chrisitian

Hallo
vor Kurzem habe ich meinen Rasenrobo nach der Winterpause wieder in Betrieb genommen und gebe deshalb mal eine kurze Statusmeldung ab. Den Akku und beide Motoren habe ich ausgetausch. Einer der Motoren (RB35) ist zum Schluss heiß gelaufen. Den Betrieb mit 12 Zellen hat er mir nach 3 Jahren übel genommen. Die neuen Motoren sind 540er mit 810:1 Untersetzung (Conrad). Die haben allerdings mehr Strom gezogen als die RB35 weshalb der Motortreiben von dem RN-Board gegrillt wurde. Nach Austausch vom Motortreiber und Anpassen der PWM im Programm verrichtet der Rasenrobo wieder seine Gartenarbeit wie gewohnt. Mit den neuen Akkus werkelt er 1 Stunde und 50 min.
Zur Ortung des Rasenrobo habe ich schon diverse Versuch mit US und IR gemacht. War alles nicht so der Hit. Deshalb ein neuer Versuch mit Bilderkennung: Der Rasenrobo hat eine rote Markierung bekommen. Die webcam ist am Fenster im 2. Stock befestigt und erfaßt leider nicht den ganzen Garten. Das Programm ist mit VB6 geschrieben. Das Bild hat eine Matrix von 320 x 160. Die Auswertung pro Bild dauert nur 0,05 sec. Grob gesagt wird ein Fleck mit dem höchsten Rotanteil gesucht. Zum Ausschluss falscher Messungen werden nur Werte akzeptiert falls 10 aufeinanderfolgende Messungen alle unmittelbar benachbart sind.

Nach etwa 10 Minuten:
http://www.rasenrobo.de/rasenrobo1.jpg

Nach etwa 1 Stunde:
http://www.rasenrobo.de/rasenrobo2.jpg
Die Aufnahmen stammen von heute Abend. Zum Schluss ist´s zu Dunkel geworden. Immer wenn der Robo ausserhalb vom Bild ist, werden gelegentlich rote Punkte markiert die nicht zum Robo gehören. Deshalb die grünen Flecken im Teich (die Goldfische) oder in der Ecke rechts oben.

Das Programm für Interessierte (insb. VB6-Nostalgiker):

Code:

---

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Dim fs
Dim rot As Integer, grün As Integer, blau As Integer, farbealt, rotalt As Byte, grünalt As Byte, blaualt As Byte
Dim starti, startj, endi, endj, am As String, amh As String, j As Integer, jj As Long
Dim ErgebnisIR As Long, a As Picture, b As Picture, c As Picture, groesse As RECT
Dim pointert As Long, smax As Integer, xmax As Integer, ymax As Integer, xmaxalt As Integer, ymaxalt As Integer, mousex As Integer, mousey As Integer, Letztesx(10), Letztesy(10), letzter
Dim Bmp As strucBITMAP ' Struktur für die Bitmap-Rahmenangaben ' des geladenen Bildes
Dim gSafearray As strucSAFEARRAY
Dim Pic() As Integer, i As Integer, k As Integer, ii As Integer, kk As Integer
Private Declare Function VarPtrArray Lib "msvbvm60.dll" _
  Alias "VarPtr" ( _
  Ptr() As Any) As Long
Private Declare Function GetObject Lib "gdi32" _
  Alias "GetObjectA" ( _
  ByVal hObject As Long, _
  ByVal nCount As Long, _
  lpObject As Any) As Long
' Informationsblock der Array-Dimensionierung bei VB6
Private Type strucSAFEARRAY
  Dimensionen As Integer    ' Zahl der Array-Dimensionen
  Features As Integer      ' spezielle Array-Eigenschaften
  Elemente As Long          ' Angabe zum einz. Arrayfeld
  Locks As Long            ' Sperrvermerke
  DatenZeiger As Long      ' Zeiger: Speicher-Start der Arraydaten
  Elements1 As Long        ' Anzahl Elemente in 1.Dimension
  lBound1 As Long          ' Arrayuntergrenze 1. Dimension
  Elements2 As Long        ' s.o.
  lBound2 As Long
End Type
Private Type strucBITMAP
  Type As Long
  PixelWidth As Long      ' Bildbreite (Pixel)
  PixelHeight As Long    ' Bildhöhe  (Pixel)
  BytesWidth As Long      ' Breite (in Byte; bei 24 Bit-Bitmap 3 Byte/Pixel)
  Planes As Integer
  BitsPerPixel As Integer ' Prog unterstützt nur 24 Bits/Pixe
  BitZeiger As Long      ' Zeiger auf die Bilddaten
End Type
Private Sub Command1_Click()
xmaxalt = 0: ymaxalt = 0
If Command1.Caption = "Start" Then
    Command1.Caption = "Stop":    Open "C:\efilm\roboter2.dat" For Append As #1: Print #1, Command1.Caption
Else
    Command1.Caption = "Start": Close #1
End If
End Sub
Private Sub Form_Load()
 Set fs = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next        'Don't stop execution, continue on next line
  ' WebBrowser1.Navigate2 "http:\\www.t-online.de"
  WebBrowser1.Navigate2 "http://192.168.1.20/img/main.cgi?next_file=main.htm"
    If Err.Number <> 0 Then MsgBox "Error :" & Err.Description  'Display error message
    Timer1.Interval = 50: Timer1.Enabled = True
    Picture1.Visible = False
End Sub
Private Sub Picture2_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
  ErgebnisIR = FindWindow(0&, "Form1")
  DoEvents: ' On Error Resume Next
  Set a = CaptureWindow(ErgebnisIR, False, 5, 25, 500, 330)
  SavePicture a, "C:\zwischen.bmp": Set a = LoadPicture("C:\zwischen.bmp")
  If Command1.Caption = "Start" Then Set Picture2.Picture = a ' Clipboard.GetData(2) ' b
  Call GetObject(a, Len(Bmp), Bmp)
  With gSafearray
    .Elemente = 2              'für integer
    .Dimensionen = 2            ' 2-dimensionales Array
    .lBound1 = 0
    .Elements1 = Bmp.PixelHeight ' Bildhöhe in Pixel
    .lBound2 = 0
    .Elements2 = Bmp.BytesWidth / 2 ' Bildbreite in Byte !!!
    .DatenZeiger = Bmp.BitZeiger ' Zeiger auf die Bilddaten
  End With
          ' Overlay-Array für Bildzugriff
 Call CopyMemory(ByVal VarPtrArray(Pic), VarPtr(gSafearray), 4)
 
 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
 On Error Resume Next
 For k = 0 To UBound(Pic, 2): For i = 0 To UBound(Pic, 1)
      rot = Int(Pic(i, k) / &H400): blau = Pic(i, k) And &H1F: grün = Int(Pic(i, k) / &H20) And &H1F
      If mousex = i And mousey = UBound(Pic, 2) - k Then
        Text1.Text = mousex & vbTab & mousey: Text3.Text = rot: Text4.Text = blau: Text5.Text = grün
      End If
      If rot <= blau + 2 Or rot <= grün + 2 Then
          S5(i, k) = 0
        Else
          S5(i, k) = rot - (blau + grün) / 2
      End If
 Next i:  Next k
 For k = 0 To UBound(Pic, 2): For i = 0 To UBound(Pic, 1)
  If S5(i, k) > 0 Then
    S1(i, k) = S5(i, k) + (S1(i - 1, k) + S1(i, k - 1)) / 9 * 4
    ii = UBound(Pic, 1) - i: kk = UBound(Pic, 2) - k:
    s2(ii, kk) = S5(ii, kk) + (s2(ii + 1, kk) + s2(ii, kk + 1)) / 9 * 4
    S3(i, kk) = S5(i, kk) + (S3(i - 1, kk) + S3(i, kk + 1)) / 9 * 4
    S4(ii, k) = S5(ii, k) + (S4(ii + 1, k) + S4(ii, k - 1)) / 9 * 4
  End If
 Next i:  Next k
 For k = 0 To UBound(Pic, 2): For i = 0 To UBound(Pic, 1)
  If S5(i, k) > 0 Then
    S1(i, k) = S1(i, k) + s2(i, k) + S3(i, k) + S4(i, k)
    If smax < S1(i, k) Then smax = S1(i, k): xmax = i: ymax = k
  End If
 Next i:  Next k
 ymax = UBound(Pic, 2) - ymax
 Text2 = Timer - t & vbTab & xmax & vbTab & ymax: Text2.Refresh
 Call CopyMemory(ByVal VarPtrArray(Pic), 0&, 4)
  Picture2.FillColor = vbGreen: Picture2.FillStyle = vbFSSolid
  Picture2.Circle (xmax, ymax), 1, vbGreen
  letzter = letzter + 1: letzter = letzter Mod 10
  Letztesx(letzter) = xmax: Letztesy(letzter) = ymax:
  For i = 1 To 9: deltax = Abs(Letztesx(i) - Letztesx(0)): deltay = Abs(Letztesy(i) - Letztesy(0))
    If deltax > 25 Or deltay > 25 Then i = 25:
  Next
  If i < 20 And xmaxalt > 0 And ymaxalt > 0 And Command1.Caption = "Stop" Then
    Picture2.Line (xmax, ymax)-(xmaxalt, ymaxalt), vbGreen
    Print #1, xmax, ymax
  End If
  If xmax > 0 And ymax > 0 Then xmaxalt = xmax: ymaxalt = ymax
End Sub

---

So, jetzt gut Nacht
Christian

Zu dem Programm gehört noch ein
Modul1 Bildschirmanalyse

Code:

---

Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Integer, ByVal nCmdShow As Integer) As Integer
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 PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const conHwndTopmost = -1: Const conHwndNoTopmost = -2: Const conSwpNoActivate = &H30: Const conSwpShowWindow = &H40
Dim flag, lParam, s As String, erg As String, f
Public hwnd2, s2, zeiger
Public Const SW_SHOWNORMAL = 1, SW_SHOWMAXIMIZED = 3
Dim namealt, efilmPatientenID As String
Const WM_CLOSE = &H10
 Const WM_MBUTTONDBLCLK = &H209
 Const WM_ACTIVATE = &H6
 Const WM_DDE_FIRST = &H3E0
 Const WM_DDE_TERMINATE = (WM_DDE_FIRST + 1)
 Const WM_DESTROY = &H2
 Const WM_MBUTTONDOWN = &H207
 Const WM_MBUTTONUP = &H208
Public Const WM_QUIT = &H12
Public Const WM_QUERYOPEN = &H13
Public Const WM_QUERYENDSESSION = &H11
 
 
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal Y As Long) As Long
'Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Const MOUSEEVENTF_MOVE = &H1
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_RIGHTDOWN = &H8
Public Const MOUSEEVENTF_RIGHTUP = &H10
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20
Public Const MOUSEEVENTF_MIDDLEUP = &H40
Public Const MOUSEEVENTF_WHEEL = &H800
Public Const MOUSEEVENTF_ABSOLUTE = &H8000
Public Type RECT
      Left As Long
      Top As Long
      Right As Long
      Bottom As Long
End Type
 
      ' This module contains several routines for capturing windows into a
      ' picture.  All the routines work on both 16 and 32 bit Windows
      ' platforms.
      ' The routines also have palette support.
      '
      ' CreateBitmapPicture - Creates a picture object from a bitmap and
      ' palette.
      ' CaptureWindow - Captures any window given a window handle.
      ' CaptureActiveWindow - Captures the active window on the desktop.
      ' CaptureForm - Captures the entire form.
      ' CaptureClient - Captures the client area of a form.
      ' CaptureScreen - Captures the entire screen.
      ' PrintPictureToFitPage - prints any picture as big as possible on
      ' the page.
      '
      ' NOTES
      '    - No error trapping is included in these routines.
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
 
      Option Explicit
      Option Base 0
      Private Type PALETTEENTRY
        peRed As Byte
        peGreen As Byte
        peBlue As Byte
        peFlags As Byte
      End Type
      Private Type LOGPALETTE
        palVersion As Integer
        palNumEntries As Integer
        palPalEntry(255) As PALETTEENTRY  ' Enough for 256 colors.
      End Type
      Private Type GUID
        Data1 As Long
        Data2 As Integer
        Data3 As Integer
        Data4(7) As Byte
      End Type
      #If Win32 Then
        Private Const RASTERCAPS As Long = 38
        Private Const RC_PALETTE As Long = &H100
        Private Const SIZEPALETTE As Long = 104
'
'        Private Type RECT
'            Left As Long
'            Top As Long
'            Right As Long
'            Bottom As Long
'        End Type
        Private Declare Function CreateCompatibleDC Lib "gdi32" ( _
            ByVal hDC As Long) As Long
        Private Declare Function CreateCompatibleBitmap Lib "gdi32" ( _
            ByVal hDC As Long, ByVal nWidth As Long, _
            ByVal nHeight As Long) As Long
        Private Declare Function GetDeviceCaps Lib "gdi32" ( _
            ByVal hDC As Long, ByVal iCapabilitiy As Long) As Long
        Private Declare Function GetSystemPaletteEntries Lib "gdi32" ( _
            ByVal hDC As Long, ByVal wStartIndex As Long, _
            ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) _
            As Long
        Private Declare Function CreatePalette Lib "gdi32" ( _
            lpLogPalette As LOGPALETTE) As Long
        Private Declare Function SelectObject Lib "gdi32" ( _
            ByVal hDC As Long, ByVal hObject As Long) As Long
        Private Declare Function BitBlt Lib "gdi32" ( _
            ByVal hDCDest As Long, ByVal XDest As Long, _
            ByVal YDest As Long, ByVal nWidth As Long, _
            ByVal nHeight As Long, ByVal hDCSrc As Long, _
            ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) _
            As Long
        Private Declare Function DeleteDC Lib "gdi32" ( _
            ByVal hDC As Long) As Long
        Private Declare Function GetForegroundWindow Lib "user32" () _
            As Long
        Private Declare Function SelectPalette Lib "gdi32" ( _
            ByVal hDC As Long, ByVal hPalette As Long, _
            ByVal bForceBackground As Long) As Long
        Private Declare Function RealizePalette Lib "gdi32" ( _
            ByVal hDC As Long) As Long
        Private Declare Function GetWindowDC Lib "user32" ( _
            ByVal hwnd As Long) As Long
        Private Declare Function GetDC Lib "user32" ( _
            ByVal hwnd As Long) As Long
'        Private Declare Function GetWindowRect Lib "user32" ( _
'            ByVal hWnd As Long, lpRect As RECT) As Long
        Private Declare Function ReleaseDC Lib "user32" ( _
            ByVal hwnd As Long, ByVal hDC As Long) As Long
        Private Declare Function GetDesktopWindow Lib "user32" () As Long
        Private Type PicBmp
            Size As Long
            Type As Long
            hBmp As Long
            hPal As Long
            Reserved As Long
        End Type
        Private Declare Function OleCreatePictureIndirect _
            Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, _
            ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
      #ElseIf Win16 Then
        Private Const RASTERCAPS As Integer = 38
        Private Const RC_PALETTE As Integer = &H100
        Private Const SIZEPALETTE As Integer = 104
        Private Type RECT
            Left As Integer
            Top As Integer
            Right As Integer
            Bottom As Integer
        End Type
        Private Declare Function CreateCompatibleDC Lib "GDI" ( _
            ByVal hDC As Integer) As Integer
        Private Declare Function CreateCompatibleBitmap Lib "GDI" ( _
            ByVal hDC As Integer, ByVal nWidth As Integer, _
            ByVal nHeight As Integer) As Integer
        Private Declare Function GetDeviceCaps Lib "GDI" ( _
            ByVal hDC As Integer, ByVal iCapabilitiy As Integer) As Integer
        Private Declare Function GetSystemPaletteEntries Lib "GDI" ( _
            ByVal hDC As Integer, ByVal wStartIndex As Integer, _
            ByVal wNumEntries As Integer, _
            lpPaletteEntries As PALETTEENTRY) As Integer
        Private Declare Function CreatePalette Lib "GDI" ( _
            lpLogPalette As LOGPALETTE) As Integer
        Private Declare Function SelectObject Lib "GDI" ( _
            ByVal hDC As Integer, ByVal hObject As Integer) As Integer
        Private Declare Function BitBlt Lib "GDI" ( _
            ByVal hDCDest As Integer, ByVal XDest As Integer, _
            ByVal YDest As Integer, ByVal nWidth As Integer, _
            ByVal nHeight As Integer, ByVal hDCSrc As Integer, _
            ByVal XSrc As Integer, ByVal YSrc As Integer, _
            ByVal dwRop As Long) As Integer
        Private Declare Function DeleteDC Lib "GDI" ( _
            ByVal hDC As Integer) As Integer
        Private Declare Function GetForegroundWindow Lib "USER" _
            Alias "GetActiveWindow" () As Integer
        Private Declare Function SelectPalette Lib "USER" ( _
            ByVal hDC As Integer, ByVal hPalette As Integer, ByVal _
            bForceBackground As Integer) As Integer
        Private Declare Function RealizePalette Lib "USER" ( _
            ByVal hDC As Integer) As Integer
        Private Declare Function GetWindowDC Lib "USER" ( _
            ByVal hwnd As Integer) As Integer
        Private Declare Function GetDC Lib "USER" ( _
            ByVal hwnd As Integer) As Integer
        Private Declare Function GetWindowRect Lib "USER" ( _
            ByVal hwnd As Integer, lpRect As RECT) As Integer
        Private Declare Function ReleaseDC Lib "USER" ( _
            ByVal hwnd As Integer, ByVal hDC As Integer) As Integer
        Private Declare Function GetDesktopWindow Lib "USER" () As Integer
        Private Type PicBmp
            Size As Integer
            Type As Integer
            hBmp As Integer
            hPal As Integer
            Reserved As Integer
        End Type
        Private Declare Function OleCreatePictureIndirect _
            Lib "oc25.dll" (PictDesc As PicBmp, RefIID As GUID, _
            ByVal fPictureOwnsHandle As Integer, IPic As IPicture) _
            As Integer
      #End If
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      ' CreateBitmapPicture
      '    - Creates a bitmap type Picture object from a bitmap and
      '      palette.
      '
      ' hBmp
      '    - Handle to a bitmap.
      '
      ' hPal
      '    - Handle to a Palette.
      '    - Can be null if the bitmap doesn't use a palette.
      '
      ' Returns
      '    - Returns a Picture object containing the bitmap.
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      #If Win32 Then
        Public Function CreateBitmapPicture(ByVal hBmp As Long, _
            ByVal hPal As Long) As Picture
            Dim r As Long
      #ElseIf Win16 Then
        Public Function CreateBitmapPicture(ByVal hBmp As Integer, _
            ByVal hPal As Integer) As Picture
            Dim r As Integer
      #End If
        Dim Pic As PicBmp
        ' IPicture requires a reference to "Standard OLE Types."
        Dim IPic As IPicture
        Dim IID_IDispatch As GUID
        ' Fill in with IDispatch Interface ID.
        With IID_IDispatch
            .Data1 = &H20400
            .Data4(0) = &HC0
            .Data4(7) = &H46
        End With
        ' Fill Pic with necessary parts.
        With Pic
            .Size = Len(Pic)          ' Length of structure.
            .Type = vbPicTypeBitmap  ' Type of Picture (bitmap).
            .hBmp = hBmp              ' Handle to bitmap.
            .hPal = hPal              ' Handle to palette (may be null).
        End With
        ' Create Picture object.
        r = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)
        ' Return the new Picture object.
        Set CreateBitmapPicture = IPic
      End Function
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      ' CaptureWindow
      '    - Captures any portion of a window.
      '
      ' hWndSrc
      '    - Handle to the window to be captured.
      '
      ' Client
      '    - If True CaptureWindow captures from the client area of the
      '      window.
      '    - If False CaptureWindow captures from the entire window.
      '
      ' LeftSrc, TopSrc, WidthSrc, HeightSrc
      '    - Specify the portion of the window to capture.
      '    - Dimensions need to be specified in pixels.
      '
      ' Returns
      '    - Returns a Picture object containing a bitmap of the specified
      '      portion of the window that was captured.
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      ''''''
      '
      #If Win32 Then
        Public Function CaptureWindow(ByVal hWndSrc As Long, _
            ByVal Client As Boolean, ByVal LeftSrc As Long, _
            ByVal TopSrc As Long, ByVal WidthSrc As Long, _
            ByVal HeightSrc As Long) As Picture
            Dim hDCMemory As Long
            Dim hBmp As Long
            Dim hBmpPrev As Long
            Dim r As Long
            Dim hDCSrc As Long
            Dim hPal As Long
            Dim hPalPrev As Long
            Dim RasterCapsScrn As Long
            Dim HasPaletteScrn As Long
            Dim PaletteSizeScrn As Long
      #ElseIf Win16 Then
        Public Function CaptureWindow(ByVal hWndSrc As Integer, _
            ByVal Client As Boolean, ByVal LeftSrc As Integer, _
            ByVal TopSrc As Integer, ByVal WidthSrc As Long, _
            ByVal HeightSrc As Long) As Picture
            Dim hDCMemory As Integer
            Dim hBmp As Integer
            Dim hBmpPrev As Integer
            Dim r As Integer
            Dim hDCSrc As Integer
            Dim hPal As Integer
            Dim hPalPrev As Integer
            Dim RasterCapsScrn As Integer
            Dim HasPaletteScrn As Integer
            Dim PaletteSizeScrn As Integer
      #End If
        Dim LogPal As LOGPALETTE
        ' Depending on the value of Client get the proper device context.
        If Client Then
            hDCSrc = GetDC(hWndSrc) ' Get device context for client area.
        Else
            hDCSrc = GetWindowDC(hWndSrc) ' Get device context for entire
                                          ' window.
        End If
        ' Create a memory device context for the copy process.
        hDCMemory = CreateCompatibleDC(hDCSrc)
        ' Create a bitmap and place it in the memory DC.
        hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
        hBmpPrev = SelectObject(hDCMemory, hBmp)
        ' Get screen properties.
        RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS) ' Raster
                                                            ' capabilities.
        HasPaletteScrn = RasterCapsScrn And RC_PALETTE      ' Palette
                                                              ' support.
        PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) ' Size of
                                                              ' palette.
        ' If the screen has a palette make a copy and realize it.
        If HasPaletteScrn And (PaletteSizeScrn = 256) Then
            ' Create a copy of the system palette.
            LogPal.palVersion = &H300
            LogPal.palNumEntries = 256
            r = GetSystemPaletteEntries(hDCSrc, 0, 256, _
                LogPal.palPalEntry(0))
            hPal = CreatePalette(LogPal)
            ' Select the new palette into the memory DC and realize it.
            hPalPrev = SelectPalette(hDCMemory, hPal, 0)
            r = RealizePalette(hDCMemory)
        End If
        ' Copy the on-screen image into the memory DC.
        r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, _
            LeftSrc, TopSrc, vbSrcCopy)
      ' Remove the new copy of the  on-screen image.
        hBmp = SelectObject(hDCMemory, hBmpPrev)
        ' If the screen has a palette get back the palette that was
        ' selected in previously.
        If HasPaletteScrn And (PaletteSizeScrn = 256) Then
            hPal = SelectPalette(hDCMemory, hPalPrev, 0)
        End If
        zeiger = hBmpPrev
        ' Release the device context resources back to the system.
        r = DeleteDC(hDCMemory)
        r = ReleaseDC(hWndSrc, hDCSrc)
        ' Call CreateBitmapPicture to create a picture object from the
        ' bitmap and palette handles. Then return the resulting picture
        ' object.
        Set CaptureWindow = CreateBitmapPicture(hBmp, hPal)
      End Function
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      ' CaptureScreen
      '    - Captures the entire screen.
      '
      ' Returns
      '    - Returns a Picture object containing a bitmap of the screen.
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      Public Function CaptureScreen() As Picture
        #If Win32 Then
            Dim hWndScreen As Long
        #ElseIf Win16 Then
            Dim hWndScreen As Integer
        #End If
        ' Get a handle to the desktop window.
        hWndScreen = GetDesktopWindow()
        ' Call CaptureWindow to capture the entire desktop give the handle
        ' and return the resulting Picture object.
        Set CaptureScreen = CaptureWindow(hWndScreen, False, 0, 0, _
            Screen.Width \ Screen.TwipsPerPixelX, _
            Screen.Height \ Screen.TwipsPerPixelY)
      End Function
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      ' CaptureForm
      '    - Captures an entire form including title bar and border.
      '
      ' frmSrc
      '    - The Form object to capture.
      '
      ' Returns
      '    - Returns a Picture object containing a bitmap of the entire
      '      form.
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      Public Function CaptureForm(frmSrc As Form) As Picture
        ' Call CaptureWindow to capture the entire form given its window
        ' handle and then return the resulting Picture object.
        Set CaptureForm = CaptureWindow(frmSrc.hwnd, False, 0, 0, _
            frmSrc.ScaleX(frmSrc.Width, vbTwips, vbPixels), _
            frmSrc.ScaleY(frmSrc.Height, vbTwips, vbPixels))
      End Function
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      ' CaptureClient
      '    - Captures the client area of a form.
      '
      ' frmSrc
      '    - The Form object to capture.
      '
      ' Returns
      '    - Returns a Picture object containing a bitmap of the form's
      '      client area.
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      Public Function CaptureClient(frmSrc As Form) As Picture
        ' Call CaptureWindow to capture the client area of the form given
        ' its window handle and return the resulting Picture object.
        Set CaptureClient = CaptureWindow(frmSrc.hwnd, True, 0, 0, _
            frmSrc.ScaleX(frmSrc.ScaleWidth, frmSrc.ScaleMode, vbPixels), _
            frmSrc.ScaleY(frmSrc.ScaleHeight, frmSrc.ScaleMode, vbPixels))
      End Function
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      ' CaptureActiveWindow
      '    - Captures the currently active window on the screen.
      '
      ' Returns
      '    - Returns a Picture object containing a bitmap of the active
      '      window.
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      Public Function CaptureActiveWindow(ErgebnisIR As Long) As Picture
        #If Win32 Then
            Dim hWndActive As Long
            Dim r As Long
        #ElseIf Win16 Then
            Dim hWndActive As Integer
            Dim r As Integer
        #End If
        Dim RectActive As RECT
        ' Get a handle to the active/foreground window.
        ' oder handle =  übergebener Parameter
        hWndActive = GetForegroundWindow()
        hWndActive = ErgebnisIR
        ' Get the dimensions of the window.
        r = GetWindowRect(hWndActive, RectActive)
        ' Call CaptureWindow to capture the active window given its
        ' handle and return the Resulting Picture object.
      Set CaptureActiveWindow = CaptureWindow(hWndActive, False, 0, 0, _
            RectActive.Right - RectActive.Left, _
            RectActive.Bottom - RectActive.Top)
      End Function
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      ' PrintPictureToFitPage
      '    - Prints a Picture object as big as possible.
      '
      ' Prn
      '    - Destination Printer object.
      '
      ' Pic
      '    - Source Picture object.
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      Public Sub PrintPictureToFitPage(Prn As Printer, Pic As Picture)
        Const vbHiMetric As Integer = 8
        Dim PicRatio As Double
        Dim PrnWidth As Double
        Dim PrnHeight As Double
        Dim PrnRatio As Double
        Dim PrnPicWidth As Double
        Dim PrnPicHeight As Double
        ' Determine if picture should be printed in landscape or portrait
        ' and set the orientation.
        If Pic.Height >= Pic.Width Then
            Prn.Orientation = vbPRORPortrait  ' Taller than wide.
        Else
            Prn.Orientation = vbPRORLandscape  ' Wider than tall.
        End If
        ' Calculate device independent Width-to-Height ratio for picture.
        PicRatio = Pic.Width / Pic.Height
        ' Calculate the dimentions of the printable area in HiMetric.
        PrnWidth = Prn.ScaleX(Prn.ScaleWidth, Prn.ScaleMode, vbHiMetric)
        PrnHeight = Prn.ScaleY(Prn.ScaleHeight, Prn.ScaleMode, vbHiMetric)
        ' Calculate device independent Width to Height ratio for printer.
        PrnRatio = PrnWidth / PrnHeight
        ' Scale the output to the printable area.
        If PicRatio >= PrnRatio Then
            ' Scale picture to fit full width of printable area.
            PrnPicWidth = Prn.ScaleX(PrnWidth, vbHiMetric, Prn.ScaleMode)
            PrnPicHeight = Prn.ScaleY(PrnWidth / PicRatio, vbHiMetric, _
              Prn.ScaleMode)
        Else
            ' Scale picture to fit full height of printable area.
            PrnPicHeight = Prn.ScaleY(PrnHeight, vbHiMetric, Prn.ScaleMode)
            PrnPicWidth = Prn.ScaleX(PrnHeight * PicRatio, vbHiMetric, _
              Prn.ScaleMode)
        End If
        ' Print the picture using the PaintPicture method.
        Prn.PaintPicture Pic, 0, 0, PrnPicWidth, PrnPicHeight
      End Sub
      '--------------------------------------------------------------------
 
 
 
Function EnumWndProc(ByVal hwnd As Long, lParam As Long) As Long
s = WindowTextFromWnd(hwnd)
If InStr(1, s, flag) > 0 Then
hwnd2 = hwnd
s2 = s
EnumWndProc = False
End If
EnumWndProc = True
End Function
Function schach(flag1)
Dim t
flag = flag1
On Error Resume Next
f = EnumWindows(AddressOf EnumWndProc, 5)
t = Timer: Do: DoEvents: Loop Until Timer > t + 0.5
schach = s2
End Function
Function WindowTextFromWnd(ByVal hwnd As Long) As String
Dim c As Integer
c = GetWindowTextLength(hwnd)
If c <= 0 Then Exit Function
s = String$(c, 0): c = GetWindowText(hwnd, s, c + 1)
WindowTextFromWnd = s
End Function

---

Christian H

Hallo,
auch ich bin seit langer Zeit mal wieder etwas an meinem Rasenmäher gesessen. Leider fehlt jedoch größtenteils die Zeit dafür. Zu deinem Ansatz wollte ich sagen, dass mir diese Idee letztlich auch durch den Kopf gegangen ist. Jedoch war mein Problem zum einen, dass eine Kamera nicht alle Bereiche abdeckt (mit mehreren wird das ganze sehr komplex) und zum anderen auch, dass durch die Perspektive der Kamera eine eindeutige Lokalisation schwierig ist. Meine Anliegen war nicht die Induktionsschleife zu ersetzen, sondern das Mähen effizienter zu gestalten. Was ich jedoch anders machen würde wäre, nicht eine farbliche Markierung, sondern eine Infrarotmarkierung zu verwenden. Mit zusätzlichem IR-Filter an der Kamera denke ich dass sich hier eine höhere Genauigkeit und niedrigere Störanfälligkeit erreichen lässt. Auch wenn die Umsetzung für mich im Moment zeitlich nicht machbar ist, werde ich dein Projekt mit Spannung verfolgen.

Gruß, homedom