{----------------------------------------------------------------------------- The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is: JvAVICapture.PAS, released 2003-07-05. The Initial Developer of the Original Code is Olivier Sannier Portions created by Olivier Sannier are Copyright (C) 2003 Olivier Sannier. All Rights Reserved. Contributor(s): none to date Current Version: 0.4 You may retrieve the latest version of this file at the Project JEDI's JVCL home page, located at http://jvcl.sourceforge.net Description: This unit defines a component that you can drop on any form or frame and that will display the video stream captured by a video device installed under Windows. You can perform live previews, record movies (and save them to avi files) or even capture single frames. A direct access is provided to the frames so that you can process them if you want. This is an encapsulation of the AVICap API from Win32. Known Issues: none known -----------------------------------------------------------------------------} // $Id: JvAVICapture.pas 11893 2008-09-09 20:45:14Z obones $ unit JvAVICapture; {$I jvcl.inc} {$I windowsonly.inc} interface uses {$IFDEF UNITVERSIONING} JclUnitVersioning, {$ENDIF UNITVERSIONING} Windows, Messages, VFW, MMSystem, SysUtils, Classes, Graphics, Controls, JvTypes; type TJvScrollPos = class(TPersistent) protected FLeft: Integer; FTop: Integer; published property Left: Integer read FLeft write FLeft; property Top: Integer read FTop write FTop; end; // The video format used by the video device TJvVideoFormat = class(TPersistent) protected FHWnd: HWND; // the AVICap window using this format FWidth: Cardinal; // width of the image FHeight: Cardinal; // height of the image FBitDepth: Cardinal; // bits per pixel (8-16-24-32...) FPixelFormat: TPixelFormat; // pixel format (RGB, BGR, YUV...) FCompression: Integer; // compression used public constructor Create; // Create the video format procedure Update; // Update from the AVICap window property Width: Cardinal read FWidth; property Height: Cardinal read FHeight; property BitDepth: Cardinal read FBitDepth; property PixelFormat: TPixelFormat read FPixelFormat; property Compression: Integer read FCompression; end; // The audio format used by the device TJvAudioFormat = class(TPersistent) protected FHWnd: HWND; // the AVICap window using this format FFormatTag: Cardinal; // the format tag (PCM or others...) FChannels: Cardinal; // number of channels (usually 1 or 2) FSamplesPerSec: Cardinal; // number of samples per second in the stream FAvgBytesPerSec: Cardinal; // the average number of bytes per second FBlockAlign: Cardinal; // size of the block to align on FBitsPerSample: Cardinal; // number of bits per sample FExtraSize: Cardinal; // size of the extra data FExtra: Pointer; // extra data for formats other than PCM public // creates the audio format object and initializes it constructor Create; // updates from the AVICap window procedure Update; // apply the format to the window, returns True if successfull function Apply: Boolean; // fill in a PWaveFormatEx structure to use with API calls procedure FillWaveFormatEx(var wfex: PWaveFormatEx); // run-time only property, see FSize property ExtraSize: Cardinal read FExtraSize write FExtraSize; // run-time only property, see FExtra property Extra: Pointer read FExtra write FExtra; published // see the relevant fields for details on the following properties property FormatTag: Cardinal read FFormatTag write FFormatTag; property Channels: Cardinal read FChannels write FChannels; property SamplesPerSec: Cardinal read FSamplesPerSec write FSamplesPerSec; property AvgBytesPerSec: Cardinal read FAvgBytesPerSec write FAvgBytesPerSec; property BlockAlign: Cardinal read FBlockAlign write FBlockAlign; property BitsPerSample: Cardinal read FBitsPerSample write FBitsPerSample; end; // a percentage TJvPercent = 0..100; // the number of audio buffers to use (maximum 10) TJvNumAudioBuffer = 0..10; // the type of a virtual key TJvVirtualKey = type Integer; // the capture settings to use to save a video stream to an AVI file TJvCaptureSettings = class(TPersistent) protected // the AVICap window that will use these settings and from which // we will get the values when we update them FHWnd: HWND; // if True, the API will popup a confirmation window when starting the // capture session allowing the user to choose to continue or not. FConfirmCapture: Boolean; // the delay in microsecond between two frames. This is a requested // value, it may not be fully respected by the driver when capturing FFrameDelay: Cardinal; // the percentage of frames dropped above which the capture will end // in an error state (too many drops having occured) FPercentDropForError: TJvPercent; // if True the capture session will be launched in a separate background // thread, not disabling the caller. Reentrance issues must then be // considered to avoid the user to launch twice the capture, for instance FYield: Boolean; // the requested number of video buffers. The actual number of allocated // buffers may well be smaller because of hardware limitations FNumVideoBuffer: Cardinal; // the requested number of audio buffers. The actual number of allocated // buffers may well be smaller because of hardware limitations FNumAudioBuffer: TJvNumAudioBuffer; // if True, the audio stream will also be captured FCaptureAudio: Boolean; // if True, a left mouse click will stop the capture session FAbortLeftMouse: Boolean; // if True, a right mouse click will stop the capture session FAbortRightMouse: Boolean; // if different from 0, a press on that virtual key will stop the // capture session FKeyAbort: TJvVirtualKey; // if True, the FTimeLimit parameter will be considered FLimitEnabled: Boolean; // the time limit for the capture session (in seconds). Will only be // considered if FLimitEnabled is True FTimeLimit: Cardinal; // if True, the capture will occur at twice the size specified in the // other parameters of this class. FStepCapture2x: Boolean; // the number of frames to sample and make the average of when using // a step capture FStepCaptureAverageFrames: Cardinal; // the size of an audio buffer FAudioBufferSize: Cardinal; // if True, the audio stream is the master one with respect to time // alignment. if False, the video stream is the master (recommanded) FAudioMaster: Boolean; // if True, the capture will controll a MCI device as its source FMCIControl: Boolean; // if True, the step capture is enabled on the MCI device // this is only considered if FMCIControl is True FMCIStep: Boolean; // time of the MCI device to start capture at // this is only considered if FMCIControl is True FMCIStartTime: Cardinal; // time of the MCI device to stop capture at // this is only considered if FMCIControl is True FMCIStopTime: Cardinal; // sets the FKeyAbort field procedure SetKeyAbort(nKeyAbort: TJvVirtualKey); // get and set the FPS property function GetFPS: Double; procedure SetFPS(const Value: Double); // set the FrameDelay property, ensuring the value is always // greater than 0 procedure SetFrameDelay(const Value: Cardinal); public // creates and initializes the class constructor Create; // updates the class fields from the AVICap window procedure Update; // applies the class fields to the AVICap window, returns True if successful function Apply: Boolean; published // (rom) default values would be a good idea // please refer to the relevant field declarations for detail on the following properties property ConfirmCapture: Boolean read FConfirmCapture write FConfirmCapture; property FrameDelay: Cardinal read FFrameDelay write SetFrameDelay; property FPS: Double read GetFPS write SetFPS; property PercentDropForError: TJvPercent read FPercentDropForError write FPercentDropForError; property Yield: Boolean read FYield write FYield; property NumVideoBuffer: Cardinal read FNumVideoBuffer write FNumVideoBuffer; property NumAudioBuffer: TJvNumAudioBuffer read FNumAudioBuffer write FNumAudioBuffer; property CaptureAudio: Boolean read FCaptureAudio write FCaptureAudio; property AbortLeftMouse: Boolean read FAbortLeftMouse write FAbortLeftMouse; property AbortRightMouse: Boolean read FAbortRightMouse write FAbortRightMouse; property KeyAbort: TJvVirtualKey read FKeyAbort write SetKeyAbort; property LimitEnabled: Boolean read FLimitEnabled write FLimitEnabled; property TimeLimit: Cardinal read FTimeLimit write FTimeLimit; property StepCapture2x: Boolean read FStepCapture2x write FStepCapture2x; property StepCaptureAverageFrames: Cardinal read FStepCaptureAverageFrames write FStepCaptureAverageFrames; property AudioBufferSize: Cardinal read FAudioBufferSize write FAudioBufferSize; property AudioMaster: Boolean read FAudioMaster write FAudioMaster; property MCIControl: Boolean read FMCIControl write FMCIControl; property MCIStep: Boolean read FMCIStep write FMCIStep; property MCIStartTime: Cardinal read FMCIStartTime write FMCIStartTime; property MCIStopTime: Cardinal read FMCIStopTime write FMCIStopTime; end; // the type for the number of colors a palette can have TJvPaletteNbColors = 0..256; TJvPalette = class(TPersistent) protected FHWnd: HWND; // the AVICap window that will use these settings public // create the object constructor Create; // save the palette associated with the driver into the given file // and returns True upon success. function Save(FileName: string): Boolean; // loads the palette from the given file and returns True upon success // FHWnd must not be null function Load(FileName: string): Boolean; // paste the palette from the clipboard function PasteFromClipboard: Boolean; // automatically create the best palette from the first nbFrames frames with // a maximum of nbColors colors function AutoCreate(nbFrames: Integer; nbColors: TJvPaletteNbColors): Boolean; // Use this call from a frame callback and set the Flag to True to indicate that // the current frame must be considered when creating the palette. Continue // calling this method with Flag set to True as long as you need it. // Then call it again with Flag set to False, to finalize the palette and pass // it to the capture driver that will now use it. function ManuallyCreate(Flag: Boolean; nbColors: TJvPaletteNbColors): Boolean; end; // the driver index (-1 if not connected, 0-9 if connected as there are at most 10 drivers // according to Microsoft documentation. But there can be more than 1 source per driver... TJvDriverIndex = -1..9; // The exception triggered when an invalid index driver index is given EInvalidDriverIndexError = class(EJVCLException) public constructor Create(Index: TJvDriverIndex; MaxIndex: TJvDriverIndex); end; // what a driver can do on the system TJvDriverCaps = set of (dcOverlay, // overlay rendering dcDlgVideoSource, // display a dialog to choose video source dcDlgVideoFormat, // display a dialog to choose video format dcDlgVideoDisplay, // display a dialog to choose video display dcCaptureInitialized, // is the capture initialized dcSuppliesPalettes); // if the driver supplies palettes TJvUsedEvents = set of (ueCapControl, // the OnCapControl event will be triggered ueError, // the OnError event will be triggered ueFrame, // the OnFrame event will be triggered ueStatus, // the OnStatus event will be triggered ueVideoStream, // the OnVideoStream event will be triggered ueWaveStream, // the OnWaveStream event will be triggered ueYield); // the OnYield event will be triggered // the video dialog to display TJvVideoDialog = (vdSource, // the source dialog (only if dcDlgVideoSource is in the caps) vdFormat, // the format dialog (only if dcDlgVideoFormat is in the caps) vdDisplay, // the display dialog (only if dcDlgVideoDisplay is in the caps) vdCompression); // the compression dialog (with all the installed video codecs) // local type for the events PJvVideoHdr = PVIDEOHDR; PJvWaveHdr = PWaveHdr; // forward declaration for the events TJvAVICapture = class; // the event triggered in case of an error // Sender is the TJvAVICapture component triggering the event // nErr is the error number // Str is the string associated with that error TOnError = procedure(Sender: TJvAVICapture; nErr: Integer; Str: string) of object; // the event triggered in case of a status change (use it to follow progress) // Sender is the TJvAVICapture component triggering the event // nId is the id of the status change (see win32 API for more details) // Str is the string associated with that status change TOnStatus = procedure(Sender: TJvAVICapture; nId: Integer; Str: string) of object; // the event triggerred when the driver is yielding. a good place to put a // call to Application.ProcessMessages // Sender is the TJvAVICapture component triggering the event TOnYield = procedure(Sender: TJvAVICapture) of object; // the event trigerred when a frame is ready to be written to disk during streaming capture // Sender is the TJvAVICapture component triggering the event // videoHdr is the video header describing the stream TOnVideoStream = procedure(Sender: TJvAVICapture; videoHdr: PJvVideoHdr) of object; // the event trigerred when a frame is ready, in a non streaming capture session TOnFrame = TOnVideoStream; // the event trigerred when an audio buffer is ready to be written do disk during streaming capture // Sender is the TJvAVICapture component triggering the event // audioHdr is the audio header describing the stream TOnWaveStream = procedure(Sender: TJvAVICapture; waveHdr: PJvWaveHdr) of object; // the event triggered when you want to use precise capture control // Sender is the TJvAVICapture component triggering the event // state is the state in which the capture is (refer to API for details) // Result is to be set to True if capture must continue, False if it must stop TOnCapControl = procedure(Sender: TJvAVICapture; nState: Integer; var Result: Boolean) of object; // the main component. Just drop it on a form or a frame, set the driver property, set previewing to // True and you should see the video coming through (even in design mode !) TJvAVICapture = class(TWinControl) protected FCaptureSettings: TJvCaptureSettings; // the capture settings FCapturing: Boolean; // True if capture is happening FConnected: Boolean; // True if connected to a driver FDrivers: TStringList; // the available drivers as a TStringList FDriverCaps: TJvDriverCaps; // the current driver capabilities FHWnd: HWND; // the handle to the AviCap window FNoFile: Boolean; // True if not capturing to a file FOverlaying: Boolean; // True if using overlay display FPreviewFrameDelay: Cardinal; // the time between two preview frames (ms) FPreviewing: Boolean; // True if previewing FSingleFrameCapturing: Boolean; // True if capturing using single frame capture FTitle: string; // the title of the AVICap window FVideoLeft: Integer; // the left coordinate of the displayed video FVideoTop: Integer; // the top coordinate of the displayed video // the user supplied event handlers // see respective types for details FOnError: TOnError; FOnStatus: TOnStatus; FOnYield: TOnYield; FOnFrame: TOnFrame; FOnVideoStream: TOnVideoStream; FOnWaveStream: TOnWaveStream; FOnCapControl: TOnCapControl; FFileName: string; // the filename for the capture file FFileSizeAlloc: Cardinal; // the size to allocate for the capture file FUsedEvents: TJvUsedEvents; // which events are used FCaptureStatus: TCAPSTATUS; // the state of the current capture FVideoFormat: TJvVideoFormat; // the current video format used (or to be used) FAudioFormat: TJvAudioFormat; // the current audio format used (or to be used) FScrollPos: TJvScrollPos; // the scrolling position in the window FPalette: TJvPalette; // the palette in use FDriverIndex: TJvDriverIndex; // the driver index (-1 if not connected) // the Pointer to the previous WndProc of the AviCap window FPreviousWndProc: Pointer; // window creation stuff, where the AviCap window is created: // what is done is that the component inherits from TWinControl and as such // has its own handle. We then create the AviCap window and set it as a child // of the TWinControl. This allows to take advantage of all the VCL handling // for design time, parent, ownership... and we can focus on using the // AviCap window to do the capture procedure CreateWindowHandle(const Params: TCreateParams); override; // destroys the AviCap window just before letting the VCL destroy the handle // for the TWinControl procedure DestroyWindowHandle; override; // Resizes the internal window that is used to display the AviCap content. procedure ResizeAviCapWindow(Width, Height: Integer); // We enforce the size of the window to be equal to the // video frame in this method as it is the place where it // should be done, rather than doing it in SetBounds function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override; // sets the title of the AviCap window procedure SetTitle(nTitle: string); // sets the preview frame delay (the time between two frames) procedure SetPreviewFrameDelay(nPreviewFrameDelay: Cardinal); // sets and gets the preview frame rate in frames per second procedure SetPreviewFPS(nPreviewFPS: Double); function GetPreviewFPS: Double; // sets the previewing property and starts or stop previewing accordingly procedure SetPreviewing(nPreviewing: Boolean); // sets and gets the filename for capture procedure SetFileName(nFileName: TFileName); function GetFileName: TFileName; // delivers FDrivers as TStrings for property function GetDrivers: TStrings; // sets the file size to allocate before capture. This might speed up capture as // the file won't need to be grown procedure SetFileSizeAlloc(nFileSizeAlloc: Cardinal); // sets the used events and updates the related values in the AviCap window procedure SetUsedEvents(nUsedEvents: TJvUsedEvents); // sets the overlaying rendering. May do nothing if driver cannot do overlay rendering procedure SetOverlaying(nOverlaying: Boolean); // returns the name of the driver or an empty string if FConnected is False function GetDriverName: string; // returns the version of the driver or an empty string if FConnected is False function GetDriverVersion: string; // set the scrolling position in the AviCap window. Useful if the frame is larger than // the actual size of the control procedure SetScrollPos(nScrollPos: TJvScrollPos); // sets and gets the MCI device used with this AviCap component (may well be empty) procedure SetMCIDevice(nMCIDevice: string); function GetMCIDevice: string; // sets the driver index to the given value and tries to connect. If connection // is not possible, will not change the current value procedure SetDriverIndex(nIndex: TJvDriverIndex); // tries to starts or stops capture according to the value // immediately check the value of FCapturing to see if capture // started succesfuly procedure SetCapturing(nCapturing: Boolean); // tries starts or stops single frame capture according to the value // immediately check the value of FSingleFrameCapturing to see // if capture started succesfuly procedure SetSingleFrameCapturing(const Value: Boolean); // sets the FNoFile flag procedure SetNoFile(nNoFile: Boolean); // sets the FVideoLeft and FVideoTop values and also // makes the required capCall procedure SetVideoLeft(const Value: Integer); procedure SetVideoTop(const Value: Integer); // updates the content of the FDriverCaps field procedure UpdateCaps; // updates the content of the FCaptureStatus field procedure UpdateCaptureStatus; // stops and start using callbacks. This is required as it appears that the // callbacks are still called after a capture session has been stopped. procedure StopCallbacks; procedure RestartCallbacks; // Functions to be called from the callbacks that will trigger the user events procedure DoError(ErrId: Integer; Str: string); procedure DoStatus(nId: Integer; Str: string); procedure DoYield; procedure DoFrame(videoHdr: PVIDEOHDR); procedure DoVideoStream(videoHdr: PVIDEOHDR); procedure DoWaveStream(waveHdr: PWaveHdr); procedure DoCapControl(nState: Integer; var AResult: Boolean); public // creates the component and initializes the different fields constructor Create(AOwner: TComponent); override; // destroys the component destructor Destroy; override; // sets the size of the component procedure SetBounds(nLeft, nTop, nWidth, nHeight: Integer); override; // enumarate the drivers and populates the FDrivers list procedure EnumDrivers; // tries to connect to the given driver. Returns True if successful, False otherwise function Connect(Driver: TJvDriverIndex): Boolean; // tries to disconnect from a driver. Returns True if successful, False otherwise function Disconnect: Boolean; // shows the given dialog and returns True if user pressed ok. If the driver // cannot show the given dialog... function ShowDialog(Dialog: TJvVideoDialog): Boolean; // starts and stop previewing, returning True upon success function StartPreview: Boolean; function StopPreview: Boolean; // start capturing to a file using streaming capture function StartCapture: Boolean; // start capturing without using a file. You should use the OnVideoStream event in that // case to process the frames yourself. This might be useful in a videoconferencing // software, where you transfer the frames directly function StartCaptureNoFile: Boolean; // stops the capture properly function StopCapture: Boolean; // aborts the capture, leaving the file unusable function AbortCapture: Boolean; // starts frame by frame capture (non streaming) function StartSingleFrameCapture: Boolean; // captures one frame in a frame by frame capture session function CaptureFrame: Boolean; // stops frame by frame capture function StopSingleFrameCapture: Boolean; // starts and stop overlay rendering, returns True if successful function StartOverlay: Boolean; function StopOverlay: Boolean; // applies the capture settings, returns True if successful function ApplyCaptureSettings: Boolean; // applies the audio format settings, returns True if successful function ApplyAudioFormat: Boolean; // saves the stream under the given filename function SaveAs(Name: string): Boolean; // sets information chunks in the output file function SetInfoChunk(const Chunk: TCAPINFOCHUNK): Boolean; // saves the latest captured frame to a DIB file function SaveDIB(Name: string): Boolean; // copies the latest frame to the clipboard function CopyToClipboard: Boolean; // grabs one frame, not using any capture session // if stop is True, previewing and overlaying are stopped // if stop is False, previewing and overlaying are left untouched function GrabFrame(Stop: Boolean): Boolean; // public properties (run-time only), refer to fields and methods descriptions // for details on the usage property CaptureStatus: TCAPSTATUS read FCaptureStatus; property Capturing: Boolean read FCapturing write SetCapturing; property Connected: Boolean read FConnected; property DriverCaps: TJvDriverCaps read FDriverCaps; property DriverName: string read GetDriverName; property DriverVersion: string read GetDriverVersion; property Drivers: TStrings read GetDrivers; property Handle: HWND read FHWnd; property Palette: TJvPalette read FPalette; property SingleFrameCapturing: Boolean read FSingleFrameCapturing write SetSingleFrameCapturing; property VideoFormat: TJvVideoFormat read FVideoFormat; published // published properties, refer to the field and methods descriptions for details property AudioFormat: TJvAudioFormat read FAudioFormat; property CaptureSettings: TJvCaptureSettings read FCaptureSettings; property DriverIndex: TJvDriverIndex read FDriverIndex write SetDriverIndex default -1; property FileName: TFileName read GetFileName write SetFileName; property FileSizeAlloc: Cardinal read FFileSizeAlloc write SetFileSizeAlloc default 0; property MCIDevice: string read GetMCIDevice write SetMCIDevice; property NoFile: Boolean read FNoFile write SetNoFile default False; property Overlaying: Boolean read FOverlaying write SetOverlaying default False; property PreviewFrameDelay: Cardinal read FPreviewFrameDelay write SetPreviewFrameDelay default 50; property PreviewFPS: Double read GetPreviewFPS write SetPreviewFPS; property Previewing: Boolean read FPreviewing write SetPreviewing default False; property ScrollPos: TJvScrollPos read FScrollPos write SetScrollPos; property Title: string read FTitle write SetTitle; property UsedEvents: TJvUsedEvents read FUsedEvents write SetUsedEvents default []; property VideoLeft: Integer read FVideoLeft write SetVideoLeft default 0; property VideoTop: Integer read FVideoTop write SetVideoTop default 0; // inherited properties getting published property AutoSize; property ParentShowHint; property ShowHint; property Visible; // the events, refer to the fields decriptions for details property OnError: TOnError read FOnError write FOnError; property OnStatus: TOnStatus read FOnStatus write FOnStatus; property OnYield: TOnYield read FOnYield write FOnYield; property OnFrame: TOnFrame read FOnFrame write FOnFrame; property OnVideoStream: TOnVideoStream read FOnVideoStream write FOnVideoStream; property OnWaveStream: TOnWaveStream read FOnWaveStream write FOnWaveStream; property OnCapControl: TOnCapControl read FOnCapControl write FOnCapControl; end; {$IFDEF UNITVERSIONING} const UnitVersioning: TUnitVersionInfo = ( RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/branches/JVCL3_36_PREPARATION/run/JvAVICapture.pas $'; Revision: '$Revision: 11893 $'; Date: '$Date: 2008-09-09 22:45:14 +0200 (mar., 09 sept. 2008) $'; LogPath: 'JVCL\run' ); {$ENDIF UNITVERSIONING} implementation uses Math, // for Min and Max JvResources; const // minimal height and width of the display window cMinHeight = 20; cMinWidth = 20; { Global functions } // an helper function that tells if the window is connected to a driver function capDriverConnected(hWnd: HWND): Boolean; var TmpName: array [0..MAX_PATH] of Char; begin Result := capDriverGetName(hWnd, TmpName, SizeOf(TmpName)); end; { This is the custom window procedure, which replaces the one originally associated with the AviCap window. all we do is pass the messages to the TWinControl containing the AviCap window so that it can resize and move itself. Then we pass the message to the original window procedure for it to handle the messages it needs to perform the video capture } function CustomWndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; var SelfObj: TJvAVICapture; begin Result := 0; // get the Pointer to self from the window user data SelfObj := TJvAVICapture(GetWindowLong(hWnd, GWL_USERDATA)); if SelfObj <> nil then begin // send the message to the containing window, // except for WM_NCHITTEST during design // This will prevent 100% processor usage when the mouse is kept over // the control during design time // Note: We MUST convert SelfObj to a TWinControl as the Handle // property of TJvAVICapture returns the handle of the AVICap window // thus leading to an infinite loop if we were to use it... if (Msg <> WM_NCHITTEST) or not (csDesigning in SelfObj.ComponentState) then PostMessage(TWinControl(SelfObj).Handle, Msg, wParam, lParam); // sending the message to the original window proc Result := CallWindowProc(SelfObj.FPreviousWndProc, hWnd, Msg, wParam, lParam); end; end; { Callbacks } // This is the callback called in case of an error // will only be called if the user chose so with ueError function ErrorCallback(hWnd: HWND; ErrId: Integer; Str: LPTSTR): LRESULT; stdcall; var SelfObj: TJvAVICapture; begin // clear previous error if required if ErrId = 0 then begin Result := LRESULT(Ord(True)); Exit; end; // get the Pointer to self from the window user data SelfObj := TJvAVICapture(GetWindowLong(hWnd, GWL_USERDATA)); if SelfObj <> nil then SelfObj.DoError(ErrId, Str); Result := LRESULT(Ord(True)); end; // This is the callback called in case of a status change // will only be called if the user chose so with ueStatus function StatusCallback(hWnd: HWND; nId: Integer; Str: LPTSTR): LRESULT; stdcall; var SelfObj: TJvAVICapture; begin // get the Pointer to self from the window user data SelfObj := TJvAVICapture(GetWindowLong(hWnd, GWL_USERDATA)); if SelfObj <> nil then SelfObj.DoStatus(nId, Str); Result := LRESULT(Ord(True)); end; // This is the callback called in case of yielding // will only be called if the user chose so with ueYield function YieldCallback(hWnd: HWND): LRESULT; stdcall; var SelfObj: TJvAVICapture; begin // get the Pointer to self from the window user data SelfObj := TJvAVICapture(GetWindowLong(hWnd, GWL_USERDATA)); if SelfObj <> nil then SelfObj.DoYield; Result := LRESULT(Ord(True)); end; // This is the callback called in case a new frame is available while a non // streaming capture is in progress // will only be called if the user chose so with ueFrame function FrameCallback(hWnd: HWND; videoHdr: PVIDEOHDR): LRESULT; stdcall; var SelfObj: TJvAVICapture; begin // get the Pointer to self from the window user data SelfObj := TJvAVICapture(GetWindowLong(hWnd, GWL_USERDATA)); if SelfObj <> nil then SelfObj.DoFrame(videoHdr); Result := LRESULT(Ord(True)); end; // This is the callback called when a frame is available, just before being // written to disk, only if using stream capture // will only be called if the user chose so with ueVideoStream function VideoStreamCallback(hWnd: HWND; videoHdr: PVIDEOHDR): LRESULT; stdcall; var SelfObj: TJvAVICapture; begin // get the Pointer to self from the window user data SelfObj := TJvAVICapture(GetWindowLong(hWnd, GWL_USERDATA)); if SelfObj <> nil then SelfObj.DoVideoStream(videoHdr); Result := LRESULT(Ord(True)); end; // this is the callback when an audio buffer is ready to be written to disk // and only when using streaming capture // will only be called if user chose so with ueWaveStream function WaveStreamCallback(hWnd: HWND; waveHdr: PWaveHdr): LRESULT; stdcall; var SelfObj: TJvAVICapture; begin // get the Pointer to self from the window user data SelfObj := TJvAVICapture(GetWindowLong(hWnd, GWL_USERDATA)); if SelfObj <> nil then SelfObj.DoWaveStream(waveHdr); Result := LRESULT(Ord(True)); end; // this is the callback called when a precise capture control event has // occured. Only called if user chose so with ueCapControl function CapControlCallback(hWnd: HWND; nState: Integer): LRESULT; stdcall; var SelfObj: TJvAVICapture; res: Boolean; begin res := True; // get the Pointer to self from the window user data SelfObj := TJvAVICapture(GetWindowLong(hWnd, GWL_USERDATA)); if SelfObj <> nil then SelfObj.DoCapControl(nState, res); Result := LRESULT(Ord(res)); end; //=== { TJvVideoFormat } ===================================================== constructor TJvVideoFormat.Create; begin inherited Create; FHWnd := 0; end; procedure TJvVideoFormat.Update; var BmpInfo: BITMAPINFOHEADER; begin if (FHWnd <> 0) and capDriverConnected(FHWnd) then begin // get format from the AviCap window capGetVideoFormat(FHWnd, @BmpInfo, SizeOf(BmpInfo)); // update the internal values FWidth := BmpInfo.biWidth; FHeight := BmpInfo.biHeight; FBitDepth := BmpInfo.biBitCount; FCompression := BmpInfo.biCompression; case BitDepth of 0: FPixelFormat := pfDevice; 1: FPixelFormat := pf1bit; 4: FPixelFormat := pf4bit; 8: FPixelFormat := pf8bit; 16: FPixelFormat := pf15bit; 24: FPixelFormat := pf24bit; 32: FPixelFormat := pf32bit; else FPixelFormat := pfCustom; end; end; end; //=== { TJvAudioFormat } ===================================================== constructor TJvAudioFormat.Create; begin inherited Create; FHWnd := 0; FExtra := nil; end; procedure TJvAudioFormat.Update; var Info: tWAVEFORMATEX; begin if (FHWnd <> 0) and capDriverConnected(FHWnd) then begin // gets the format from the AviCap window capGetAudioFormat(FHWnd, @Info, SizeOf(Info)); // sets the internal values FFormatTag := Info.wFormatTag; FChannels := Info.nChannels; FSamplesPerSec := Info.nSamplesPerSec; FAvgBytesPerSec := Info.nAvgBytesPerSec; FBlockAlign := Info.nBlockAlign; FBitsPerSample := Info.wBitsPerSample; FExtraSize := Info.cbSize; // if there is extra data, save it too if FExtraSize > 0 then begin // if there was extra data saved before, free it before if FExtra <> nil then FreeMem(FExtra); GetMem(FExtra, ExtraSize); CopyMemory(FExtra, (PChar(@Info)) + SizeOf(tWAVEFORMATEX), FExtraSize); end; end; end; function TJvAudioFormat.Apply: Boolean; var pwfex: PWaveFormatEx; begin Result := False; if FHWnd <> 0 then begin FillWaveFormatEx(pwfex); Result := capSetAudioFormat(FHWnd, pwfex, SizeOf(tWAVEFORMATEX) + pwfex^.cbSize); end; end; procedure TJvAudioFormat.FillWaveFormatEx(var wfex: PWaveFormatEx); begin case FormatTag of WAVE_FORMAT_PCM: begin GetMem(wfex, SizeOf(tWAVEFORMATEX)); wfex^.wFormatTag := FFormatTag; // ensure maximum 2 channels wfex^.nChannels := FChannels mod 3; wfex^.nSamplesPerSec := FSamplesPerSec; // ensure 8 or 16 bits wfex^.wBitsPerSample := ((FBitsPerSample div 8) mod 3) * 8; // using rules defined in Documentation wfex^.nBlockAlign := wfex.nChannels * wfex.wBitsPerSample div 8; wfex^.nAvgBytesPerSec := wfex.nSamplesPerSec * wfex.nBlockAlign; wfex^.cbSize := 0; end; else GetMem(wfex, SizeOf(tWAVEFORMATEX) + FExtraSize); wfex^.wFormatTag := FFormatTag; wfex^.nChannels := FChannels; wfex^.nSamplesPerSec := FSamplesPerSec; wfex^.nAvgBytesPerSec := FAvgBytesPerSec; wfex^.nBlockAlign := FBlockAlign; wfex^.wBitsPerSample := FBitsPerSample; wfex^.cbSize := FExtraSize; // copy Extra to the end of the structure CopyMemory((PChar(@wfex)) + SizeOf(tWAVEFORMATEX), FExtra, FExtraSize); end; end; //=== { TJvCaptureSettings } ================================================= constructor TJvCaptureSettings.Create; begin inherited Create; FHWnd := 0; FFrameDelay := 1; end; procedure TJvCaptureSettings.SetKeyAbort(nKeyAbort: TJvVirtualKey); var Modifiers: Word; begin // Unregister any previous hotkey if FKeyAbort <> 0 then UnregisterHotKey(FHWnd, 0); // register hotkey, only if needed if nKeyAbort <> 0 then begin Modifiers := 0; if (nKeyAbort and $4000) <> 0 then Modifiers := Modifiers or MOD_SHIFT; if (nKeyAbort and $8000) <> 0 then Modifiers := Modifiers or MOD_CONTROL; if RegisterHotKey(FHWnd, 0, Modifiers, nKeyAbort and $FF) then FKeyAbort := nKeyAbort; end else FKeyAbort := nKeyAbort; end; procedure TJvCaptureSettings.Update; var Parms: TCAPTUREPARMS; begin if FHWnd <> 0 then begin // get capture settings from window capCaptureGetSetup(FHWnd, @Parms, SizeOf(Parms)); // udapte internal settings with Parms do begin FFrameDelay := dwRequestMicroSecPerFrame; // FFramesPerSec := 1/dwRequestMicroSecPerFrame*1E6; FConfirmCapture := fMakeUserHitOKToCapture; FPercentDropForError := wPercentDropForError; FYield := FYield; FNumVideoBuffer := wNumVideoRequested; FCaptureAudio := FCaptureAudio; FNumAudioBuffer := wNumAudioRequested; FAbortLeftMouse := FAbortLeftMouse; FAbortRightMouse := FAbortRightMouse; FKeyAbort := vKeyAbort; FLimitEnabled := FLimitEnabled; FTimeLimit := wTimeLimit; FStepCapture2x := fStepCaptureAt2x; FStepCaptureAverageFrames := wStepCaptureAverageFrames; FAudioBufferSize := dwAudioBufferSize; FAudioMaster := (AVStreamMaster = AVSTREAMMASTER_AUDIO); FMCIControl := FMCIControl; FMCIStep := fStepMCIDevice; FMCIStartTime := dwMCIStartTime; FMCIStopTime := dwMCIStopTime; end; end; end; function TJvCaptureSettings.Apply: Boolean; var Parms: TCAPTUREPARMS; begin Result := False; if FHWnd <> 0 then begin // get original values from window capCaptureGetSetup(FHWnd, @Parms, SizeOf(Parms)); // set our own values with Parms do begin dwRequestMicroSecPerFrame := FFrameDelay; fMakeUserHitOKToCapture := ConfirmCapture; wPercentDropForError := PercentDropForError; FYield := Yield; wNumVideoRequested := NumVideoBuffer; FCaptureAudio := CaptureAudio; wNumAudioRequested := NumAudioBuffer; FAbortLeftMouse := AbortLeftMouse; FAbortRightMouse := AbortRightMouse; vKeyAbort := FKeyAbort; FLimitEnabled := LimitEnabled; wTimeLimit := TimeLimit; fStepCaptureAt2x := StepCapture2x; wStepCaptureAverageFrames := StepCaptureAverageFrames; dwAudioBufferSize := AudioBufferSize; if AudioMaster then AVStreamMaster := AVSTREAMMASTER_AUDIO else AVStreamMaster := AVSTREAMMASTER_NONE; FMCIControl := Self.FMCIControl; fStepMCIDevice := Self.FMCIStep; dwMCIStartTime := FMCIStartTime; dwMCIStopTime := FMCIStopTime; end; // apply new settings Result := capCaptureSetSetup(FHWnd, @Parms, SizeOf(Parms)); end; end; function TJvCaptureSettings.GetFPS: Double; begin Result := 1 / FFrameDelay * 1.0E6; end; procedure TJvCaptureSettings.SetFPS(const Value: Double); begin FFrameDelay := Round(1.0E6 / Value); end; procedure TJvCaptureSettings.SetFrameDelay(const Value: Cardinal); begin // to avoid division by 0 and stupid value for a time delay // between two frames if Value = 0 then FFrameDelay := 1 else FFrameDelay := Value; end; //=== { TJvPalette } ========================================================= constructor TJvPalette.Create; begin inherited Create; FHWnd := 0; end; function TJvPalette.Load(FileName: string): Boolean; begin Result := (FHWnd <> 0) and capPaletteOpen(FHWnd, PChar(FileName)); end; function TJvPalette.Save(FileName: string): Boolean; begin Result := (FHWnd <> 0) and capPaletteSave(FHWnd, PChar(FileName)); end; function TJvPalette.PasteFromClipboard: Boolean; begin Result := (FHWnd <> 0) and capPalettePaste(FHWnd); end; function TJvPalette.AutoCreate(nbFrames: Integer; nbColors: TJvPaletteNbColors): Boolean; begin Result := (FHWnd <> 0) and capPaletteAuto(FHWnd, nbFrames, nbColors); end; function TJvPalette.ManuallyCreate(Flag: Boolean; nbColors: TJvPaletteNbColors): Boolean; begin Result := (FHWnd <> 0) and capPaletteManual(FHWnd, Flag, nbColors); end; //=== { TJvAVICapture } ====================================================== constructor TJvAVICapture.Create(AOwner: TComponent); begin inherited Create(AOwner); FScrollPos := TJvScrollPos.Create; // Not connected yet FDriverIndex := -1; FFileSizeAlloc := 0; FOverlaying := False; FPreviewing := False; FUsedEvents := []; FVideoLeft := 0; FVideoTop := 0; FDrivers := TStringList.Create; // Preview frame delay = 50ms between frames (20 frames per second) FPreviewFrameDelay := 50; FVideoFormat := TJvVideoFormat.Create; FAudioFormat := TJvAudioFormat.Create; // Default to PCM, 11.025khz 8 bit Mono with FAudioFormat do begin FormatTag := WAVE_FORMAT_PCM; Channels := 1; BitsPerSample := 8; SamplesPerSec := 11025; end; FCaptureSettings := TJvCaptureSettings.Create; FPalette := TJvPalette.Create; SetBounds(0, 0, 320, 240); EnumDrivers; // set all events to 'used' UsedEvents := [ueError, ueStatus, ueYield, ueFrame, ueVideoStream, ueWaveStream, ueCapControl]; end; destructor TJvAVICapture.Destroy; begin Disconnect; FDrivers.Free; FCaptureSettings.Free; FAudioFormat.Free; FVideoFormat.Free; FPalette.Free; FScrollPos.Free; inherited Destroy; end; procedure TJvAVICapture.CreateWindowHandle(const Params: TCreateParams); begin // ensure the TWinControl is fully created first inherited CreateWindowHandle(Params); // no hint to show //ParentShowHint := False; //ShowHint := False; // create the AviCap window FHWnd := capCreateCaptureWindow( PChar(Title), // use the user defined title WS_VISIBLE or // window is visible WS_CHILD and // it is a child window not WS_CAPTION and // it has no caption not WS_BORDER, // it has no border 0, // 0 left coordinate 0, // 0 top coordinate 320, // width defaults to 320 240, // height defaults to 240 inherited Handle, // child of the TWinControl 0); // window identifier // place the Pointer to Self in the user data SetWindowLong(FHWnd, GWL_USERDATA, Integer(Self)); // replace the WndProc to be ours FPreviousWndProc := Pointer(GetWindowLong(FHWnd, GWL_WNDPROC)); SetWindowLong(FHWnd, GWL_WNDPROC, Integer(@CustomWndProc)); // updates the FHWnd member of audio format, capture settings, palette and video format // yes, they are private members, but they can still be accessed by a foreign class // because the access is done in the same pas file ! FAudioFormat.FHWnd := FHWnd; FCaptureSettings.FHWnd := FHWnd; FPalette.FHWnd := FHWnd; FVideoFormat.FHWnd := FHWnd; // sets the callbacks UsedEvents := FUsedEvents; end; procedure TJvAVICapture.DestroyWindowHandle; begin // restore the window proc SetWindowLong(FHWnd, GWL_WNDPROC, Integer(FPreviousWndProc)); // destroy the AviCap Window DestroyWindow(FHWnd); // let the TWinControl window be destroyed inherited DestroyWindowHandle; end; procedure TJvAVICapture.SetTitle(nTitle: string); begin if FHWnd <> 0 then begin FTitle := nTitle; SetWindowText(FHWnd, PChar(FTitle)); end; end; procedure TJvAVICapture.SetPreviewFrameDelay(nPreviewFrameDelay: Cardinal); begin FPreviewFrameDelay := nPreviewFrameDelay; if Previewing then begin StopPreview; StartPreview; end; end; procedure TJvAVICapture.SetPreviewFPS(nPreviewFPS: Double); begin SetPreviewFrameDelay(Round(1.0E3 * 1.0 / nPreviewFPS)); end; function TJvAVICapture.GetPreviewFPS: Double; begin Result := 1.0E3 * 1.0 / FPreviewFrameDelay; end; procedure TJvAVICapture.SetPreviewing(nPreviewing: Boolean); begin if (not nPreviewing) and Previewing then StopPreview; if nPreviewing and (not Previewing) then StartPreview; end; procedure TJvAVICapture.SetFileName(nFileName: TFileName); begin if FHWnd <> 0 then begin FFileName := nFileName; // change the filename capFileSetCaptureFile(FHWnd, PChar(nFileName)); end; end; function TJvAVICapture.GetFileName: TFileName; var Name: array [0..MAX_PATH] of Char; begin if FHWnd <> 0 then begin // get the filename from the window capFileGetCaptureFile(FHWnd, Name, SizeOf(Name)); FFileName := Name; end; Result := FFileName; end; function TJvAVICapture.GetDrivers: TStrings; begin Result := FDrivers; end; procedure TJvAVICapture.SetFileSizeAlloc(nFileSizeAlloc: Cardinal); begin if FHWnd <> 0 then begin FFileSizeAlloc := nFileSizeAlloc; capFileAlloc(FHWnd, FFileSizeAlloc); end; end; procedure TJvAVICapture.SetUsedEvents(nUsedEvents: TJvUsedEvents); begin FUsedEvents := nUsedEvents; if FHWnd <> 0 then begin if ueError in FUsedEvents then capSetCallbackOnError(FHWnd, @ErrorCallback) else capSetCallbackOnError(FHWnd, nil); if ueStatus in FUsedEvents then capSetCallbackOnStatus(FHWnd, @StatusCallback) else capSetCallbackOnStatus(FHWnd, nil); if ueYield in FUsedEvents then capSetCallbackOnYield(FHWnd, @YieldCallback) else capSetCallbackOnYield(FHWnd, nil); if ueFrame in FUsedEvents then capSetCallbackOnFrame(FHWnd, @FrameCallback) else capSetCallbackOnFrame(FHWnd, nil); if ueVideoStream in FUsedEvents then capSetCallbackOnVideoStream(FHWnd, @VideoStreamCallback) else capSetCallbackOnVideoStream(FHWnd, nil); if ueWaveStream in FUsedEvents then capSetCallbackOnWaveStream(FHWnd, @WaveStreamCallback) else capSetCallbackOnWaveStream(FHWnd, nil); if ueCapControl in FUsedEvents then capSetCallbackOnCapControl(FHWnd, @CapControlCallback) else capSetCallbackOnCapControl(FHWnd, nil); end; end; procedure TJvAVICapture.SetOverlaying(nOverlaying: Boolean); begin if not nOverlaying then begin if Overlaying then StopOverlay; end else if not Overlaying then StartOverlay; end; function TJvAVICapture.GetDriverName: string; var Name: array [0..MAX_PATH] of Char; begin if FHWnd <> 0 then begin capDriverGetName(FHWnd, Name, SizeOf(Name)); Result := Name; end else Result := RsNotConnected; end; function TJvAVICapture.GetDriverVersion: string; var Version: array [0..MAX_PATH] of Char; begin if FHWnd <> 0 then begin capDriverGetVersion(FHWnd, Version, SizeOf(Version)); Result := Version; end else Result := RsNotConnected; end; procedure TJvAVICapture.SetScrollPos(nScrollPos: TJvScrollPos); var TmpPoint: TPoint; begin if FHWnd <> 0 then begin FScrollPos := nScrollPos; TmpPoint.X := FScrollPos.Left; TmpPoint.Y := FScrollPos.Top; capSetScrollPos(FHWnd, @TmpPoint); end; end; procedure TJvAVICapture.SetMCIDevice(nMCIDevice: string); begin if FHWnd <> 0 then capSetMCIDeviceName(FHWnd, PChar(nMCIDevice)); end; function TJvAVICapture.GetMCIDevice: string; var Name: array [0..MAX_PATH] of Char; begin if FHWnd <> 0 then begin capGetMCIDeviceName(FHWnd, Name, SizeOf(Name)); Result := Name; end else Result := RsNotConnected; end; procedure TJvAVICapture.SetDriverIndex(nIndex: TJvDriverIndex); begin if Connect(nIndex) then FDriverIndex := nIndex; end; procedure TJvAVICapture.SetCapturing(nCapturing: Boolean); begin if FCapturing then begin if not nCapturing then StopCapture; end else if nCapturing then if FNoFile then StartCaptureNoFile else StartCapture; end; procedure TJvAVICapture.SetNoFile(nNoFile: Boolean); begin // only allow to change if not capturing if not FCapturing then FNoFile := nNoFile; end; procedure TJvAVICapture.UpdateCaps; var Caps: TCAPDRIVERCAPS; begin if FHWnd <> 0 then begin // get value from the window capDriverGetCaps(FHWnd, @Caps, SizeOf(Caps)); // update internal value FDriverCaps := []; if Caps.fHasOverlay then FDriverCaps := FDriverCaps + [dcOverlay]; if Caps.fHasDlgVideoSource then FDriverCaps := FDriverCaps + [dcDlgVideoSource]; if Caps.fHasDlgVideoFormat then FDriverCaps := FDriverCaps + [dcDlgVideoFormat]; if Caps.fHasDlgVideoDisplay then FDriverCaps := FDriverCaps + [dcDlgVideoDisplay]; if Caps.fCaptureInitialized then FDriverCaps := FDriverCaps + [dcCaptureInitialized]; if Caps.fDriverSuppliesPalettes then FDriverCaps := FDriverCaps + [dcSuppliesPalettes]; end; end; procedure TJvAVICapture.UpdateCaptureStatus; begin if FHWnd <> 0 then begin capGetStatus(FHWnd, @FCaptureStatus, SizeOf(FCaptureStatus)); FCapturing := FCaptureStatus.fCapturingNow; FPreviewing := FCaptureStatus.fLiveWindow; FOverlaying := FCaptureStatus.fOverlayWindow; end; end; procedure TJvAVICapture.StopCallbacks; begin if FHWnd <> 0 then begin if not (csDesigning in ComponentState) then capSetCallbackOnError(FHWnd, nil); capSetCallbackOnStatus(FHWnd, nil); capSetCallbackOnYield(FHWnd, nil); capSetCallbackOnFrame(FHWnd, nil); capSetCallbackOnVideoStream(FHWnd, nil); capSetCallbackOnWaveStream(FHWnd, nil); capSetCallbackOnCapControl(FHWnd, nil); end; end; procedure TJvAVICapture.ResizeAviCapWindow(Width, Height: Integer); begin MoveWindow(FHwnd, 0, 0, Width, Height, True); end; procedure TJvAVICapture.RestartCallbacks; begin UsedEvents := FUsedEvents; end; procedure TJvAVICapture.SetBounds(nLeft, nTop, nWidth, nHeight: Integer); var lWidth, lHeight: Integer; begin // reload video size FVideoFormat.Update; // Force the width and height to stay in a constant interval : // not less than cMinHeight and cMinWidth // not more than the video size // Autosizing will have been enforced in the CanAutoSize procedure lHeight := Max(Min(nHeight, FVideoFormat.Height), cMinHeight); lWidth := Max(Min(nWidth, FVideoFormat.Width), cMinWidth); // If we changed the size here, force the resize of the internal window. if (lHeight <> nHeight) or (lWidth <> nWidth) then ResizeAviCapWindow(lWidth, lHeight); inherited SetBounds(nLeft, nTop, lWidth, lHeight); end; procedure TJvAVICapture.EnumDrivers; var I: Integer; DeviceName: array [0..MAX_PATH] of Char; DeviceVersion: array [0..MAX_PATH] of Char; begin // no more than 10 drivers in the system (cf Win32 API) for I := 0 to 9 do if capGetDriverDescription(I, DeviceName, SizeOf(DeviceName), DeviceVersion, SizeOf(DeviceVersion)) then Drivers.Add(DeviceName); end; function TJvAVICapture.Connect(Driver: TJvDriverIndex): Boolean; begin // Request a handle, will create the AviCap internal window // will trigger an exception if no parent is set HandleNeeded; if Driver = -1 then begin // if Driver is -1, then we disconnect Result := Disconnect; // force the video format to be 0, 0 and update the size of the control FVideoFormat.FHeight := 0; FVideoFormat.FWidth := 0; end else begin // else we try to connect to that driver Result := capDriverConnect(FHWnd, Driver); FConnected := Result; if FConnected then begin // if connected successfully, update the property FDriverIndex := Driver; UpdateCaps; FCaptureSettings.Update; FAudioFormat.Update; UpdateCaptureStatus; end else // if not, trigger an exception raise EInvalidDriverIndexError.Create(Driver, Drivers.Count - 1); end; AdjustSize; end; function TJvAVICapture.Disconnect: Boolean; begin Result := capDriverDisconnect(FHWnd); UpdateCaptureStatus; FConnected := False; end; function TJvAVICapture.ShowDialog(Dialog: TJvVideoDialog): Boolean; begin Result := False; if FHWnd <> 0 then begin case Dialog of vdSource: Result := capDlgVideoSource(FHWnd); vdFormat: Result := capDlgVideoFormat(FHWnd); vdDisplay: Result := capDlgVideoDisplay(FHWnd); vdCompression: Result := capDlgVideoCompression(FHWnd); end; // update everything to reflect user changes UpdateCaps; VideoFormat.Update; AudioFormat.Update; CaptureSettings.Update; AdjustSize; end; end; function TJvAVICapture.StartPreview: Boolean; begin // if we have a valid window that is not already previewing if (FHWnd <> 0) and not FPreviewing then begin capPreviewRate(FHWnd, FPreviewFrameDelay); FPreviewing := capPreview(FHWnd, True); UpdateCaptureStatus; VideoFormat.Update; if FPreviewing then begin FOverlaying := False; RestartCallbacks; end; Result := FPreviewing; end else Result := False; end; function TJvAVICapture.StopPreview: Boolean; begin // if we have a valid window doing previewing // then the result is the result of capPreview Result := (FHWnd <> 0) and FPreviewing and capPreview(FHWnd, False); // if succesfully stopped preview, update internal values if Result then begin UpdateCaptureStatus; FPreviewing := False; StopCallbacks; end; end; function TJvAVICapture.StartCapture: Boolean; begin if (FHWnd <> 0) and not FCapturing and ApplyCaptureSettings and ApplyAudioFormat then begin UpdateCaptureStatus; VideoFormat.Update; FCapturing := capCaptureSequence(FHWnd); if FCapturing then RestartCallbacks; Result := FCapturing; end else Result := False; end; function TJvAVICapture.StartCaptureNoFile: Boolean; begin if (FHWnd <> 0) and not FCapturing and ApplyCaptureSettings and ApplyAudioFormat then begin UpdateCaptureStatus; VideoFormat.Update; FCapturing := capCaptureSequenceNoFile(FHWnd); FNoFile := True; if FCapturing then RestartCallbacks; Result := FCapturing; end else Result := False; end; function TJvAVICapture.StopCapture: Boolean; begin Result := (FHWnd <> 0) and FCapturing and capCaptureStop(FHWnd); if Result then begin FCapturing := False; StopCallbacks; end; end; function TJvAVICapture.AbortCapture: Boolean; begin Result := (FHWnd <> 0) and FCapturing and capCaptureAbort(FHWnd); if Result then begin FCapturing := False; StopCallbacks; end; end; function TJvAVICapture.StartSingleFrameCapture: Boolean; begin Result := (FHWnd <> 0) and not FSingleFrameCapturing and capCaptureSingleFrameOpen(FHWnd); if Result then begin UpdateCaptureStatus; VideoFormat.Update; RestartCallbacks; FSingleFrameCapturing := True; end; end; function TJvAVICapture.CaptureFrame: Boolean; begin Result := (FHWnd <> 0) and FSingleFrameCapturing and capCaptureSingleFrame(FHWnd); UpdateCaptureStatus; VideoFormat.Update; end; function TJvAVICapture.StopSingleFrameCapture: Boolean; begin Result := (FHWnd <> 0) and FSingleFrameCapturing and capCaptureSingleFrameClose(FHWnd); if Result then begin UpdateCaptureStatus; VideoFormat.Update; StopCallbacks; FSingleFrameCapturing := False; end; end; function TJvAVICapture.StartOverlay: Boolean; begin if (FHWnd <> 0) and not FOverlaying then begin capPreviewRate(FHWnd, FPreviewFrameDelay); FOverlaying := capOverlay(FHWnd, True); UpdateCaptureStatus; VideoFormat.Update; if FOverlaying then begin FPreviewing := False; RestartCallbacks; end; Result := FOverlaying; end else Result := False; end; function TJvAVICapture.StopOverlay: Boolean; begin Result := (FHWnd <> 0) and FOverlaying and capOverlay(FHWnd, False); if Result then begin UpdateCaptureStatus; FOverlaying := False; StopCallbacks; end; end; function TJvAVICapture.ApplyCaptureSettings: Boolean; begin Result := CaptureSettings.Apply; end; function TJvAVICapture.ApplyAudioFormat: Boolean; begin Result := AudioFormat.Apply; end; function TJvAVICapture.SaveAs(Name: string): Boolean; begin Result := (FHWnd <> 0) and capFileSaveAs(FHWnd, PChar(Name)); end; function TJvAVICapture.SetInfoChunk(const Chunk: TCAPINFOCHUNK): Boolean; begin Result := (FHWnd <> 0) and capFileSetInfoChunk(FHWnd, @Chunk); end; function TJvAVICapture.SaveDIB(Name: string): Boolean; begin Result := (FHWnd <> 0) and capFileSaveDIB(FHWnd, PChar(Name)); end; function TJvAVICapture.CopyToClipboard: Boolean; begin Result := (FHWnd <> 0) and capEditCopy(FHWnd); end; function TJvAVICapture.GrabFrame(Stop: Boolean): Boolean; begin Result := False; if FHWnd <> 0 then if Stop then begin FPreviewing := False; FOverlaying := False; Result := capGrabFrame(FHWnd); end else Result := capGrabFrameNoStop(FHWnd); end; procedure TJvAVICapture.DoError(ErrId: Integer; Str: string); begin if csDesigning in ComponentState then Windows.MessageBox(WindowHandle, PChar(Str), PChar(RsErrorMessagePrefix + IntToStr(ErrId)), MB_ICONERROR); if Assigned(FOnError) then FOnError(Self, ErrId, Str); end; procedure TJvAVICapture.DoStatus(nId: Integer; Str: string); begin UpdateCaptureStatus; if Assigned(FOnStatus) then FOnStatus(Self, nId, Str); end; procedure TJvAVICapture.DoYield; begin UpdateCaptureStatus; if Assigned(FOnYield) then FOnYield(Self); end; procedure TJvAVICapture.DoFrame(videoHdr: PVIDEOHDR); begin if Assigned(FOnFrame) then FOnFrame(Self, videoHdr); end; procedure TJvAVICapture.DoVideoStream(videoHdr: PVIDEOHDR); begin if Assigned(FOnVideoStream) then FOnVideoStream(Self, videoHdr); end; procedure TJvAVICapture.DoWaveStream(waveHdr: PWaveHdr); begin if Assigned(FOnWaveStream) then FOnWaveStream(Self, waveHdr); end; procedure TJvAVICapture.DoCapControl(nState: Integer; var AResult: Boolean); begin AResult := True; if Assigned(FOnCapControl) then FOnCapControl(Self, nState, AResult); end; procedure TJvAVICapture.SetVideoLeft(const Value: Integer); var P: TPoint; begin P.X := Value; P.Y := VideoTop; if capSetScrollPos(FHWnd, @P) then FVideoLeft := Value; end; procedure TJvAVICapture.SetVideoTop(const Value: Integer); var P: TPoint; begin P.X := VideoLeft; P.Y := Value; if capSetScrollPos(FHWnd, @P) then FVideoTop := Value; end; function TJvAVICapture.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; begin // always possible to do autosizing Result := True; // reload video size FVideoFormat.Update; // force the width and height to be equal // to the one from the video (with a minimum value set // in case there is no video yet) NewHeight := Max(cMinHeight, FVideoFormat.Height); NewWidth := Max(cMinWidth, FVideoFormat.Width); // We must call ResizeAviCapWindow here as well as in SetBounds because // CanAutoSize might be call without a call to SetBounds. ResizeAviCapWindow(NewWidth, NewHeight); end; procedure TJvAVICapture.SetSingleFrameCapturing(const Value: Boolean); begin if Value then StartSingleFrameCapture else StopSingleFrameCapture; end; //=== EInvalidDriverIndexError =============================================== constructor EInvalidDriverIndexError.Create(Index: TJvDriverIndex; MaxIndex: TJvDriverIndex); begin inherited CreateResFmt(@RsEInvalidDriverIndex, [Index, MaxIndex]); end; {$IFDEF UNITVERSIONING} initialization RegisterUnitVersion(HInstance, UnitVersioning); finalization UnregisterUnitVersion(HInstance); {$ENDIF UNITVERSIONING} end.