(* ImageEn Build 7.0.0.06.2637 @ 7-4-17 14:58:42.679 *) (* Copyright (c) 1998-2017 by Carlotta Calandra. All rights reserved. Copyright (c) 2011-2017 by Xequte Software. This software comes without express or implied warranty. In no case shall the author be liable for any damage or unwanted behavior of any computer hardware and/or software. Author grants you the right to include the component in your application, whether COMMERCIAL, SHAREWARE, or FREEWARE. ImageEn, IEvolution and ImageEn ActiveX may not be included in any commercial, shareware or freeware libraries or components. www.ImageEn.com *) (* File version 1006 *) unit hvideocap; {$R-} {$Q-} {$I ie.inc} {$IFDEF IEINCLUDEVIDEOCAPTURE} interface uses Windows, Messages, SysUtils, StdCtrls, Classes, Graphics, Controls, Forms, ImageEnView, ImageEnProc, hyiedefs, videocap, ieview, iexBitmaps; const VH_FRAMEMESSAGE = WM_USER + 5000; VH_DESTROYWINDOW = WM_USER + 5001; type {!! TImageEnVideoCap Description TImageEnVideoCap is a non-visual component which can capture images from video cameras. It uses VFW (Video for Windows) to capture frames from a video source. It is recommended that you now use .. to capture video from cameras, because it uses the more widely supported DirectShow API. This component is deprecated. See also - Methods and Properties Events !!} {$ifdef IEHASPLATFORMATTRIBUTE} [ComponentPlatformsAttribute(pidWin32 or pidWin64)] {$endif} TImageEnVideoCap = class(TComponent) private fCapture: boolean; // if true starts capture fWndC: HWND; // Video Capture Window handle (0=to create) fDrivers: TStringList; // available drivers fVideoSource: integer; // index of current video capture source fCallBackFrame: boolean; // If True activates CallBackFrameFunc callback fOnVideoFrame: TVideoFrameEvent; fOnVideoFrameRaw: TVideoFrameRawEvent; fhBitmapInfo: THandle; // BitmapInfo Handle filled by FillBitmapInfo fBitmapInfoUp: boolean; // true if fhBitmapInfo is updated (used in FillBitmapInfo) fConnected: boolean; // true if connected to capture driver fOnJob: TIEJobEvent; fHDrawDib: HDRAWDIB; fBitmap: TIEDibBitmap; fPix: pointer; fDone: boolean; fDriverBusy: boolean; fEnding: boolean; fUseWindowsCodec: boolean; // recording support fRecFileName: String; // destination file name fRecFrameRate: integer; // frames per second (dwRequestMicroSecPerFrame) fRecAudio: boolean; // true enables audio capture (fCaptureAudio) fRecMultitask: boolean; // false disables multitasking (fYeld) [ESC=abort] fRecording: boolean; // true if we are recording fWinHandle: HWND; protected procedure SetCapture(v: boolean); procedure DriverConnect; function DriverConnectNE: boolean; procedure DriverDisconnect; procedure FillDrivers; procedure SetVideoSource(v: integer); function GetHasDlgVideoSource: boolean; function GetHasDlgVideoFormat: boolean; function GetHasDlgVideoDisplay: boolean; function GetHasOverlay: boolean; procedure GetCaps(var fDriverCaps: TCAPDRIVERCAPS); procedure SetCallBackFrame(v: boolean); procedure SetOnVideoFrame(v: TVideoFrameEvent); procedure SetOnVideoFrameRaw(v: TVideoFrameRawEvent); function FillBitmapInfo: boolean; procedure CreateCaptureWindow; procedure DestroyCaptureWindow; procedure DoJob(job: TIEJob; per: integer); procedure AllocateWindow; function GetAudioFormat: word; procedure SetAudioFormat(v: word); function GetAudioChannels: word; procedure SetAudioChannels(v: word); function GetAudioSamplesPerSec: dword; procedure SetAudioSamplesPerSec(v: dword); function GetAudioBitsPerSample: word; procedure SetAudioBitsPerSample(v: word); procedure GetWaveFormat(var wf: TWAVEFORMATEX); procedure SetWaveFormat(var wf: TWAVEFORMATEX); public constructor Create(Owner: TComponent); override; destructor Destroy; override; property Capture: boolean read fCapture write SetCapture default false; function DoConfigureSource: boolean; function DoConfigureFormat: boolean; function DoConfigureDisplay: boolean; function DoConfigureCompression: boolean; {!! TImageEnVideoCap.VideoSourceList Declaration property VideoSourceList: TStringList; Description This is the list of video capture (video source) drivers installed on the system. The format is: "Device_Name Device_Version". The index of the list corresponds to VideoSource property value. Read-only !!} property VideoSourceList: TStringList read fDrivers; {!! TImageEnVideoCap.HasOverlay Declaration property HasOverlay: boolean; Description Returns True if the selected driver supports Overlay display mode. Read-only !!} property HasOverlay: boolean read GetHasOverlay; {!! TImageEnVideoCap.HasDlgVideoSource Declaration property HasDlgVideoSource: boolean; Description Returns True if the selected driver supports a Video Source Dialog. Read-only !!} property HasDlgVideoSource: boolean read GetHasDlgVideoSource; {!! TImageEnVideoCap.HasDlgVideoFormat Declaration property HasDlgVideoFormat: boolean; Description Returns True if the selected driver supports a Video Format Dialog. Read-only !!} property HasDlgVideoFormat: boolean read GetHasDlgVideoFormat; {!! TImageEnVideoCap.HasDlgVideoDisplay Declaration property HasDlgVideoDisplay: boolean; Description Returns True if the selected driver supports a Video Display Dialog. Read-only !!} property HasDlgVideoDisplay: boolean read GetHasDlgVideoDisplay; procedure StartRecord; procedure StopRecord; {!! TImageEnVideoCap.RecFileName Declaration property RecFileName: String Description RecFileName contains the file name (AVI file format) where to save the captured video input. Default: 'Capture.avi' !!} property RecFileName: String read fRecFileName write fRecFileName; {!! TImageEnVideoCap.RecFrameRate Declaration property RecFrameRate: integer; Description RecFrameRate is the number of frames per second captured on recording. Default: 15 !!} property RecFrameRate: integer read fRecFrameRate write fRecFrameRate; {!! TImageEnVideoCap.RecAudio Declaration property RecAudio: boolean; Description Set RecAudio to True to capture audio input with video input. Default: False !!} property RecAudio: boolean read fRecAudio write fRecAudio; {!! TImageEnVideoCap.RecMultitask Declaration property RecMultitask: boolean; Description If RecMultitask is False the system is locked to wait the end of recording. To stop recording press ESC. Default: True !!} property RecMultitask: boolean read fRecMultitask write fRecMultitask; {!! TImageEnVideoCap.WndCaptureHandle Declaration property WndCaptureHandle: HWND; Description WndCaptureHandle is the handle of the video capture window. It is useful to send messages to Video for Windows system. !!} property WndCaptureHandle: HWND read fWndC; property AudioFormat: word read GetAudioFormat write SetAudioFormat; property AudioChannels: word read GetAudioChannels write SetAudioChannels; property AudioSamplesPerSec: dword read GetAudioSamplesPerSec write SetAudioSamplesPerSec; property AudioBitsPerSample: word read GetAudioBitsPerSample write SetAudioBitsPerSample; // Video format function GetVideoSize: TRect; {!! TImageEnVideoCap.UseWindowsCodec Declaration property UseWindowsCodec: boolean; Description If UseWindowsCodec isTrue, TImageEnVideoCap uses Windows codec to render video stream, otherwise it uses internal codec. Default: True (Use Windows codecs) Try setting this property to False if you have problems with video capture. !!} property UseWindowsCodec: boolean read fUseWindowsCodec write fUseWindowsCodec; published {!! TImageEnVideoCap.VideoSource Declaration property VideoSource: integer; Description VideoSource property contains the index of the current video source (see VideoSourceList). Default: 0 !!} property VideoSource: integer read fVideoSource write SetVideoSource default 0; {!! TImageEnVideoCap.OnVideoFrame Declaration property OnVideoFrame: ; Description This event is generated for each input frame. If you handle this event, the performance of video input degrades. You haven’t to free this bitmap: ImageEn will free it. !!} property OnVideoFrame: TVideoFrameEvent read fOnVideoFrame write SetOnVideoFrame; {!! TImageEnVideoCap.OnVideoFrameRaw Declaration property OnVideoFrameRaw: ; Description This event is generated for each input frame (as OnVideoFrame). The TVideoFrameRawEvent function is defined in this way: You can modify the pixels (pData) because this event is generated before video source shows the frame. !!} property OnVideoFrameRaw: TVideoFrameRawEvent read fOnVideoFrameRaw write SetOnVideoFrameRaw; {!! TImageEnVideoCap.OnJob Declaration property OnJob: ; Description The OnJob event is generated on video capture jobs, as connecting, video format negotiations... Supported job of TImageEnVideoView have "iejVIDEOCAP_" prefix. See TIEJobEvent type for more details. Example procedure TForm1.ImageEnVideoView1Job(Sender: TObject; job: TIEJob; per: Integer); begin case job of iejNOTHING: Label8.Caption := ''; iejVIDEOCAP_CONNECTING: Label8.Caption := 'Connecting...'; iejVIDEOCAP_TRYVIDEOFORMATS: Label8.Caption := 'Trying supported video formats...'+inttostr(per)+'%'; iejVIDEOCAP_NEGOTIATINGVIDEOFORMAT: Label8.Caption := 'Negotiating video format...'; end; Application.ProcessMessages; end; !!} property OnJob: TIEJobEvent read fOnJob write fOnJob; end {$ifdef IEWarningForDeprecated} deprecated {$endif}; implementation uses hyieutils; {$R-} const DLL2 = 'AVICAP32.DLL'; // VIDEOCAP CONSTS WM_CAP_START = WM_USER; WM_CAP_GET_STATUS = WM_CAP_START + 54; WM_CAP_SET_CALLBACK_STATUS = WM_CAP_START + 3; WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10; WM_CAP_SEQUENCE = WM_CAP_START + 62; WM_CAP_STOP = WM_CAP_START + 69; WM_CAP_ABORT = WM_CAP_START + 68; WM_CAP_FILE_SET_CAPTURE_FILE = WM_CAP_START + 20; WM_CAP_SETPREVIEW = WM_CAP_START + 50; WM_CAP_SETPREVIEWRATE = WM_CAP_START + 52; WM_CAP_SETOVERLAY = WM_CAP_START + 51; WM_CAP_SET_SCALE = WM_CAP_START + 53; WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11; WM_CAP_GRAB_FRAME = WM_CAP_START + 60; WM_CAP_SET_CALLBACK_FRAME = WM_CAP_START + 5; WM_CAP_DLG_VIDEOFORMAT = WM_CAP_START + 41; WM_CAP_DLG_VIDEOSOURCE = WM_CAP_START + 42; WM_CAP_DLG_VIDEODISPLAY = WM_CAP_START + 43; WM_CAP_DRIVER_GET_CAPS = WM_CAP_START + 14; WM_CAP_GET_VIDEOFORMAT = WM_CAP_START + 44; WM_CAP_SET_VIDEOFORMAT = WM_CAP_START + 45; WM_CAP_DRIVER_GET_NAME = WM_CAP_START + 12; WM_CAP_SET_SEQUENCE_SETUP = WM_CAP_START + 64; WM_CAP_GET_SEQUENCE_SETUP = WM_CAP_START + 65; WM_CAP_DLG_VIDEOCOMPRESSION = WM_CAP_START + 46; WM_CAP_FILE_SAVEDIB = WM_CAP_START + 25; WM_CAP_EDIT_COPY = WM_CAP_START + 30; WM_CAP_SET_USER_DATA = WM_CAP_START + 9; WM_CAP_GET_USER_DATA = WM_CAP_START + 8; WM_CAP_SEQUENCE_NOFILE = WM_CAP_START + 63; WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START + 6; WM_CAP_SET_CALLBACK_YIELD = WM_CAP_START + 4; WM_CAP_SET_CALLBACK_ERROR = WM_CAP_START + 2; WM_CAP_SET_AUDIOFORMAT = WM_CAP_START + 35; WM_CAP_GET_AUDIOFORMAT = WM_CAP_START + 36; IDS_CAP_BEGIN = 300; // "Capture Start" IDS_CAP_END = 301; // "Capture End" // AVICAP function capCreateCaptureWindow(lpszWindowName: PChar; dwStyle: dword; x, y, nWidth, nHeight: integer; hwndParent: HWND; nID: integer): HWND; stdcall; external DLL2 name 'capCreateCaptureWindow' + IEDLLWNameExt; function capGetDriverDescription(wDriverIndex: integer; lpszName: PChar; cnName: integer; lpszVer: PChar; cbVer: integer): longbool; stdcall; external DLL2 name 'capGetDriverDescription' + IEDLLWNameExt; function CallBackFrameFunc(hWnd: HWND; lpVHdr: PVIDEOHDR): LRESULT; stdcall; forward; function CallBackYeldFunc(hWnd: HWND): LRESULT; stdcall; forward; function CallBackStatusFunc(hWnd: HWND; nID: integer; lpsz: PChar): LRESULT; stdcall; forward; function capErrorCallback(hWnd: HWND; nID: integer; lpsz: PChar): LRESULT; stdcall; forward; ///////////////////////////////////////////////////////////////////////////////////// constructor TImageEnVideoCap.Create(Owner: TComponent); begin inherited Create(Owner); // fUseWindowsCodec := true; fEnding := false; fCallBackFrame := false; fDrivers := TStringList.Create; fVideoSource := 0; FillDrivers; fWndC := 0; fCapture := false; fOnVideoFrame := nil; fhBitmapInfo := GlobalAlloc(GHND, sizeof(TBITMAPINFO) + sizeof(TRGBQUAD) * 256); fConnected := false; fBitmapInfoUp := false; fRecFileName := 'Capture.avi'; fRecFrameRate := 15; // 15 frames per second (dwRequestMicroSecPerFrame=66667) fRecAudio := false; fRecMultitask := true; fRecording := false; fOnJob := nil; fHDrawDib := IEDrawDibOpen; fBitmap := TIEDibBitmap.create; fPix := nil; fDone := true; fDriverBusy := false; AllocateWindow; end; ///////////////////////////////////////////////////////////////////////////////////// destructor TImageEnVideoCap.Destroy; begin if fCapture then SetCapture(false); // this calls also SetDisplayMode FreeAndNil(fDrivers); DestroyCaptureWindow; GlobalFree(fhBitmapInfo); IEDrawDibClose(fHDrawDib); FreeAndNil(fBitmap); PostMessage(fWinHandle, VH_DESTROYWINDOW, 0, 0); if fPix <> nil then freemem(fPix); inherited; end; ///////////////////////////////////////////////////////////////////////////////////// procedure TImageEnVideoCap.FillDrivers; var DeviceName: array[0..79] of Char; DeviceVersion: array[0..79] of Char; q: integer; begin fDrivers.Clear; for q := 0 to 9 do if capGetDriverDescription(q, DeviceName, 80, DeviceVersion, 80) then fDrivers.Add(string(DeviceName) + ' ' + string(DeviceVersion)); end; {!! TImageEnVideoCap.Capture Declaration property Capture: boolean; Description Set Capture to True to activate video frames capture. When Capture is True, video frames are sent to OnVideoFrame and OnVideoFrameRaw events. !!} procedure TImageEnVideoCap.SetCapture(v: boolean); var cp: TCAPTUREPARMS; begin if fWndC = 0 then CreateCaptureWindow; if v then begin // START VIDEO INPUT fEnding := false; fCapture := true; if fWndC <> 0 then begin if not fConnected then DriverConnect; SendMessage(fWndC, WM_CAP_SET_SCALE, 1, 0); SendMessage(fWndC, WM_CAP_SET_USER_DATA, 0, LPARAM(pointer(self))); // SendMessage(fWndC, WM_CAP_GET_SEQUENCE_SETUP, sizeof(cp), LPARAM(@cp)); cp.fAbortLeftMouse := false; cp.fAbortRightMouse := false; cp.fLimitEnabled := false; cp.dwRequestMicroSecPerFrame := round((1 / fRecFrameRate) * 1000000); cp.wPercentDropForError := 100; if fRecording then begin cp.fYield := fRecMultitask; cp.fCaptureAudio := fRecAudio; SendMessage(fWndC, WM_CAP_SET_SEQUENCE_SETUP, sizeof(cp), LPARAM(@cp)); if SendMessage(fWndC, WM_CAP_FILE_SET_CAPTURE_FILE, 0, LPARAM(PChar(fRecFileName))) = 0 then raise TVideoCapException.Create('Unable to create AVI file'); SetCallBackFrame(fCallBackFrame); if SendMessage(fWndC, WM_CAP_SEQUENCE, 0, 0) = 0 then raise TVideoCapException.Create('Unable to start video recording'); end else begin cp.fYield := true; cp.fCaptureAudio := false; //cp.wNumVideoRequested := 120; //cp.fStepCaptureAt2x := true; SendMessage(fWndC, WM_CAP_SET_SEQUENCE_SETUP, sizeof(cp), LPARAM(@cp)); SetCallBackFrame(fCallBackFrame); SendMessage(fWndC, WM_CAP_SEQUENCE_NOFILE, 0, 0); end; end; end else begin // STOP VIDEO INPUT fEnding := true; SendMessage(fWndC, WM_CAP_STOP, 0, 0); SendMessage(fWndC, WM_CAP_SET_USER_DATA, 0, 0); DriverDisconnect; fCapture := false; DestroyCaptureWindow; end; end; // Assigns fWndC // note: make sure that fWndC is 0 before call CreateCaptureWindow procedure TImageEnVideoCap.CreateCaptureWindow; begin fWndC := capCreateCaptureWindow(PChar(name), WS_CHILD, 0, 0, 50, 50, IEFindHandle(self), 0); end; procedure TImageEnVideoCap.DestroyCaptureWindow; begin if fWndC <> 0 then begin SendMessage(fWndC, WM_CAP_SET_USER_DATA, 0, 0); DestroyWindow(fWndC); fWndC := 0; end; end; ///////////////////////////////////////////////////////////////////////////////////// procedure TImageEnVideoCap.DriverDisconnect; begin SendMessage(fWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0); fConnected := false; end; ///////////////////////////////////////////////////////////////////////////////////// procedure TImageEnVideoCap.SetVideoSource(v: integer); begin fVideoSource := v; if fCapture then begin SetCapture(false); SetCapture(true); end; end; ///////////////////////////////////////////////////////////////////////////////////// procedure TImageEnVideoCap.DriverConnect; begin if fWndC = 0 then CreateCaptureWindow; DoJob(iejVIDEOCAP_CONNECTING, 0); if SendMessage(fWndC, WM_CAP_DRIVER_CONNECT, fVideoSource, 0) = 0 then raise TVideoCapException.Create('Unable to open video capture driver'); fConnected := true; fBitmapInfoUp := false; FillBitmapInfo; DoJob(iejNOTHING, 0); end; // like DriverConnect, but returns false if fail to connect function TImageEnVideoCap.DriverConnectNE: boolean; begin if fWndC = 0 then CreateCaptureWindow; result := SendMessage(fWndC, WM_CAP_DRIVER_CONNECT, fVideoSource, 0) <> 0; fConnected := result; end; ///////////////////////////////////////////////////////////////////////////////////// function TImageEnVideoCap.GetHasDlgVideoSource: boolean; var fDriverCaps: TCAPDRIVERCAPS; begin GetCaps(fDriverCaps); result := fDriverCaps.fHasDlgVideoSource; end; ///////////////////////////////////////////////////////////////////////////////////// function TImageEnVideoCap.GetHasDlgVideoFormat: boolean; var fDriverCaps: TCAPDRIVERCAPS; begin GetCaps(fDriverCaps); result := fDriverCaps.fHasDlgVideoFormat; end; ///////////////////////////////////////////////////////////////////////////////////// function TImageEnVideoCap.GetHasDlgVideoDisplay: boolean; var fDriverCaps: TCAPDRIVERCAPS; begin GetCaps(fDriverCaps); result := fDriverCaps.fHasDlgVideoDisplay; end; ///////////////////////////////////////////////////////////////////////////////////// function TImageEnVideoCap.GetHasOverlay: boolean; var fDriverCaps: TCAPDRIVERCAPS; begin GetCaps(fDriverCaps); result := fDriverCaps.fHasOverlay; end; ///////////////////////////////////////////////////////////////////////////////////// procedure TImageEnVideoCap.GetCaps(var fDriverCaps: TCAPDRIVERCAPS); var lcon: boolean; begin lcon := fConnected; if not fConnected then DriverConnect; SendMessage(fWndC, WM_CAP_DRIVER_GET_CAPS, sizeof(TCAPDRIVERCAPS), LPARAM(@fDriverCaps)); if not lcon then DriverDisconnect; end; {!! TImageEnVideoCap.StartRecord Declaration function StartRecord: boolean; Description Begin recording of the video input to AVI format. To select compression algorithm run the ConfigureCompression dialog. StartRecord doesn't actually begins record, but enable recording when Capture becomes true. StartRecord returns False if it fails, True if it’s successful. !!} procedure TImageEnVideoCap.StartRecord; begin fRecording := true; end; {!! TImageEnVideoCap.StopRecord Declaration procedure StopRecord; Description Stops recording begun with StartRecord. !!} procedure TImageEnVideoCap.StopRecord; begin fRecording := false; end; {!! TImageEnVideoCap.DoConfigureSource Declaration function DoConfigureSource: boolean; Description Executes the Configure Source Dialog of the selected driver (see VideoSource property). If the driver is busy or it has failed to open, the function returns False. !!} function TImageEnVideoCap.DoConfigureSource: boolean; var lcon: boolean; begin lcon := fConnected; result := fConnected; if not fConnected then result := DriverConnectNE; if result then begin result := SendMessage(fWndC, WM_CAP_DLG_VIDEOSOURCE, 0, 0) <> 0; fBitmapInfoUp := false; FillBitmapInfo; if not lcon then DriverDisconnect end; end; ///////////////////////////////////////////////////////////////////////////////////// {!! TImageEnVideoCap.DoConfigureFormat Declaration function DoConfigureFormat: boolean; Description Executes the Configure Format Dialog of the selected driver (see VideoSource property). If the driver is busy or it has failed to open, the function returns False. !!} function TImageEnVideoCap.DoConfigureFormat: boolean; var lcon: boolean; begin lcon := fConnected; result := fConnected; if not fConnected then result := DriverConnectNE; if result then begin result := SendMessage(fWndC, WM_CAP_DLG_VIDEOFORMAT, 0, 0) <> 0; fBitmapInfoUp := false; FillBitmapInfo; if not lcon then DriverDisconnect end; end; ///////////////////////////////////////////////////////////////////////////////////// {!! TImageEnVideoCap.DoConfigureDisplay Declaration function DoConfigureDisplay: boolean; Description Executes the Configure Display Dialog of the selected driver (see VideoSource property). If the driver is busy or it has failed to open, the function returns False. !!} function TImageEnVideoCap.DoConfigureDisplay: boolean; var lcon: boolean; begin lcon := fConnected; result := fConnected; if not fConnected then result := DriverConnectNE; if result then begin result := SendMessage(fWndC, WM_CAP_DLG_VIDEODISPLAY, 0, 0) <> 0; fBitmapInfoUp := false; FillBitmapInfo; if not lcon then DriverDisconnect end; end; ///////////////////////////////////////////////////////////////////////////////////// function TImageEnVideoCap.FillBitmapInfo: boolean; var sz: integer; pt: PBITMAPINFO; lcon: boolean; begin if not fBitmapInfoUp then begin lcon := fConnected; result := fConnected; if not fConnected then result := DriverConnectNE; if result then begin GlobalFree(fhBitmapInfo); sz := SendMessage(fWndC, WM_CAP_GET_VIDEOFORMAT, 0, 0); // get size fhBitmapInfo := GlobalAlloc(GHND, IMAX(sizeof(TBITMAPINFO) + sizeof(TRGBQUAD) * 256, sz)); pt := GlobalLock(fhBitmapInfo); SendMessage(fWndC, WM_CAP_GET_VIDEOFORMAT, sz, LPARAM(pt)); if pt^.bmiHeader.biBitCount = 1 then fBitmap.AllocateBits(pt^.bmiHeader.biWidth, pt^.bmiHeader.biHeight, 1) else fBitmap.AllocateBits(pt^.bmiHeader.biWidth, pt^.bmiHeader.biHeight, 24); if fPix <> nil then freemem(fPix); getmem(fPix, pt^.bmiHeader.biSizeImage); GlobalUnLock(fhBitmapInfo); if not lcon then DriverDisconnect; end; fBitmapInfoUp := true; end else result := true; end; {!! TImageEnVideoCap.GetVideoSize Declaration function GetVideoSize: TRect; Description Returns the rectangle of video input (as selected from ConfigureFormat dialog). !!} function TImageEnVideoCap.GetVideoSize: TRect; var pt: PBITMAPINFO; begin if fWndC = 0 then CreateCaptureWindow; FillBitmapInfo; with result do begin Left := 0; Top := 0; pt := GlobalLock(fhBitmapInfo); Right := pt^.bmiHeader.biWidth - 1; Bottom := pt^.bmiHeader.biHeight - 1; GlobalUnLock(fhBitmapInfo); end; end; // Enable/Disable calls to CallBackFrameFunc() procedure TImageEnVideoCap.SetCallBackFrame(v: boolean); begin fCallBackFrame := v; if fConnected then begin if v then begin SendMessage(fWndC, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, LPARAM(@CallBackFrameFunc)); SendMessage(fWndC, WM_CAP_SET_CALLBACK_ERROR, 0, LPARAM(@capErrorCallback)); SendMessage(fWndC, WM_CAP_SET_CALLBACK_YIELD, 0, LPARAM(@CallBackYeldFunc)); SendMessage(fWndC, WM_CAP_SET_CALLBACK_STATUS, 0, LPARAM(@CallBackStatusFunc)); end else begin SendMessage(fWndC, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, 0); SendMessage(fWndC, WM_CAP_SET_CALLBACK_ERROR, 0, 0); SendMessage(fWndC, WM_CAP_SET_CALLBACK_YIELD, 0, 0); SendMessage(fWndC, WM_CAP_SET_CALLBACK_STATUS, 0, 0); end; end; end; ///////////////////////////////////////////////////////////////////////////////////// procedure TImageEnVideoCap.SetOnVideoFrame(v: TVideoFrameEvent); begin fOnVideoFrame := v; SetCallBackFrame(assigned(fOnVideoFrame) or assigned(fOnVideoFrameRaw)); end; ///////////////////////////////////////////////////////////////////////////////////// procedure TImageEnVideoCap.SetOnVideoFrameRaw(v: TVideoFrameRawEvent); begin fOnVideoFrameRaw := v; SetCallBackFrame(assigned(fOnVideoFrame) or assigned(fOnVideoFrameRaw)); end; ///////////////////////////////////////////////////////////////////////////////////// {!! TImageEnVideoCap.DoConfigureCompression Declaration function DoConfigureCompression: boolean; Description Executes the Configure Compression Dialog of the selected driver (see VideoSource property). If the driver is busy (fails to open), the function returns False. !!} function TImageEnVideoCap.DoConfigureCompression: boolean; var lcon: boolean; begin lcon := fConnected; result := fConnected; if not fConnected then result := DriverConnectNE; if result then begin result := SendMessage(fWndC, WM_CAP_DLG_VIDEOCOMPRESSION, 0, 0) <> 0; fBitmapInfoUp := false; FillBitmapInfo; if not lcon then DriverDisconnect end; end; ///////////////////////////////////////////////////////////////////////////////////// procedure TImageEnVideoCap.DoJob(job: TIEJob; per: integer); begin if assigned(fOnJob) then fOnJob(self, job, per); end; (* /* dwFlags field of VIDEOHDR */ #define VHDR_DONE 0x00000001 /* Done bit */ #define VHDR_PREPARED 0x00000002 /* Set if this header has been prepared */ #define VHDR_INQUEUE 0x00000004 /* Reserved for driver */ #define VHDR_KEYFRAME 0x00000008 /* Key Frame */ *) function CallBackFrameFunc(hWnd: HWND; lpVHdr: PVIDEOHDR): LRESULT; {$ifdef IEWarningForDeprecated} deprecated; {$endif} var pobj: pointer; obj: TImageEnVideoCap; i: pointer; begin result := 0; if (lpVHdr^.dwFlags and 1 = 0) or (lpVHdr^.dwFlags and 2 = 0) then exit; if IESendMessageTimeOut(hWnd, WM_CAP_GET_USER_DATA, 0, 0, SMTO_ABORTIFHUNG or SMTO_BLOCK, 100, @i) <> 0 then begin pobj := pointer(i); if assigned(pobj) then begin obj := pobj; if (obj.fDone) and (not obj.fEnding) then begin obj.fDone := false; copymemory(obj.fpix, lpVHdr^.lpData, lpVHdr^.dwBufferLength); PostMessage(obj.fWinHandle, VH_FRAMEMESSAGE, 0, LPARAM(pobj)); end; end; end; end; function capErrorCallback(hWnd: HWND; nID: integer; lpsz: PChar): LRESULT; begin result := 0; end; function CallBackYeldFunc(hWnd: HWND): LRESULT; begin result := 1; end; function CallBackStatusFunc(hWnd: HWND; nID: integer; lpsz: PChar): LRESULT; {$ifdef IEWarningForDeprecated} deprecated; {$endif} var pobj: pointer; obj: TImageEnVideoCap; i: pointer; begin if IESendMessageTimeOut(hWnd, WM_CAP_GET_USER_DATA, 0, 0, SMTO_ABORTIFHUNG or SMTO_BLOCK, 100, @i) <> 0 then begin pobj := pointer(i); if assigned(pobj) then begin obj := pobj; case nID of IDS_CAP_BEGIN: obj.fDriverBusy := true; IDS_CAP_END: obj.fDriverBusy := false; end; end; end; result := 0; end; function VideoCapWndProc(Window: HWND; Message, wParam, lParam: Longint): Longint; stdcall; {$ifdef IEWarningForDeprecated} deprecated; {$endif} var pbi: PBITMAPINFOHEADER; obj: TImageEnVideoCap; begin case Message of VH_FRAMEMESSAGE: begin obj := TImageEnVideoCap(lParam); with obj do begin if assigned(fOnVideoFrame) and (not fEnding) then begin pbi := GlobalLock(fhBitmapInfo); if fUseWindowsCodec then IEDrawDibDraw(fHDrawDib, fBitmap.HDC, 0, 0, pbi^.biWidth, pbi^.biHeight, pbi^, fPix, 0, 0, pbi^.biWidth, pbi^.biHeight, 0) else _CopyDIB2BitmapEx(THandle(pbi), fBitmap, fPix, false); GlobalUnLock(fhBitmapInfo); fOnVideoFrame(obj, fBitmap); end; if assigned(fOnVideoFrameRaw) and (not fEnding) then fOnVideoFrameRaw(obj, fhBitmapInfo, fpix); fDone := true; Result := 0; end; end; VH_DESTROYWINDOW: begin DestroyWindow(Window); Result := 0; end; else Result := DefWindowProc(Window, Message, wParam, lParam); end; end; var VideoCapWindowClass: TWndClass = ( style: 0; lpfnWndProc: nil; cbClsExtra: 0; cbWndExtra: 0; hInstance: 0; hIcon: 0; hCursor: 0; hbrBackground: 0; lpszMenuName: nil; lpszClassName: 'TVideoCapWindow'); procedure TImageEnVideoCap.AllocateWindow; var TempClass: TWndClass; ClassRegistered: Boolean; begin VideoCapWindowClass.lpfnWndProc := @VideoCapWndProc; VideoCapWindowClass.hInstance := HInstance; ClassRegistered := GetClassInfo(HInstance, VideoCapWindowClass.lpszClassName, TempClass); if not ClassRegistered or (TempClass.lpfnWndProc <> @VideoCapWndProc) then begin if ClassRegistered then Windows.UnregisterClass(VideoCapWindowClass.lpszClassName, HInstance); Windows.RegisterClass(VideoCapWindowClass); end; fWinHandle := CreateWindow(VideoCapWindowClass.lpszClassName, '', 0, 0, 0, 0, 0, 0, 0, HInstance, nil); end; ///////////////////////////////////////////////////////////////////////////////////// procedure TImageEnVideoCap.GetWaveFormat(var wf: TWAVEFORMATEX); var lcon: boolean; begin lcon := fConnected; if not fConnected then DriverConnect; SendMessage(fWndC, WM_CAP_GET_AUDIOFORMAT, sizeof(TWAVEFORMATEX), LPARAM(@wf)); if not lcon then DriverDisconnect; end; ///////////////////////////////////////////////////////////////////////////////////// procedure TImageEnVideoCap.SetWaveFormat(var wf: TWAVEFORMATEX); var lcon: boolean; begin lcon := fConnected; if not fConnected then DriverConnect; wf.nAvgBytesPerSec := 0; wf.cbSize := 0; SendMessage(fWndC, WM_CAP_SET_AUDIOFORMAT, sizeof(TWAVEFORMATEX), LPARAM(@wf)); if not lcon then DriverDisconnect; end; ///////////////////////////////////////////////////////////////////////////////////// function TImageEnVideoCap.GetAudioFormat: word; var wf: TWAVEFORMATEX; begin GetWaveFormat(wf); result := wf.wFormatTag end; ///////////////////////////////////////////////////////////////////////////////////// {!! TImageEnVideoCap.AudioFormat Declaration property AudioFormat: word; Description , , and properties allow the application to get/set the audio recording format. AudioFormat specifies the compression audio format. Currently defined values are: $0000 : UNKNOWN $0001 : PCM $0002 : ADPCM $0003 : IEEE_FLOAT $0004 : VSELP $0005 : IBM_CVSD $0006 : ALAW $0007 : MULAW $0008 : DTS $0010 : OKI_ADPCM $0011 : DVI_ADPCM $0012 : MEDIASPACE_ADPCM $0013 : SIERRA_ADPCM $0014 : G723_ADPCM $0015 : DIGISTD $0016 : DIGIFIX $0017 : DIALOGIC_OKI_ADPCM $0018 : MEDIAVISION_ADPCM $0019 : CU_CODEC $0020 : YAMAHA_ADPCM $0021 : SONARC $0022 : DSPGROUP_TRUESPEECH $0023 : ECHOSC1 $0024 : AUDIOFILE_AF36 $0025 : APTX $0026 : AUDIOFILE_AF10 $0027 : PROSODY_1612 $0028 : LRC $0030 : DOLBY_AC2 $0031 : GSM610 $0032 : MSNAUDIO $0033 : ANTEX_ADPCME $0034 : CONTROL_RES_VQLPC $0035 : DIGIREAL $0036 : DIGIADPCM $0037 : CONTROL_RES_CR10 $0038 : NMS_VBXADPCM $0039 : CS_IMAADPCM $003A : ECHOSC3 $003B : ROCKWELL_ADPCM $003C : ROCKWELL_DIGITALK $003D : XEBEC $0040 : G721_ADPCM $0041 : G728_CELP $0042 : MSG723 $0050 : MPEG $0052 : RT24 $0053 : PAC $0055 : MPEGLAYER3 $0059 : LUCENT_G723 $0060 : CIRRUS $0061 : ESPCM $0062 : VOXWARE $0063 : CANOPUS_ATRAC $0064 : G726_ADPCM $0065 : G722_ADPCM $0067 : DSAT_DISPLAY $0069 : VOXWARE_BYTE_ALIGNED $0070 : VOXWARE_AC8 $0071 : VOXWARE_AC10 $0072 : VOXWARE_AC16 $0073 : VOXWARE_AC20 $0074 : VOXWARE_RT24 $0075 : VOXWARE_RT29 $0076 : VOXWARE_RT29HW $0077 : VOXWARE_VR12 $0078 : VOXWARE_VR18 $0079 : VOXWARE_TQ40 $0080 : SOFTSOUND $0081 : VOXWARE_TQ60 $0082 : MSRT24 $0083 : G729A $0084 : MVI_MVI2 $0085 : DF_G726 $0086 : DF_GSM610 $0088 : ISIAUDIO $0089 : ONLIVE $0091 : SBC24 $0092 : DOLBY_AC3_SPDIF $0093 : MEDIASONIC_G723 $0094 : PROSODY_8KBPS $0094 : ZYXEL_ADPCM $0098 : PHILIPS_LPCBB $0099 : PACKED $00A0 : MALDEN_PHONYTALK $0100 : RHETOREX_ADPCM $0101 : IRAT $0111 : VIVO_G723 $0112 : VIVO_SIREN $0123 : DIGITAL_G723 $0125 : SANYO_LD_ADPCM $0130 : SIPROLAB_ACEPLNET $0131 : SIPROLAB_ACELP4800 $0132 : SIPROLAB_ACELP8V3 $0133 : SIPROLAB_G729 $0134 : SIPROLAB_G729A $0135 : SIPROLAB_KELVIN $0140 : G726ADPCM $0150 : QUALCOMM_PUREVOICE $0151 : QUALCOMM_HALFRATE $0155 : TUBGSM $0160 : MSAUDIO1 $0200 : CREATIVE_ADPCM $0202 : CREATIVE_FASTSPEECH8 $0203 : CREATIVE_FASTSPEECH10 $0210 : UHER_ADPCM $0220 : QUARTERDECK $0230 : ILINK_VC $0240 : RAW_SPORT $0250 : IPI_HSX $0251 : IPI_RPELP $0260 : CS2 $0270 : SONY_SCX $0300 : FM_TOWNS_SND $0400 : BTV_DIGITAL $0450 : QDESIGN_MUSIC $0680 : VME_VMPCM $0681 : TPC $1000 : OLIGSM $1001 : OLIADPCM $1002 : OLICELP $1003 : OLISBC $1004 : OLIOPR $1100 : LH_CODEC $1400 : NORRIS $1500 : SOUNDSPACE_MUSICOMPRESS $2000 : DVM !!} procedure TImageEnVideoCap.SetAudioFormat(v: word); var wf: TWAVEFORMATEX; begin GetWaveFormat(wf); wf.wFormatTag := v; SetWaveFormat(wf); end; ///////////////////////////////////////////////////////////////////////////////////// function TImageEnVideoCap.GetAudioChannels: word; var wf: TWAVEFORMATEX; begin GetWaveFormat(wf); result := wf.nChannels; end; ///////////////////////////////////////////////////////////////////////////////////// {!! TImageEnVideoCap.AudioChannels Declaration property AudioChannels: word; Description , , and properties allow the application to get/set the audio recording format. AudioChannels specifies the number of channels in the waveform-audio data. Monaural data uses one channel and stereo data uses two channels. !!} procedure TImageEnVideoCap.SetAudioChannels(v: word); var wf: TWAVEFORMATEX; begin GetWaveFormat(wf); wf.nChannels := v; SetWaveFormat(wf); end; ///////////////////////////////////////////////////////////////////////////////////// function TImageEnVideoCap.GetAudioSamplesPerSec: dword; var wf: TWAVEFORMATEX; begin GetWaveFormat(wf); result := wf.nSamplesPerSec; end; ///////////////////////////////////////////////////////////////////////////////////// {!! TImageEnVideoCap.AudioSamplesPerSec Declaration property AudioSamplesPerSec: dword; Description , , and properties allow the application to get/set the audio recording format. AudioSamplesPerSec specifies the sampling rate, in samples per second (hertz), at which each channel should be played or recorded. !!} procedure TImageEnVideoCap.SetAudioSamplesPerSec(v: dword); var wf: TWAVEFORMATEX; begin GetWaveFormat(wf); wf.nSamplesPerSec := v; SetWaveFormat(wf); end; ///////////////////////////////////////////////////////////////////////////////////// function TImageEnVideoCap.GetAudioBitsPerSample: word; var wf: TWAVEFORMATEX; begin GetWaveFormat(wf); result := wf.wBitsPerSample; end; ///////////////////////////////////////////////////////////////////////////////////// {!! TImageEnVideoCap.AudioBitsPerSample Declaration property AudioBitsPerSample: word; Description , , and properties allow the application to get/set the audio recording format. AudioBitsPerSample specifies the bits per sample for the AudioFormat format type. If a compression scheme cannot define a bits-per-sample value, this field is zero. !!} procedure TImageEnVideoCap.SetAudioBitsPerSample(v: word); var wf: TWAVEFORMATEX; begin GetWaveFormat(wf); wf.wBitsPerSample := v; SetWaveFormat(wf); end; {$ELSE} // {$ifdef IEINCLUDEVIDEOCAPTURE} interface implementation {$ENDIF} end.