1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161:
| unit webcamdriver;
interface
uses GR32, UConvert, Windows, Messages, ExtCtrls, SysUtils;
function capCreateCaptureWindow(lpszWindowName : LPCSTR; dwStyle : DWORD; x, y : Integer; nWidth : Integer; nHeight : Integer; hwndParent : HWND; nID : Integer ): HWND; stdcall; external 'AVICAP32.DLL' name 'capCreateCaptureWindowA';
type PVIDEOHDR = ^TVIDEOHDR; TVIDEOHDR = packed record lpData : PBYTE; dwBufferLength : DWORD; dwBytesUsed : DWORD; dwTimeCaptured : DWORD; dwUser : DWORD; dwFlags : DWORD; dwReserved : array[0..3] of DWORD; end;
type TWebcam = class private var CapHandle: HWND; w,h: Integer; const WM_CAP_SET_CALLBACK_FRAME = (WM_USER + 5); WM_CAP_DRIVER_CONNECT = (WM_USER + 10); WM_CAP_DRIVER_DISCONNECT = (WM_USER + 11); WM_CAP_EDIT_COPY = (WM_USER + 30); WM_CAP_DLG_VIDEOFORMAT = (WM_USER + 41); WM_CAP_DLG_VIDEOSOURCE = (WM_USER + 42); WM_CAP_DLG_VIDEODISPLAY = (WM_USER + 43); WM_CAP_GET_VIDEOFORMAT = (WM_USER + 44); WM_CAP_SET_VIDEOFORMAT = (WM_USER + 45); WM_CAP_DLG_VIDEOCOMPRESSION = (WM_USER + 46); WM_CAP_SET_PREVIEW = (WM_USER + 50); WM_CAP_SET_OVERLAY = (WM_USER + 51); WM_CAP_SET_PREVIEWRATE = (WM_USER + 52); WM_CAP_SET_SCALE = (WM_USER + 53); procedure bildgroesse_anpassen; public var resolution,bit,compression: string; Frame: TBitmap32; constructor create(FormHandle:HWND); function OnFrame(hCapWnd: HWND; lpVHDR: PVideoHdr): DWord; stdcall; procedure DLG_VideoSource; procedure DLG_VideoFormat; procedure DLG_VideoCompression; end;
implementation
function TWebcam.OnFrame(hCapWnd: HWND; lpVHDR: PVideoHdr): DWord; stdcall; var BitmapInfo: TBitmapInfo; src, dest: Pointer; begin Result:=1; FillChar(BitmapInfo, SizeOf(BitmapInfo), 0); SendMessage(CapHandle, WM_CAP_GET_VIDEOFORMAT, SizeOf(BitmapInfo), Integer(@BitmapInfo));
src:=lpVHdr^.lpData; dest:=Frame.ScanLine[0];
case bitmapinfo.bmiHeader.biCompression of BI_RGB: case bitmapinfo.bmiHeader.biBitCount of 16: Conv16To32(src, dest, w, h); 24: Conv24To32(src, dest, w, h); 32: Move(src^, dest^, w*h*4); end; UYVY: UYVYtoARGB(src, dest, w, h); YUY2: YUY2toARGB(src, dest, w, h); I420: I420toARGB(src, dest, w, h); end;
Frame.Changed; end;
constructor TWebcam.create(FormHandle:HWND); begin inherited Create; CapHandle:=capCreateCaptureWindow('Video', ws_child + ws_visible, 0, 0, 1, 1, FormHandle, 1);
SendMessage(CapHandle, WM_CAP_DRIVER_CONNECT, 0, 0); SendMessage(CapHandle, WM_CAP_SET_PREVIEWRATE,1, 0); sendMessage(Caphandle, WM_CAP_SET_OVERLAY, 1, 0); SendMessage(CapHandle, WM_CAP_SET_CALLBACK_FRAME, 0, Integer(@TWebcam.OnFrame));
Frame:=TBitmap32.Create; bildgroesse_anpassen;
end;
procedure TWebcam.bildgroesse_anpassen; var BitmapInfo: TBitmapInfo; begin SendMessage(CapHandle, WM_CAP_GET_VIDEOFORMAT, SizeOf(BitmapInfo), Integer(@BitmapInfo)); w:=bitmapinfo.bmiHeader.biWidth; h:=bitmapinfo.bmiHeader.biHeight; Frame.SetSize(w, h); resolution:=IntToStr(w)+'x'+IntToStr(h); bit:=IntToStr(bitmapinfo.bmiHeader.biBitCount)+'bit'; compression:=GETFOURCC(bitmapinfo.bmiHeader.biCompression); end;
procedure TWebcam.DLG_VideoFormat; begin sendMessage(CapHandle, WM_CAP_DLG_VIDEOFORMAT, 1, 0); bildgroesse_anpassen; end; procedure TWebcam.DLG_VideoSource; begin sendMessage(CapHandle, WM_CAP_DLG_VIDEOSOURCE, 1, 0); bildgroesse_anpassen; end;
procedure TWebcam.DLG_VideoCompression; begin sendMessage(CapHandle, WM_CAP_DLG_VIDEOCOMPRESSION, 1, 0); bildgroesse_anpassen; end;
end. |