jvavicapture.pas

East make Tray Icon in delphi

    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;
    // 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: '$RCSfile: JvAVICapture.pas,v $';
    Revision: '$Revision: 1.27 $';
    Date: '$Date: 2005/02/17 10:19:58 $';
    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;