1806 lines
61 KiB
ObjectPascal
1806 lines
61 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
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 <obones att altern dott org>
|
|
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 11161 2007-01-20 19:59:32Z 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/tags/JVCL3_32/run/JvAVICapture.pas $';
|
|
Revision: '$Revision: 11161 $';
|
|
Date: '$Date: 2007-01-20 20:59:32 +0100 (sam., 20 janv. 2007) $';
|
|
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: LPSTR): 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: LPSTR): 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.
|
|
|