XProfan

 $H Windows.ph
' Bewegungsmelder
' Walter, 29.4.2023
' qui Bewegungsmelder zeigt am Bildschirm im Sekundentakt Bilder aus qui Laptop-caméra zur Kontrolle/Einstellung qui Empfindlichkeit.
' cela jeweilige Bild wird sur Changements zum vorigen Bild geprüft (Toleranz pour Changement / Nombre de modifié Pixel).
' Wird chez plus que qui eingestellten Anzahl Pixeln qui eingestellte Toleranz überschritten, erfolgt une annonce.
'
' Ab dem Drücken de Button START volonté chez chacun erkannten Veränderung
' Bild-Nr, date et l'heure ins Bild geschrieben et cela photo im Programmordner gespeichert.
' (qui Bilder volonté pas automatisch gelöscht, cependant beim prochain Start des Programms überschrieben).
' (cela alles peut sich naturellement à qui eigenen Wünsche anpassen - en supplément oui qui Source :+D--).
' ici ist eingestellt 1 Bild pro seconde, Breite/Hauteur 640*480
'
' la base ist "https://XProfan.net/intl/de/quelltexte/webcam-laptop-caméra-snapshot-escapi-dll/"
' et qui Anregung dans "https://XProfan.net/intl/de/cafe/bewegungsmelder-programmieren-mithilfe-einer-webcam/" bzw. "https://XProfan.net/intl/de/anwendungen/webcam-bewegungsmelder/",
' prospeed.dll pour den comparaison qui Webcam-Bilder trop verwenden.
'
' Requiert Escapi.dll V3 Win32
'          Windows.ph
'          prospeed.dll
'
declare dll1&,AnzCam%,capture#,a%,b%,nom$
declare dll2&,ZweitesBild#, x&,AnzBy&,Tol&
declare b1%,b2%,t%,ed1%,ed2%,m%
declare hBMP%,BildBuffer#
declare pfad$,i%,Startverzögerung%,Ende%,fonctionne%, Bewegungen%,zeit!,la durée!,HiebeProBew%
'
pfad$=GETDIR $(»)
Startverzögerung%=3
'
'
' Bildbuffer
AnzBy&=1228800
dim BildBuffer#,AnzBy&' 640*480*4 Byte
dim ZweitesBild#,AnzBy&
'
' Schnittstellenstruktur pour escapi.dll
struct Bild=buff%%,mWidth&,mHeight&' Pointer sur 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")
'
'
'
'
'-------------------------------------------
Titre de la fenêtre "Bewegungsmelder"
window 700,700
CLS ~GETSYSCOLOR(15)
'
' Toleranz
create("Text",%hwnd,"Toleranz pour veränderte Pixel",20,503,200,25)
ed1%=Créer("Edit",%hwnd,"200",220,500,40,20)
Créer("Tooltip",%hwnd,ed1%,"Etwa 200...300 ist chez mir un bon Wert.")
create("Text",%hwnd,"Anzahl veränderter Pixel außerhalb Toleranz",300,503,300,25)
ed2%=Créer("Edit",%hwnd,"100",620,500,40,20)
Créer("Tooltip",%hwnd,ed2%,"Etwa 100 ist chez mir un bon Wert.")
t%=create("Text",%hwnd,»,20,550,400,25)
'
b2%=create("Button",%hwnd,"Start",450,550,80,25)
Créer("Tooltip",%hwnd,b2%,"Ab START wird chez chacun erkannten Bewegung un 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
'
'
' caméra einschalten (escapi.dll)
' messagebox(str$(ESCAPIDLLVersion()),"Escapi Version",0)
AnzCam%=countCaptureDevices()
name$=space$(1024)
' messagebox("Anzahl Kameras trouvé: "+str$(AnzCam%),"Anzahl",0)
getCaptureDeviceName(0,addr(nom$),1024)' caméra Nr. 0
' messagebox(nom$,"Kamera gewählt",0)
a%=initCapture(0, addr(capture#))
'
'
'
läuft%=0
ende%=0
Bewegungen%=0
i%=1
Settimer 1000' Sekundentakt
Utilisateur Messages $10' Abbruch übers Windows-Croix
'
'

whilenot ende%

    waitinput

    si %UMessage = $10' Abbruch übers Windows-Croix

        ende% = 1

    elseif %wmtimer

        settext m%,»

        si i%>1

            ' cela vorige Bild wird dans ZweitesBild# gemerkt
            ZweitesBild#=BildBuffer#

        endif

        si a%>0

            b%=doCapture(0)

        endif

        si b%>0

            tandis que 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

        si i%>Startverzögerung%' eingestellt sommes 3 Sekunden, ensuite wird 1 x pro seconde verglichen

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

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

                beep
                settext m%,"Bewegung erkannt: "+str$(x&)+" Pixel sommes modifié."

                si fonctionne%=1

                    inc Bewegungen%
                    BildBeschriftenSpeichern

                endif

            endif

        endif

        sleep 10
        ~DeleteObject(hBMP%)'grenier de Bitmap freigeben
        inc i%

    elseif clicked(b1%)' Abbruch-Button

        ende%=1

    elseif clicked(b2%)' Start gedrückt

        fonctionne%=1
        settext t%,"Bei chacun erkannten Bewegung wird un Bild gespeichert."

    endif

Wend

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

proc BildBeschriftenSpeichern

    '-------------------------------
    ' Bild Nr, date et Zeit ins Bild écrivons
    ' Bild Sauver
    ' Nr, date et l'heure ins Bild écrivons
    startpaint hBMP%
    drawtext 0, 0, "Nr. "+str$(Bewegungen%) + "  " + dt("getDate",0)+"  "+dt("getTime", 2)
    endpaint
    ' Bild Sauver
    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