unit UWebCam; interface uses math, gl, glu, glext, SysUtils, UIni, UTime, SDL, UCaptureWDM; function wStartWebCam: boolean; procedure wStopWebCam; procedure wInit; procedure wClose; procedure wDraw(DoDraw: boolean; Screen: integer); var WebCamReady: boolean; FGrabFrameFlag : boolean; FTex: glUint; FTexX, FTexY: integer; FdataX, FdataY: integer; FrameDataPtr: PByteArray; frame: Pointer; WDMSample: TSampleClass; implementation uses UGraphic, ULog, UDisplay; function wStartWebCam(): boolean; begin if not WebCamReady then wInit(); Result := WebCamReady; if WebCamReady and not FGrabFrameFlag then begin glBindTexture(GL_TEXTURE_2D, FTex); glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, FTexX, FTexY, GL_BGR, GL_UNSIGNED_BYTE, @FrameDataPtr[0]); glBindTexture(GL_TEXTURE_2D, 0); FGrabFrameFlag := true; WDMSample.Start; end; end; procedure wStopWebCam(); begin if WebCamReady and FGrabFrameFlag then begin FGrabFrameFlag := false; WDMSample.Stop; end; end; procedure wInit; const width = 320; height = 240; begin if WebCamReady then exit; WebCamReady := false; if(Ini.EnableWebCam=0) then exit; if (Length(GetCapDevices())-1 < Ini.WebCamID) then Exit; try WDMSample := TSampleClass.Create(Ini.WebCamID, Ini.WebCamMediaID); except wClose; Log.LogError('Error init WDM (UWebCam.wInitWDM)'); Exit; end; FTexX := width; FTexY := height; FdataX := Round(Power(2, Ceil(Log2(FTexX)))); FdataY := Round(Power(2, Ceil(Log2(FTexY)))); FrameDataPtr:=WDMSample.FramePtr; glGenTextures(1, @FTex); glBindTexture(GL_TEXTURE_2D, FTex); glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_PRIORITY, 1.0); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); glTexImage2D(GL_TEXTURE_2D, 0, 3, FdataX, FdataY, 0, GL_BGR, GL_UNSIGNED_BYTE, nil); glBindTexture(GL_TEXTURE_2D, 0); FGrabFrameFlag := false; WebCamReady := true; end; procedure UploadNewFrame; begin if (not WDMSample.CapStatus) then exit; FrameDataPtr := WDMSample.FramePtr; if (FTexX<>WDMSample.GetWidth) or (FTexY<>WDMSample.GetHeight) then begin FTexX := WDMSample.GetWidth; FTexY := WDMSample.GetHeight; FdataX := Round(Power(2, Ceil(Log2(FTexX)))); FdataY := Round(Power(2, Ceil(Log2(FTexY)))); glGenTextures(1, @FTex); glBindTexture(GL_TEXTURE_2D, FTex); glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_PRIORITY, 1.0); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); glTexImage2D(GL_TEXTURE_2D, 0, 3, FdataX, FdataY, 0, GL_BGR, GL_UNSIGNED_BYTE, nil); glBindTexture(GL_TEXTURE_2D, 0); end; glBindTexture(GL_TEXTURE_2D, FTex); glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, FTexX, FTexY, GL_BGR, GL_UNSIGNED_BYTE, @FrameDataPtr[0]); glBindTexture(GL_TEXTURE_2D, 0); WDMSample.TriggerCapture; end; procedure wDraw(DoDraw: boolean; Screen: integer); var SRect: record left, right, upper, lower: double; end; ScreenAspect: double; CamAspect: double; ScaledVideoWidth: double; ScaledVideoHeight: double; begin if not WebCamReady then exit; if DoDraw then begin try UploadNewFrame; except wClose; Log.LogError('Error Uploading new Frame (UWebCam.wDraw)'); Exit; end; end else Exit; ScreenAspect := (ScreenW/Screens) / ScreenH; CamAspect := FTexX/FTexY; if (ScreenAspect >= 1) then begin ScaledVideoWidth := RenderW; ScaledVideoHeight := RenderH * ScreenAspect/CamAspect; end else begin ScaledVideoHeight := RenderH; ScaledVideoWidth := RenderW * CamAspect/ScreenAspect; end; SRect.left := (RenderW - ScaledVideoWidth) / 2; SRect.right := SRect.left + ScaledVideoWidth; SRect.lower := (RenderH - ScaledVideoHeight) / 2; SRect.upper := SRect.lower + ScaledVideoHeight; if (Screen=1) then begin glClearColor(0,0,0,1); glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); end; glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); glColor4f(1, 1, 1, 1); glBindTexture(GL_TEXTURE_2D, FTex); glbegin(gl_quads); // upper-left coord glTexCoord2f(FTexX/FdataX, 0); glVertex2f(SRect.left, SRect.upper); // lower-left coord glTexCoord2f(FTexX/FdataX, FTexY/FdataY); glVertex2f(SRect.left, SRect.lower); // lower-right coord glTexCoord2f(0, FTexY/FdataY); glVertex2f(SRect.Right, SRect.lower); // upper-right coord glTexCoord2f(0, 0); glVertex2f(SRect.Right, SRect.upper); glEnd; glDisable(GL_BLEND); end; procedure wClose(); begin WebCamReady := false; FGrabFrameFlag := false; if (WDMSample<>nil) then begin WDMSample.Terminate; WDMSample.WaitFor; WDMSample.Free; WDMSample := nil; end; if(frame<>nil) then FreeMem(frame); frame := nil; WebCamReady := false; glDeleteTextures(1, @FTex); end; end.