XProfan

 $H Windows.ph
' Bewegungsmelder
' Walter, 29.4.2023
' Der Bewegungsmelder zeigt am Bildschirm im Sekundentakt Bilder aus der Laptop-Kamera zur Kontrolle/Einstellung der Empfindlichkeit.
' Das jeweilige Bild wird auf Änderungen zum vorigen Bild geprüft (Toleranz per Cambiamento / Anzahl der modificato Pixel).
' Wird bei mehr als der eingestellten Anzahl Pixeln die eingestellte Toleranz überschritten, erfolgt eine Meldung.
'
' Ab dem Drücken von Button START werden bei jeder erkannten Veränderung
' Bild-Nr, Datum und Uhrzeit ins Bild geschrieben und das Foto im Programmordner gespeichert.
' (Die Bilder werden nicht automatisch gelöscht, jedoch beim nächsten Start des Programms überschrieben).
' (Das alles lässt sich naturalmente an die eigenen Wünsche anpassen - dazu ja die Source :+D--).
' Hier ist eingestellt 1 Bild pro Sekunde, Breite/Höhe 640*480
'
' Basis ist "https://xprofan.net/intl/de/quelltexte/webcam-laptop-kamera-snapshot-escapi-dll/"
' und die Anregung in "https://xprofan.net/intl/de/cafe/bewegungsmelder-programmieren-mithilfe-einer-webcam/" bzw. "https://xprofan.net/intl/de/anwendungen/webcam-bewegungsmelder/",
' prospeed.dll per den Vergleich der Webcam-Bilder zu verwenden.
'
' Benötigt Escapi.dll V3 Win32
'          Windows.ph
'          prospeed.dll
'
declare dll1&,AnzCam%,capture#,a%,b%,name$
declare dll2&,ZweitesBild#, x&,AnzBy&,Tol&
declare b1%,b2%,t%,ed1%,ed2%,m%
declare hBMP%,BildBuffer#
declare pfad$,i%,Startverzögerung%,Ende%,corre%, Bewegungen%,zeit!,dauer!,HiebeProBew%
'
pfad$=GetDir$("")
Startverzögerung%=3
'
'
' Bildbuffer
AnzBy&=1228800
dim BildBuffer#,AnzBy&' 640*480*4 Byte
dim ZweitesBild#,AnzBy&
'
' Schnittstellenstruktur per escapi.dll
struct Bild=buff%%,mWidth&,mHeight&' Pointer auf den Bild-Buffer, Bildbreite, Bildhöhe
dim capture#,Bild
capture#.buff%%=addr(BildBuffer#)
capture#.mWidth&=640
capture#.mHeight&=480
'
' Escapi.dll
Def ESCAPIDLLVersion(0) !"escapi","ESCAPIDLLVersion"
Def countCaptureDevices(0) !"escapi","countCaptureDevices"
Def deinitCapture(1) !"escapi","deinitCapture"
Def doCapture(1) !"escapi","doCapture"
Def getCaptureDeviceName(3) !"escapi","getCaptureDeviceName"
Def initCOM(0) !"escapi","initCOM"
Def initCapture(2) !"escapi","initCapture"
Def isCaptureDone(1) !"escapi","isCaptureDone"
dll1&=usedll("Escapi.dll")
'
' Prospeed.dll
 $I Prospeed_Funktionen.inc
