Databases
StackOverflow2013
Postsdbo
POGetting a snapshot from a webcam with Delphi
 

Note that there are some explanatory texts on larger screens.

plurals
  1. POGetting a snapshot from a webcam with Delphi
    primarykey
    data
    text
    <p>I need to get a regular snapshot from a webcam in Delphi. Speed is not a problem (once a second is fine). I have tried demo code from based on stuff from <a href="http://delphi.pjh2.de/" rel="noreferrer">http://delphi.pjh2.de</a> but I can't get it to work. It compiles and runs OK but the callback function never fires.</p> <p>I don't have a real webcam but am running instead a simulator. The simulator works (I can see the video using Skype) but not with the test app. I don't really know where to start looking...</p> <p>Can anyone be bothered to try this code? (Apologies for the voluminous post - couldn't find how or if you can attach files - a zip file is available <a href="http://docs.google.com/uc?id=0Bz3Kt0tCTCQ3YzYzOWVlNjctYTk5Zi00MmVjLTgxNWEtMTMyMTA3YWUzODU1&amp;export=download&amp;hl=en" rel="noreferrer">here</a>.)</p> <p>Alternatively, any webcam demo code would be appreciated, preferably with a known good EXE as well as source.</p> <pre><code>program WebCamTest; uses Forms, WebCamMainForm in 'WebCamMainForm.pas' {Form1}, yuvconverts in 'yuvconverts.pas'; {$R *.res} begin Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end. unit WebCamMainForm; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, YUVConverts, StdCtrls, JPeg {, TntStdCtrls} ; const WM_CAP_START = WM_USER; WM_CAP_DRIVER_CONNECT = WM_CAP_START+ 10; WM_CAP_SET_PREVIEW = WM_CAP_START+ 50; WM_CAP_SET_OVERLAY = WM_CAP_START+ 51; WM_CAP_SET_PREVIEWRATE = WM_CAP_START+ 52; WM_CAP_GRAB_FRAME_NOSTOP = WM_CAP_START+ 61; WM_CAP_SET_CALLBACK_FRAME = WM_CAP_START+ 5; WM_CAP_GET_VIDEOFORMAT = WM_CAP_START+ 44; WM_CAP_DLG_VIDEOFORMAT = WM_CAP_START+ 41; PICWIDTH= 640; PICHEIGHT= 480; SUBLINEHEIGHT= 18; EXTRAHEIGHT= 400; type TVIDEOHDR= record lpData: Pointer; // address of video buffer dwBufferLength: DWord; // size, in bytes, of the Data buffer dwBytesUsed: DWord; // see below dwTimeCaptured: DWord; // see below dwUser: DWord; // user-specific data dwFlags: DWord; // see below dwReserved1, dwReserved2, dwReserved3: DWord; // reserved; do not use end; TVIDEOHDRPtr= ^TVideoHDR; DWordDim= array[1..PICWIDTH] of DWord; TForm1 = class(TForm) Timer1: TTimer; Panel1: TPanel; procedure FormDestroy(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormActivate(Sender: TObject); procedure Timer1Timer(Sender: TObject); private FCapHandle: THandle; FCodec: TVideoCodec; FBuf1, FBuf2: array[1..PICHEIGHT] of DWordDim; FBitmap: TBitmap; FJpeg: TJPegImage; { Private-Deklarationen } public { Public-Deklarationen } end; var Form1: TForm1; implementation {$R *.dfm} function capCreateCaptureWindow(lpszWindowName: LPCSTR; dwStyle: DWORD; x, y, nWidth, nHeight: integer; hwndParent: HWND; nID: integer): HWND; stdcall; external 'AVICAP32.DLL' name 'capCreateCaptureWindowA'; function FrameCallbackFunction(AHandle: hWnd; VIDEOHDR: TVideoHDRPtr): bool; stdcall; var I: integer; begin result:= true; with form1 do begin try ConvertCodecToRGB(FCodec, VideoHDR^.lpData, @FBuf2, PICWIDTH, PICHEIGHT); for I:= 1 to PICHEIGHT do FBuf1[I]:= FBuf2[PICHEIGHT- (I- 1)]; SetBitmapBits(FBitmap.Handle, PICWIDTH* PICHEIGHT* SizeOf(DWord), @FBuf1); FBitmap.Canvas.Brush.Color:= clWhite; FBitmap.Canvas.Font.Color:= clRed; FJpeg.Assign(FBitmap); FJpeg.CompressionQuality:= 85; FJpeg.ProgressiveEncoding:= true; FJpeg.SaveToFile('c:\webcam.jpg'); SendMessage(FCapHandle, WM_CAP_SET_CALLBACK_FRAME, 0, 0); except end; end; end; //------------------------------------------------------------------------------ procedure TForm1.FormCreate(Sender: TObject); var BitmapInfo: TBitmapInfo; begin Timer1.Enabled := false; FBitmap:= TBitmap.Create; FBitmap.Width:= PICWIDTH; FBitmap.Height:= PICHEIGHT+ SUBLINEHEIGHT+ EXTRAHEIGHT; FBitmap.PixelFormat:= pf32Bit; FBitmap.Canvas.Font.Assign(Panel1.Font); FBitmap.Canvas.Brush.Style:= bssolid; FBitmap.Canvas.Rectangle(0, PICHEIGHT, PICWIDTH, PICHEIGHT+ SUBLINEHEIGHT); FJpeg:= TJpegImage.Create; FCapHandle:= capCreateCaptureWindow('Video', WS_CHILD or WS_VISIBLE, 0, 0, PICWIDTH, PICHEIGHT, Panel1.Handle, 1); SendMessage(FCapHandle, WM_CAP_DRIVER_CONNECT, 0, 0); SendMessage(FCapHandle, WM_CAP_SET_PREVIEWRATE, 15000, 0); sendMessage(FCapHandle, WM_CAP_SET_OVERLAY, 1, 0); SendMessage(FCapHandle, WM_CAP_SET_PREVIEW, 1, 0); // SendMessage(FCapHandle, WM_CAP_DLG_VIDEOFORMAT,1,0); // -this was commented out FillChar(BitmapInfo, SizeOf(BitmapInfo), 0); SendMessage(FCapHandle, WM_CAP_GET_VIDEOFORMAT, SizeOf(BitmapInfo), Integer(@BitmapInfo)); FCodec:= BICompressionToVideoCodec(bitmapinfo.bmiHeader.biCompression); if FCodec&lt;&gt; vcUnknown then begin Timer1.Enabled:= true; end; end; procedure TForm1.FormDestroy(Sender: TObject); begin FBitmap.Free; FJpeg.Free; end; procedure TForm1.FormActivate(Sender: TObject); begin if FCodec= vcUnknown then showMessage('unknown compression'); FBitmap.Height:= PICHEIGHT+ SUBLINEHEIGHT; end; //------------------------------------------------------------------------------ procedure TForm1.Timer1Timer(Sender: TObject); begin SendMessage(FCapHandle, WM_CAP_SET_CALLBACK_FRAME, 0, integer(@FrameCallbackFunction)); SendMessage(FCapHandle, WM_CAP_GRAB_FRAME_NOSTOP, 1, 0); // ist hintergrundlauff盲hig end; end. object Form1: TForm1 Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 301 ClientWidth = 562 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False OnActivate = FormActivate OnCreate = FormCreate OnDestroy = FormDestroy PixelsPerInch = 96 TextHeight = 13 object Panel1: TPanel Left = 48 Top = 16 Width = 185 Height = 145 Caption = 'Panel1' TabOrder = 0 end object Timer1: TTimer OnTimer = Timer1Timer Left = 464 Top = 24 end end {**************************************************************************************************} { } { YUVConverts } { } { The contents of this file are subject to the Y Library Public License Version 1.0 (the } { "License"); you may not use this file except in compliance with the License. You may obtain a } { copy of the License at http://delphi.pjh2.de/ } { } { Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } { ANY KIND, either express or implied. See the License for the specific language governing } { rights and limitations under the License. } { } { The Original Code is: YUVConverts.pas, part of CapDemoC.dpr. } { The Initial Developer of the Original Code is Peter J. Haas (libs@pjh2.de). Portions created } { by Peter J. Haas are Copyright (C) 2000-2005 Peter J. Haas. All Rights Reserved. } { } { Contributor(s): } { } { You may retrieve the latest version of this file at the homepage of Peter J. Haas, located at } { http://delphi.pjh2.de/ } { } {**************************************************************************************************} // For history see end of file {$ALIGN ON, $BOOLEVAL OFF, $LONGSTRINGS ON, $IOCHECKS ON, $WRITEABLECONST OFF, $OVERFLOWCHECKS OFF} {$RANGECHECKS OFF, $TYPEDADDRESS ON, $MINENUMSIZE 1} unit yuvconverts; interface uses Windows; type TVideoCodec = (vcUnknown, vcRGB, vcYUY2, vcUYVY, vcBTYUV, vcYVU9, vcYUV12, vcY8, vcY211); const BI_YUY2 = $32595559; // 'YUY2' BI_UYVY = $59565955; // 'UYVY' BI_BTYUV = $50313459; // 'Y41P' BI_YVU9 = $39555659; // 'YVU9' planar BI_YUV12 = $30323449; // 'I420' planar BI_Y8 = $20203859; // 'Y8 ' BI_Y211 = $31313259; // 'Y211' function BICompressionToVideoCodec(Value: DWord): TVideoCodec; function ConvertCodecToRGB(Codec: TVideoCodec; Src, Dst: Pointer; AWidth, AHeight: Integer): Boolean; implementation function BICompressionToVideoCodec(Value: DWord): TVideoCodec; begin case Value of BI_RGB, BI_BITFIELDS: Result := vcRGB; // no RLE BI_YUY2: Result := vcYUY2 ; BI_UYVY: Result := vcUYVY ; BI_BTYUV: Result := vcBTYUV; BI_YVU9: Result := vcYVU9; BI_YUV12: Result := vcYUV12; BI_Y8: Result := vcY8; BI_Y211: Result := vcY211; else Result := vcUnknown; end; end; const // RGB255 ColorFAQ fY = 298.082 / 256; fRU = 0; fGU = -100.291 / 256; fBU = 516.411 / 256; fRV = 408.583 / 256; fGV = -208.120 / 256; fBV = 0; { // RGB219 ColorFAQ too dark fY = 256 / 256; fRU = 0; fGU = -86.132 / 256; fBU = 443.506 / 256; fRV = 350.901 / 256; fGV = -178.738 / 256; fBV = 0; } { // Earl same like RGB255 fY = 1.164; fRU = 0; fGU = -0.392; fBU = 2.017; fRV = 1.596; fGV = -0.813; fBV = 0; } // |R| |fY fRU fRV| |Y| | 16| // |G| = |fY fGU fGV| * |U| - |128| // |B| |fY fBU fBV| |V| |128| type TYUV = packed record Y, U, V, F1: Byte; end; PBGR32 = ^TBGR32; TBGR32 = packed record B, G, R, A: Byte; end; function YUVtoBGRAPixel(AYUV: DWord): DWord; var ValueY, ValueU, ValueV: Integer; ValueB, ValueG, ValueR: Integer; begin ValueY := TYUV(AYUV).Y - 16; ValueU := TYUV(AYUV).U - 128; ValueV := TYUV(AYUV).V - 128; ValueB := Trunc(fY * ValueY + fBU * ValueU); // fBV = 0 if ValueB &gt; 255 then ValueB := 255; if ValueB &lt; 0 then ValueB := 0; ValueG := Trunc(fY * ValueY + fGU * ValueU + fGV * ValueV); if ValueG &gt; 255 then ValueG := 255; if ValueG &lt; 0 then ValueG := 0; ValueR := Trunc(fY * ValueY + fRV * ValueV); // fRU = 0 if ValueR &gt; 255 then ValueR := 255; if ValueR &lt; 0 then ValueR := 0; with TBGR32(Result) do begin B := ValueB; G := ValueG; R := ValueR; A := 0; end; end; type TDWordRec = packed record case Integer of 0: (B0, B1, B2, B3: Byte); 1: (W0, W1: Word); end; // UYVY // YUV 4:2:2 (Y sample at every pixel, U and V sampled at every second pixel // horizontally on each line). A macropixel contains 2 pixels in 1 DWord. // 16 Bits per Pixel, 4 Byte Macropixel // U0 Y0 V0 Y1 procedure UYVYtoRGB(Src, Dst: Pointer; AWidth, AHeight: Integer); type PUYVY = ^TUYVY; TUYVY = packed record U, Y0, V, Y1: Byte; end; var x, y: Integer; w: Integer; SrcPtr: PDWord; DstPtr: PDWord; SrcLineSize: Integer; DstLineSize: Integer; YUV: DWord; b: Byte; begin SrcLineSize := AWidth * 2; DstLineSize := AWidth * 4; // Dst is Bottom Top Bitmap Inc(PByte(Dst), (AHeight - 1) * DstLineSize); w := (AWidth div 2) - 1; { TODO : bei ungeraden Breiten fehlt letztes Pixel } for y := 0 to AHeight - 1 do begin SrcPtr := Src; DstPtr := Dst; for x := 0 to w do begin YUV := SrcPtr^; // First Pixel b := TDWordRec(YUV).B0; TDWordRec(YUV).B0 := TDWordRec(YUV).B1; TDWordRec(YUV).B1 := b; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); // Second Pixel TDWordRec(YUV).B0 := TDWordRec(YUV).B3; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Inc(SrcPtr); end; Dec(PByte(Dst), DstLineSize); Inc(PByte(Src), SrcLineSize); end; end; // YUY2, YUNV, V422 // YUV 4:2:2 as for UYVY but with different component ordering within the DWord // macropixel. // 16 Bits per Pixel, 4 Byte Macropixel // Y0 U0 Y1 V0 procedure YUY2toRGB(Src, Dst: Pointer; AWidth, AHeight: Integer); var x, y: Integer; w: Integer; SrcPtr: PDWord; DstPtr: PDWord; SrcLineSize: Integer; DstLineSize: Integer; YUV: DWord; b: Byte; begin SrcLineSize := AWidth * 2; DstLineSize := AWidth * 4; // Dst is Bottom Top Bitmap Inc(PByte(Dst), (AHeight - 1) * DstLineSize); w := (AWidth div 2) - 1; { TODO : bei ungeraden Breiten fehlt letztes Pixel } for y := 0 to AHeight - 1 do begin SrcPtr := Src; DstPtr := Dst; for x := 0 to w do begin YUV := SrcPtr^; // First Pixel b := TDWordRec(YUV).B2; // Y0 U Y1 V -&gt; Y0 U V Y1 TDWordRec(YUV).B2 := TDWordRec(YUV).B3; TDWordRec(YUV).B3 := b; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); // Second Pixel TDWordRec(YUV).B0 := TDWordRec(YUV).B3; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Inc(SrcPtr); end; Dec(PByte(Dst), DstLineSize); Inc(PByte(Src), SrcLineSize); end; end; // BTYUV, I42P // YUV 4:1:1 (Y sample at every pixel, U and V sampled at every fourth pixel // horizontally on each line). A macropixel contains 8 pixels in 3 DWords. // 16 Bits per Pixel, 12 Byte Macropixel // U0 Y0 V0 Y1 U4 Y2 V4 Y3 Y4 Y5 Y6 Y7 procedure BTYUVtoRGB(Src, Dst: Pointer; AWidth, AHeight: Integer); type PBTYUVPixel = ^TBTYUVPixel; TBTYUVPixel = packed record U0, Y0, V0, Y1, U4, Y2, V4, Y3, Y4, Y5, Y6, Y7: Byte; end; var x, y: Integer; w: Integer; SrcPtr: PBTYUVPixel; DstPtr: PDWord; SrcLineSize: Integer; DstLineSize: Integer; YUV: DWord; SrcPixel: TBTYUVPixel; begin SrcLineSize := ((AWidth + 7) div 8) * (3 * 4); DstLineSize := AWidth * 4; w := AWidth - 1; for y := 0 to AHeight - 1 do begin SrcPtr := Src; DstPtr := Dst; x := w; while x &gt; 0 do begin // read macropixel SrcPixel := SrcPtr^; // First 4 Pixel TYUV(YUV).U := SrcPixel.U0; TYUV(YUV).V := SrcPixel.V0; TYUV(YUV).Y := SrcPixel.Y0; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Dec(x); if x &lt;= 0 then Break; TYUV(YUV).Y := SrcPixel.Y1; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Dec(x); if x &lt;= 0 then Break; TYUV(YUV).Y := SrcPixel.Y2; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Dec(x); if x &lt;= 0 then Break; TYUV(YUV).Y := SrcPixel.Y3; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Dec(x); if x &lt;= 0 then Break; // Second 4 Pixel TYUV(YUV).U := SrcPixel.U4; TYUV(YUV).V := SrcPixel.V4; TYUV(YUV).Y := SrcPixel.Y4; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Dec(x); if x &lt;= 0 then Break; TYUV(YUV).Y := SrcPixel.Y5; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Dec(x); if x &lt;= 0 then Break; TYUV(YUV).Y := SrcPixel.Y6; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Dec(x); if x &lt;= 0 then Break; TYUV(YUV).Y := SrcPixel.Y7; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Inc(SrcPtr); end; Inc(PByte(Dst), DstLineSize); Inc(PByte(Src), SrcLineSize); end; end; // YVU9 // 8 bit Y plane followed by 8 bit 4x4 subsampled V and U planes. // 9 Bits per Pixel, planar format procedure YVU9toRGB(Src, Dst: Pointer; AWidth, AHeight: Integer); var x, y, r, l: Integer; w: Integer; SrcYPtr: PByte; SrcUPtr: PByte; SrcVPtr: PByte; DstPtr: PDWord; SrcYLineSize: Integer; SrcUVLineSize: Integer; DstLineSize: Integer; YUV: DWord; begin DstLineSize := AWidth * 4; SrcYLineSize := AWidth; SrcUVLineSize := (AWidth + 3) div 4; // Dst is Bottom Top Bitmap Inc(PByte(Dst), (AHeight - 1) * DstLineSize); SrcYPtr := Src; SrcVPtr := PByte(LongInt(SrcYPtr) + SrcYLineSize * AHeight); SrcUPtr := PByte(LongInt(SrcVPtr) + SrcUVLineSize * ((AHeight + 3) div 4)); w := (AWidth div 4) - 1; { TODO : bei ungeraden Breiten fehlt letztes Pixel } for y := 0 to (AHeight div 4) - 1 do begin { TODO : bei ungeraden H枚hen fehlt letzte Reihe } for l := 0 to 3 do begin DstPtr := Dst; for x := 0 to w do begin // U and V YUV := (SrcUPtr^ shl 8) or (SrcVPtr^ shl 16); for r := 0 to 3 do begin YUV := (YUV and $00FFFF00) or SrcYPtr^; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Inc(SrcYPtr); end; Inc(SrcUPtr); Inc(SrcVPtr); end; Dec(PByte(Dst), DstLineSize); if l &lt; 3 then begin Dec(SrcUPtr, SrcUVLineSize); Dec(SrcVPtr, SrcUVLineSize); end; end; end; end; // YUV12, I420, IYUV // 8 bit Y plane followed by 8 bit 2x2 subsampled U and V planes. // 12 Bits per Pixel, planar format procedure YUV12toRGB(Src, Dst: Pointer; AWidth, AHeight: Integer); // I420, IYUV var x, y, l: Integer; w: Integer; SrcYPtr: PByte; SrcUPtr: PByte; SrcVPtr: PByte; DstPtr: PDWord; SrcYLineSize: Integer; SrcUVLineSize: Integer; DstLineSize: Integer; YUV: DWord; begin DstLineSize := AWidth * 4; SrcYLineSize := AWidth; SrcUVLineSize := (AWidth + 1) div 2; // Dst is Bottom Top Bitmap Inc(PByte(Dst), (AHeight - 1) * DstLineSize); SrcYPtr := Src; SrcUPtr := PByte(LongInt(SrcYPtr) + SrcYLineSize * AHeight); SrcVPtr := PByte(LongInt(SrcUPtr) + SrcUVLineSize * ((AHeight + 1) div 2)); w := (AWidth div 2) - 1; { TODO : bei ungeraden Breiten fehlt letztes Pixel } for y := 0 to (AHeight div 2) - 1 do begin { TODO : bei ungeraden H枚hen fehlt letzte Reihe } for l := 0 to 1 do begin DstPtr := Dst; for x := 0 to w do begin // First Pixel YUV := SrcYPtr^ or (SrcUPtr^ shl 8) or (SrcVPtr^ shl 16); DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Inc(SrcYPtr); // Second Pixel YUV := (YUV and $00FFFF00) or SrcYPtr^; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Inc(SrcYPtr); Inc(SrcUPtr); Inc(SrcVPtr); end; Dec(PByte(Dst), DstLineSize); if l = 0 then begin Dec(SrcUPtr, SrcUVLineSize); Dec(SrcVPtr, SrcUVLineSize); end; end; end; end; // Y8, Y800 // Simple, single Y plane for monochrome images. // 8 Bits per Pixel, planar format procedure Y8toRGB(Src, Dst: Pointer; AWidth, AHeight: Integer); var x, y: Integer; w: Integer; SrcPtr: PByte; DstPtr: PDWord; SrcLineSize: Integer; DstLineSize: Integer; Pixel: DWord; begin SrcLineSize := AWidth; DstLineSize := AWidth * 4; // Dst is Bottom Top Bitmap Inc(PByte(Dst), (AHeight - 1) * DstLineSize); w := (AWidth) - 1; for y := 0 to AHeight - 1 do begin SrcPtr := Src; DstPtr := Dst; for x := 0 to w do begin Pixel := SrcPtr^; TDWordRec(Pixel).B1 := TDWordRec(Pixel).B0; TDWordRec(Pixel).B2 := TDWordRec(Pixel).B0; TDWordRec(Pixel).B3 := 0; DstPtr^ := Pixel; Inc(DstPtr); Inc(SrcPtr); end; Dec(PByte(Dst), DstLineSize); Inc(PByte(Src), SrcLineSize); end; end; // Y211 // Packed YUV format with Y sampled at every second pixel across each line // and U and V sampled at every fourth pixel. // 8 Bits per Pixel, 4 Byte Macropixel // Y0, U0, Y2, V0 procedure Y211toRGB(Src, Dst: Pointer; AWidth, AHeight: Integer); type PYUYV = ^TYUYV; TYUYV = packed record Y0, U, Y2, V: Byte; end; var x, y: Integer; w : Integer; SrcPtr : PDWord; DstPtr : PDWord; SrcLineSize : Integer; DstLineSize : Integer; YUV: DWord; BGR: DWord; b: Byte; begin SrcLineSize := ((AWidth + 3) div 4) * 4; DstLineSize := AWidth * 4; // Dst is Bottom Top Bitmap Inc(PByte(Dst), (AHeight - 1) * DstLineSize); w := (AWidth div 4) - 1; { TODO : bei ungeraden Breiten fehlt letztes Pixel } for y := 0 to AHeight - 1 do begin SrcPtr := Src; DstPtr := Dst; for x := 0 to w do begin // Y0 U Y2 V YUV := SrcPtr^; // First and second Pixel b := TDWordRec(YUV).B2; // Y0 U Y2 V -&gt; Y0 U V Y2 TDWordRec(YUV).B2 := TDWordRec(YUV).B3; TDWordRec(YUV).B3 := b; BGR := YUVtoBGRAPixel(YUV); DstPtr^ := BGR; Inc(DstPtr); DstPtr^ := BGR; Inc(DstPtr); // third and fourth TDWordRec(YUV).B0 := TDWordRec(YUV).B3; // Y0 U V Y2 -&gt; Y2 U V Y2 BGR := YUVtoBGRAPixel(YUV); DstPtr^ := BGR; Inc(DstPtr); DstPtr^ := BGR; Inc(DstPtr); Inc(SrcPtr); end; Dec(PByte(Dst), DstLineSize); Inc(PByte(Src), SrcLineSize); end; end; function ConvertCodecToRGB(Codec: TVideoCodec; Src, Dst: Pointer; AWidth, AHeight: Integer): Boolean; begin Result := True; case Codec of vcYUY2: YUY2toRGB (Src, Dst, AWidth, AHeight); vcUYVY: UYVYtoRGB (Src, Dst, AWidth, AHeight); vcBTYUV: BTYUVtoRGB(Src, Dst, AWidth, AHeight); vcYVU9: YVU9toRGB (Src, Dst, AWidth, AHeight); vcYUV12: YUV12toRGB(Src, Dst, AWidth, AHeight); vcY8: Y8toRGB (Src, Dst, AWidth, AHeight); vcY211: Y211toRGB (Src, Dst, AWidth, AHeight); else Result := False; end; end; // History: // 2005-02-12, Peter J. Haas // // 2002-02-22, Peter J. Haas // - add YVU9, YUV12 (I420) // - add Y211 (untested) // // 2001-06-14, Peter J. Haas // - First public version // - YUY2, UYVY, BTYUV (Y41P), Y8 end. </code></pre> <p>Some message results:</p> <pre><code>var MsgResult : Integer ; procedure TForm1.FormCreate(Sender: TObject); var BitmapInfo: TBitmapInfo; begin Timer1.Enabled := false; FBitmap:= TBitmap.Create; FBitmap.Width:= PICWIDTH; FBitmap.Height:= PICHEIGHT+ SUBLINEHEIGHT+ EXTRAHEIGHT; FBitmap.PixelFormat:= pf32Bit; FBitmap.Canvas.Font.Assign(Panel1.Font); FBitmap.Canvas.Brush.Style:= bssolid; FBitmap.Canvas.Rectangle(0, PICHEIGHT, PICWIDTH, PICHEIGHT+ SUBLINEHEIGHT); FJpeg:= TJpegImage.Create; FCapHandle:= capCreateCaptureWindow('Video', WS_CHILD or WS_VISIBLE, 0, 0, PICWIDTH, PICHEIGHT, Panel1.Handle, 1); // returns 2558326 MsgResult := SendMessage(FCapHandle, WM_CAP_DRIVER_CONNECT, 0, 0); // returns 0 MsgResult := SendMessage(FCapHandle, WM_CAP_SET_PREVIEWRATE, 15000, 0); // returns 1 MsgResult := sendMessage(FCapHandle, WM_CAP_SET_OVERLAY, 1, 0); // returns 0 MsgResult := SendMessage(FCapHandle, WM_CAP_SET_PREVIEW, 1, 0); // returns 0 // SendMessage(FCapHandle, WM_CAP_DLG_VIDEOFORMAT,1,0); // -this was commented out FillChar(BitmapInfo, SizeOf(BitmapInfo), 0); MsgResult := SendMessage(FCapHandle, WM_CAP_GET_VIDEOFORMAT, SizeOf(BitmapInfo), Integer(@BitmapInfo)); // returns 0 FCodec:= BICompressionToVideoCodec(bitmapinfo.bmiHeader.biCompression); // returns vcRGB if FCodec&lt;&gt; vcUnknown then begin Timer1.Enabled:= true; end; end; procedure TForm1.FormDestroy(Sender: TObject); begin FBitmap.Free; FJpeg.Free; end; procedure TForm1.FormActivate(Sender: TObject); begin if FCodec= vcUnknown then showMessage('unknown compression'); FBitmap.Height:= PICHEIGHT+ SUBLINEHEIGHT; end; //------------------------------------------------------------------------------ procedure TForm1.Timer1Timer(Sender: TObject); begin MsgResult := SendMessage(FCapHandle, WM_CAP_SET_CALLBACK_FRAME, 0, integer(@FrameCallbackFunction)); // returns 0 MsgResult := SendMessage(FCapHandle, WM_CAP_GRAB_FRAME_NOSTOP, 1, 0); // ist hintergrundlauff盲hig // returns 0 end; </code></pre>
    singulars
    1. PO
      singulars
      1. PTAnswer
    1. This table or related slice is empty.
    1. PTQuestion
    1. USrossmcm
    1. USrossmcm
    plurals
    1. This table or related slice is empty.
    1. PL
      singulars
      1. LTLinked
    2. PL
      singulars
      1. LTLinked
    3. PL
      singulars
      1. LTLinked
    1. This table or related slice is empty.
    1. PO
      singulars
      1. PTAnswer
    2. PO
      singulars
      1. PTAnswer
    1. VO
      singulars
      1. POGetting a snapshot from a webcam with Delphi
      1. This table or related slice is empty.
      1. VTUpMod
    2. VO
      singulars
      1. POGetting a snapshot from a webcam with Delphi
      1. USChristopher Chase
      1. VTFavorite
    3. VO
      singulars
      1. POGetting a snapshot from a webcam with Delphi
      1. This table or related slice is empty.
      1. VTUpMod
    1. COAre any of the WM_CAP... messages returning errors?
      singulars
      1. POGetting a snapshot from a webcam with Delphi
      1. USRemy Lebeau
    2. COHi Remy, see my edits to the question - message results are comments out to the right. Thanks. R.
      singulars
      1. POGetting a snapshot from a webcam with Delphi
      1. USrossmcm
 

Querying!

 
Guidance
A row detail

Detail views are divided into sections. All the information in the data section comes from columns in the selected row. The other sections display data from other, related rows.

Related data can be related in a to-one or a to-many fashion. Captions of data related in a to-many fashion link to a list view showing a filtered view of the table.

Try moving around until you find a non-empty to-many entry and click on the label to get to one. You can move back to the root by clicking on the database name in the header.

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload