videocap.pas

·ImageEn 2.3.0 ImageEn一组用于图像处理、查看和分析的Delphi控件。能够保存几种图像格式

(*
Copyright (c) 1998-2007 by HiComponents. All rights reserved.

This software comes without express or implied warranty.
In no case shall the author be liable for any damage or unwanted behavior of any
computer hardware and/or software.

HiComponents grants you the right to include the compiled component
in your application, whether COMMERCIAL, SHAREWARE, or FREEWARE,
BUT YOU MAY NOT DISTRIBUTE THIS SOURCE CODE OR ITS COMPILED .DCU IN ANY FORM.

ImageEn, IEvolution and ImageEn ActiveX may not be included in any commercial,
shareware or freeware libraries or components.

email: [e-mail]

http://www.hicomponents.com
*)

unit videocap;

{$R-}
{$Q-}

{$I ie.inc}

{$IFDEF IEINCLUDEVIDEOCAPTURE}

interface

uses
  Windows, Messages, SysUtils, StdCtrls, Classes, Graphics, Controls, Forms, ImageEnView, ImageEnProc,
  hyiedefs, ievect, ieview, hyieutils;

type

  TVideoCapException = class(Exception);

{!!
<FS>TVCDisplayMode

<FM>Declaration<FC>
type TVCDisplayMode = (dmPreview, dmOverlay);

<FM>Description<FN>
dmPreview: copy video input into a temporary buffer, then display with GDI.
dmOverlay: bypass GDI by sending video input to video card directly.
!!}
  TVCDisplayMode = (dmPreview, dmOverlay);

{!!
<FS>TVideoFrameEvent

<FM>Declaration<FC>
type TVideoFrameEvent=procedure(Sender:TObject; Bitmap:<A TIEDibBitmap>) of object;

<FM>Description<FN>
The Bitmap parameter is the current frame.
!!}
  TVideoFrameEvent = procedure(Sender: TObject; Bitmap: TIEDibBitmap) of object;
  
{!!
<FS>TVideoFrameRawEvent

<FM>Declaration<FC>
TVideoFrameRawEvent = procedure(Sender: TObject; hDib: Thandle; pData: pointer) of object;

<FM>Description<FN>
hDib is an handle to TBITMAPINFO structure and pData is the pixels of the image.
!!}
  TVideoFrameRawEvent = procedure(Sender: TObject; hDib: Thandle; pData: pointer) of object;

{!!
<FS>TCAPDRIVERCAPS

<FM>Declaration<FC>
}
  TCAPDRIVERCAPS = record
    wDeviceIndex: integer;
    fHasOverlay: longbool;
    fHasDlgVideoSource: longbool;
    fHasDlgVideoFormat: longbool;
    fHasDlgVideoDisplay: longbool;
    fCaptureInitialized: longbool;
    fDriverSuppliesPalettes: longbool;
    hVideoIn: THandle;
    hVideoOut: THandle;
    hVideoExtIn: THandle;
    hVideoExtout: THandle;
  end;
{!!}

{!!
<FS>PCAPDRIVERCAPS

<FM>Declaration<FC>
type PCAPDRIVERCAPS = ^<A TCAPDRIVERCAPS>;
!!}
  PCAPDRIVERCAPS = ^TCAPDRIVERCAPS;

{!!
<FS>TVIDEOHDR

<FM>Declaration<FC>
}
  TVIDEOHDR = record
    lpData: pbyte;
    dwBufferLength: dword;
    dwBytesUsed: dword;
    dwTimeCaptured: dword;
    dwUser: dword;
    dwFlags: dword;
    dwReserved: array[0..3] of dword;
  end;
{!!}