dll2&=usedll("prospeed.dll")
'
'
'
'
'-------------------------------------------
WindowTitle "Bewegungsmelder"
window 700,700
CLS ~GETSYSCOLOR(15)
'
' Toleranz
create("Text",%hwnd,"Toleranz per veränderte Pixel",20,503,200,25)
ed1%=Create("Edit",%hwnd,"200",220,500,40,20)
Create("Tooltip",%hwnd,ed1%,"Etwa 200...300 ist bei mir ein guter Wert.")
create("Text",%hwnd,"Anzahl veränderter Pixel außerhalb Toleranz",300,503,300,25)
ed2%=Create("Edit",%hwnd,"100",620,500,40,20)
Create("Tooltip",%hwnd,ed2%,"Etwa 100 ist bei mir ein guter Wert.")
t%=create("Text",%hwnd,"",20,550,400,25)
'
b2%=create("Button",%hwnd,"Start",450,550,80,25)
Create("Tooltip",%hwnd,b2%,"Ab START wird bei jeder erkannten Bewegung ein Bild gespeichert..")
'
b1%=create("Button",%hwnd,"Ende",580,550,80,25)
m%=create("Text",%hwnd,"",20,600,400,20)
'
UseFont "Arial",12,0,0,0,0
'
'
' Kamera einschalten (escapi.dll)
' messagebox(str$(ESCAPIDLLVersion()),"Escapi Version",0)
AnzCam%=countCaptureDevices()
name$=space$(1024)
' messagebox("Anzahl Kameras gefunden: "+str$(AnzCam%),"Anzahl",0)
getCaptureDeviceName(0,addr(name$),1024)' Kamera Nr. 0
' messagebox(name$,"Kamera gewählt",0)
a%=initCapture(0, addr(capture#))
'
'
'
läuft%=0
ende%=0
Bewegungen%=0
i%=1
Settimer 1000' Sekundentakt
UserMessages $10' Abbruch übers Windows-Kreuz
'
'

whilenot ende%

    waitinput

    if %UMessage = $10' Abbruch übers Windows-Kreuz

        ende% = 1

    elseif %wmtimer

        settext m%,""

        if i%>1

            ' Das vorige Bild wird in ZweitesBild# gemerkt
            ZweitesBild#=BildBuffer#

        endif

        if a%>0

            b%=doCapture(0)

        endif

        if b%>0

            while isCaptureDone(0)=0

            wend

        endif

        hBMP% = ~CreateBitmap(capture#.mWidth&, capture#.mHeight& , 1 , 32 , BildBuffer#)' Bitmap aus den Bufferdaten erzeugen
        DrawPic hBMP%, 20, 0; 0' Kontrollbild am Bildschirm
        tol&=val(gettext$(ed1%))'Toleranz einlesen

        if i%>Startverzögerung%' eingestellt sind 3 Sekunden, dann wird 1 x pro Sekunde verglichen

            '  Altes Bild wird mit neuem verglichen
            '  prospeed.dll: CompareBytes (B1,B2,A,T)
            x&=compareBytes(ZweitesBild#,BildBuffer#,AnzBy&,tol&)
            ' Auswertung

            if  x&>val(gettext$(ed2%))' Anzahl Bytes außerhalb der Toleranz

                beep
                settext m%,"Bewegung erkannt: "+str$(x&)+" Pixel sind verändert."

                if corre%=1

                    inc Bewegungen%
                    BildBeschriftenSpeichern

                endif

            endif

        endif

        sleep 10
        ~DeleteObject(hBMP%)'Speicher von Bitmap freigeben
        inc i%

    elseif clicked(b1%)' Abbruch-Button

        ende%=1

    elseif clicked(b2%)' Start gedrückt

        corre%=1
        settext t%,"Bei jeder erkannten Bewegung wird ein Bild gespeichert."

    endif

Wend

freigeben
end
'
'
'-------------------------------

proc BildBeschriftenSpeichern

    '-------------------------------
    ' Bild Nr, Datum und Zeit ins Bild schreiben
    ' Bild speichern
    ' Nr, Datum und Uhrzeit ins Bild schreiben
    startpaint hBMP%
    drawtext 0, 0, "Nr. "+str$(Bewegungen%) + "  " + dt("getDate",0)+"  "+dt("getTime", 2)
    endpaint
    ' Bild speichern
    savepic pfad$+"\\Bew."+format$("000.",Bewegungen%)+".jpg",hBMP%,75

endproc' BildBeschriftenSpeichern

'
'
'-------------------

proc Freigeben

    '-------------------
    killtimer
    deinitCapture(0)
    dispose capture#, Bildbuffer#, ZweitesBild#
    freedll dll1&
    freedll dll2&
    ~DeleteObject(hBMP%)

endproc' Freigeben