XProfan

 $H Windows.ph
' Camera
' 25.4.2023
' Macht Bilder mit der Laptop-Kamera in fixen Abständen
' und speichert sie im aktuellen Verzeichnis als test.<nr>.jpg
'   Hier ist eingestellt 1 Bild pro Sekunde, Breite/Höhe 640*480
'   Die Bilder werden vom Start weg von 001 an durchnummeriert und überschreiben die vom letzten Lauf
' Auf dem Bildschirm wird angezeigt, was aufgenommen wird
' Benötigt Escapi.dll V3 Win32 und Windows.ph
declare dll1&,AnzCam%,capture#,a%,b%,name$
declare pfad$,i%,b1%, Ende%
declare hBMP%,BildBuffer#
pfad$=GetDir$("")
' Bildbuffer
dim BildBuffer#,1228800' 640*480*4 Byte
' Schnittstellenstruktur
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
' DLL Escapi
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")
'messagebox(str$(ESCAPIDLLVersion()),"Escapi Version",0)
AnzCam%=countCaptureDevices()
name$=space$(1024)
'messagebox("Anzahl Kameras gefunden: "+str$(AnzCam%),"Anzahl",0)
getCaptureDeviceName(0,addr(name$),1024)
'messagebox(name$,"Kamera gewählt",0)
a%=initCapture(0, addr(capture#))
WindowTitle "Fotos aus der Laptop-Kamera"
window 700,600
b1%=create("Button",%hwnd,"Beenden",20,500,80,25)
ende%=0
i%=1
Settimer 1000
UserMessages $10' Abbruch übers Windows-Kreuz

whilenot ende%

    waitinput

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

        ende% = 1

    elseif %wmtimer

        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
        ' Bild speichern
        savepic pfad$+"\\test."+format$("000.",i%)+".jpg",hBMP%,75
        sleep 10
        ~DeleteObject(hBMP%)'Speicher von Bitmap freigeben
        inc i%

    elseif clicked(b1%)' Ende-Button

        ende%=1

    endif

Wend

' freigeben
killtimer
deinitCapture(0)
dispose capture#, Bildbuffer#
freedll dll1&