XProfan

 $H Windows.ph
' Camera
' 25.4.2023
' pouvoir Bilder avec qui Laptop-caméra dans fixen Abständen
' et speichert vous im aktuellen Verzeichnis comme test.<nr>.jpg
'   ici ist eingestellt 1 Bild pro seconde, Breite/Hauteur 640*480
'   qui Bilder volonté vom Start weg de 001 à durchnummeriert et überschreiben qui vom letzten le cours
' sur dem Bildschirm wird angezeigt, quoi aufgenommen wird
' Requiert Escapi.dll V3 Win32 et Windows.ph
declare dll1&,AnzCam%,capture#,a%,b%,nom$
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 sur 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 trouvé: "+str$(AnzCam%),"Anzahl",0)
getCaptureDeviceName(0,addr(nom$),1024)
'messagebox(nom$,"Kamera gewählt",0)
a%=initCapture(0, addr(capture#))
Titre de la fenêtre "Fotos aus qui Laptop-Kamera"
window 700,600
b1%=create("Button",%hwnd,"Beenden",20,500,80,25)
ende%=0
i%=1
Settimer 1000
Utilisateur Messages $10' Abbruch übers Windows-Croix

whilenot ende%

    waitinput

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

        ende% = 1

    elseif %wmtimer

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

    elseif clicked(b1%)' Ende-Button

        ende%=1

    endif

Wend

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