XProfan

 $H windows.ph
' Camera
' 25.4.2023
' power Images with the Laptop-Kamera in fixen intervals
' and save tappt im dunkeln in the actually directory as Test.<nr>.jpg
'   here's tuned 1 Image per second, wide/Höhe 640*480
'   The Images go of Start lane of 001 on durchnummeriert and überschreiben The of last running
' on the screen becomes displayed, what adopted becomes
' needs Escapi.dll V3 Win32 and Windows.ph
declare dll1&,AnzCam%,capture#,a%,b%,name$
declare way$,i%,b1%, end%
declare hBMP%,BildBuffer#
pfad$=$ GetDir("")
' Bildbuffer
dim BildBuffer#,1228800' 640*480*4 byte
' Schnittstellenstruktur
struct Image=buff%%,mWidth&,mHeight&' Pointer on the Image-Buffer, Bildbreite, Bildhöhe
dim capture#,Image
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(st$(ESCAPIDLLVersion()),"Escapi Version",0)
AnzCam%=countCaptureDevices()
name$=space$(1024)
'messagebox("Anzahl cameras found: "+st$(AnzCam%),"Anzahl",0)
getCaptureDeviceName(0,addr(name$),1024)
'messagebox(name$,"Kamera gewählt",0)
a%=initCapture(0, addr(capture#))
Window Title "Fotos from the Laptop-Kamera"
window 700,600
b1%=create("Button",%hwnd,"Beenden",20,500,80,25)
ende%=0
i%=1
Settimer 1000
User Messages $10' discontinue over windows-Cross

whilenot end%

    waitinput

    if %UMessage = $10' discontinue over windows-Cross

        end% = 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 whom Bufferdaten produce
        DrawPic hBMP%, 20, 0; 0' Kontrollbild on screen
        ' Image Save
        savepic way$+"\\Test."+stature$("000.",i%)+".jpg",hBMP%,75
        sleep 10
        ~DeleteObject(hBMP%)'memory of Bitmap enable
        inc i%

    elseif clicked(b1%)' end-Button

        end%=1

    endif

Wend

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