{!!
<FS>PVIDEOHDR

<FM>Declaration<FC>
type PVIDEOHDR = ^<A TVIDEOHDR>;
!!}
  PVIDEOHDR = ^TVIDEOHDR;

  TCAPSTATUS = record
    uiImageWidth: dword;
    uiImageHeight: dword;
    fLiveWindow: longbool;
    fOverlayWindow: longbool;
    fScale: longbool;
    ptScroll: TPOINT;
    fUsingDefaultPalette: longbool;
    fAudioHardware: longbool;
    fCapFileExists: longbool;
    dwCurrentVideoFrame: dword;
    dwCurrentVideoFramesDropped: dword;
    dwCurrentWaveSamples: dword;
    dwCurrentTimeElapsedMS: dword;
    hPalCurrent: THandle;
    fCapturingNow: longbool;
    dwReturn: dword;
    wNumVideoAllocated: dword;
    wNumAudioAllocated: dword;
  end;
  PCAPSTATUS = ^TCAPSTATUS;

  PCAPTUREPARMS = ^TCAPTUREPARMS;
  TCAPTUREPARMS = record
    dwRequestMicroSecPerFrame: DWORD; // Requested capture rate
    fMakeUserHitOKToCapture: longbool; // Show "Hit OK to cap" dlg?

    //wPercentDropForError      :WORD;     // Give error msg if > (10%)
    wPercentDropForError: dword; // Give error msg if > (10%)

    fYield: longbool; // Capture via background task?
    dwIndexSize: DWORD; // Max index size in frames (32K)

    //wChunkGranularity         :WORD;     // Junk chunk granularity (2K)
    wChunkGranularity: dword; // Junk chunk granularity (2K)

    fUsingDOSMemory: longbool; // Use DOS buffers?

    //wNumVideoRequested        :WORD;     // # video buffers, If 0, autocalc
    wNumVideoRequested: dword; // # video buffers, If 0, autocalc

    fCaptureAudio: longbool; // Capture audio?

    //wNumAudioRequested        :WORD;     // # audio buffers, If 0, autocalc
    //vKeyAbort                 :WORD;     // Virtual key causing abort
    wNumAudioRequested: dword; // # audio buffers, If 0, autocalc
    vKeyAbort: dword; // Virtual key causing abort

    fAbortLeftMouse: longbool; // Abort on left mouse?
    fAbortRightMouse: longbool; // Abort on right mouse?
    fLimitEnabled: longbool; // Use wTimeLimit?

    //wTimeLimit                :WORD;     // Seconds to capture
    wTimeLimit: dword; // Seconds to capture

    fMCIControl: longbool; // Use MCI video source?
    fStepMCIDevice: longbool; // Step MCI device?
    dwMCIStartTime: DWORD; // Time to start in MS
    dwMCIStopTime: DWORD; // Time to stop in MS
    fStepCaptureAt2x: longbool; // Perform spatial averaging 2x

    //wStepCaptureAverageFrames :WORD;     // Temporal average n Frames
    wStepCaptureAverageFrames: dword; // Temporal average n Frames

    dwAudioBufferSize: DWORD; // Size of audio bufs (0 = default)
    fDisableWriteCache: longbool; // Attempt to disable write cache

    //AVStreamMaster            :WORD;     // Indicates whether the audio stream controls the clock when writing an AVI file.
    AVStreamMaster: dword; // Indicates whether the audio stream controls the clock when writing an AVI file.
  end;

  PWAVEFORMATEX = ^TWAVEFORMATEX;
  TWAVEFORMATEX = record
    wFormatTag: word;
    nChannels: word;
    nSamplesPerSec: dword;
    nAvgBytesPerSec: dword;
    nBlockAlign: word;
    wBitsPerSample: word;
    cbSize: word;
  end;

  //TcapVideoStreamCallback = function(hWnd:HWND; lpVHdr:PVIDEOHDR):LRESULT; stdcall;

{!!
<FS>TImageEnVideoView

<FM>Description<FN>
TImageEnVideoView is derived directly from <A TImageEnVect>. TImageEnVideoView has some properties and methods (zoom, scroll-bars...and, above all, bitmap field and vectorial object capability).

When you set <A TImageEnVideoView.ShowVideo> property to True the current image of TImageEnVideoView is overlapped from video input (stretched to current size of TImageEnVideoView component).

<FM>Properties<FN>

  <A TImageEnVideoView.AudioBitsPerSample>
  <A TImageEnVideoView.AudioChannels>
  <A TImageEnVideoView.AudioFormat>
  <A TImageEnVideoView.AudioSamplesPerSec>
  <A TImageEnVideoView.DisplayMode>
  <A TImageEnVideoView.FitFreeze>
  <A TImageEnVideoView.Frozen>
  <A TImageEnVideoView.HasDlgVideoDisplay>
  <A TImageEnVideoView.HasDlgVideoFormat>
  <A TImageEnVideoView.HasDlgVideoSource>
  <A TImageEnVideoView.HasOverlay>
  <A TImageEnVideoView.PreviewRate>
  <A TImageEnVideoView.RecAudio>
  <A TImageEnVideoView.RecFileName>
  <A TImageEnVideoView.RecFrameRate>
  <A TImageEnVideoView.RecMultitask>
  <A TImageEnVideoView.ShowVideo>
  <A TImageEnVideoView.VideoSource>
  <A TImageEnVideoView.VideoSourceList>
  <A TImageEnVideoView.WndCaptureHandle>

<FM>Methods<FN>

  <A TImageEnVideoView.DoConfigureCompression>
  <A TImageEnVideoView.DoConfigureDisplay>
  <A TImageEnVideoView.DoConfigureFormat>
  <A TImageEnVideoView.DoConfigureSource>
  <A TImageEnVideoView.Freeze>
  <A TImageEnVideoView.GetVideoSize>
  <A TImageEnVideoView.SaveFrame>
  <A TImageEnVideoView.StartRecord>
  <A TImageEnVideoView.StopRecord>
  <A TImageEnVideoView.UnFreeze>

<FM>Events<FN>

  <A TImageEnVideoView.OnJob>
  <A TImageEnVideoView.OnVideoFrameRaw>
  <A TImageEnVideoView.OnVideoFrame>
!!}
  TImageEnVideoView = class(TImageEnVect)
  private
    fShowVideo: boolean; // se true visualizza video input
    fFreeze: boolean; // se true l'immagine