dspack.pas

摄像头视频捕捉程序

{*******************************************************************************
 * DSPack 1.03                                                                *
 *                                                                             *
 * home page : http://www.progdigy.com                                         *
 * email     : [e-mail]                                          *
 *                                                                             *
 * date      : 27-05-2001                                                      *
 *******************************************************************************}

unit dspack;

interface
uses Windows, Messages, Controls, OleServer, Classes, Forms, ActiveX, ComObj, sysutils,
     comctrls, consts, DirectShow, DSUtil;

type
  TDSGraph = class;

  TOnDebug = procedure(sender: TComponent; text: string) of object ;

//******************************************************************************
//
// TDSVideoWindow declaration
//
//******************************************************************************
  TDSVideoWindow = class(TCustomControl)
  private
    FIsFullScreen : boolean;
    FVidHandle    : HWND;
    FGraph        : TDSGraph;
    FOnVidKeyDown   : TKeyEvent;
    FOnVidKeyUp     : TKeyEvent;
    FOnVidDblClick  : TMouseEvent;
    FOnVidMouseDown : TMouseEvent;
    FOnVidMouseUp   : TMouseEvent;
    FOnVidMouseMove : TMouseMoveEvent;
    procedure SetGraph(grf : TDSGraph);
    function  VideoAvailable: boolean;
    procedure VidWndProc(var Msg: TMessage);
    function  GetVideoHandle(out VideoHandle: HWND): boolean;
    procedure CaptureCanvas(Sender: TObject);
    procedure ReleaseCanvas(Sender: TObject);
  protected
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent);override;
    destructor  Destroy; override;
    function    StartFullScreen: boolean;
    function    StopFullScreen: boolean;
    property    IsFullScreen: boolean read FIsFullScreen;
  published
    property Graph: TDSGraph read FGraph write SetGraph;
    property Canvas;
    property PopupMenu;
    property Align;
    property OnVidKeyDown   : TKeyEvent       read FOnVidKeyDown   write FOnVidKeyDown;
    property OnVidKeyUp     : TKeyEvent       read FOnVidKeyUp     write FOnVidKeyUp;
    property OnVidDblClick  : TMouseEvent     read FOnVidDblClick  write FOnVidDblClick;
    property OnVidMouseDown : TMouseEvent     read FOnVidMouseDown write FOnVidMouseDown;
    property OnVidMouseUp   : TMouseEvent     read FOnVidMouseUp   write FOnVidMouseUp;
    property OnVidMouseMove : TMouseMoveEvent read FOnVidMouseMove write FOnVidMouseMove;
  end;

//******************************************************************************
//
// TDSTrackBar declaration
//
//******************************************************************************
  TDSFilterGraph2 = class;

  TDSTrackBar = class(TTrackBar)
  private
    FTimerEnable  : boolean;
    FInterval     : Cardinal;
    FWindowHandle : HWND;
    FGraph        : TDSFilterGraph2;
    procedure UpdateTimer;
    procedure WndProc2(var Msg: TMessage);
    procedure SetTimerEnabled(Value: Boolean);
    procedure SetGraph(grf: TDSFilterGraph2);
    function  SeekingAvailable: boolean;
    function  GetCapabilities: TDSAMSeekingKind;
    function  GetRate: double;
    procedure SetRate(rate: Double);
    procedure ReceiveEndOfStream;
  protected
    procedure Timer; dynamic;
    procedure Changed; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
  published
    property Capabilities : TDSAMSeekingKind read GetCapabilities;
    property Graph : TDSFilterGraph2 read FGraph write SetGraph;
    property Rate: double read GetRate write SetRate;
  end;

//******************************************************************************
// TDSGraph declaration
// Don't use directly !!
// Used internaly to receive Events from a Filter Graph, connections ...
//******************************************************************************
  TVideoSize = record
    Width : WORD;
    Height: WORD;
  end;

  TOnDSEvent = procedure(sender: TOleServer; Event, Param1, Param2: longint) of object;

  TOnGraphBufferingData           = procedure(sender: TComponent; Buffering: boolean) of object ;
  TOnGraphClockChanged            = procedure(sender: TComponent) of object ;
  TOnGraphComplete                = procedure(sender: TComponent; Result: HRESULT; Renderer: IBaseFilter) of object ;
  TOnGraphDeviceLost              = procedure(sender: TComponent; Device: IUnknown; Removed: Boolean) of object ;
  TOnGraphEndOfSegment            = procedure(sender: TComponent; StreamTime: TREFERENCE_TIME; NumSegment: Cardinal) of object ;
  TOnGraphErrorStillPlaying       = procedure(sender: TComponent; Result: HRESULT) of object ;
  TOnGraphErrorAbort              = procedure(sender: TComponent; Result: HRESULT) of object ;
  TOnGraphFullscreenLost          = procedure(sender: TComponent; Renderer: IBaseFilter) of object ;
  TOnGraphChanged                 = procedure(sender: TComponent) of object ;
  TOnGraphOleEvent                = procedure(sender: TComponent; String1, String2: string) of object ;
  TOnGraphOpeningFile             = procedure(sender: TComponent; opening: boolean) of object ;
  TOnGraphPaletteChanged          = procedure(sender: TComponent) of object ;
  TOnGraphPaused                  = procedure(sender: TComponent; Result: HRESULT) of object ;
  TOnGraphQualityChange           = procedure(sender: TComponent) of object ;
  TOnGraphSNDDevInError           = procedure(sender: TComponent; OccurWhen: TSNDDEV_ERR; ErrorCode: DWORD) of object ;
  TOnGraphSNDDevOutError          = procedure(sender: TComponent; OccurWhen: TSNDDEV_ERR; ErrorCode: DWORD) of object ;
  TOnGraphStepComplete            = procedure(sender: TComponent) of object ;
  TOnGraphStreamControlStarted    = procedure(sender: TComponent; PinSender: IPin; Cookie: DWORD) of object ;
  TOnGraphStreamControlStopped    = procedure(sender: TComponent; PinSender: IPin; Cookie: DWORD) of object ;
  TOnGraphStreamErrorStillPlaying = procedure(sender: TComponent; Operation: HRESULT; Value: DWORD) of object ;
  TOnGraphStreamErrorStopped      = procedure(sender: TComponent; Operation: HRESULT; Value: DWORD) of object ;
  TOnGraphUserAbort               = procedure(sender: TComponent) of object ;
  TOnGraphVideoSizeChanged        = procedure(sender: TComponent; size: TVideoSize) of object ;
  TOnGraphTimeCodeAvailable       = procedure(sender: TComponent; From: IBaseFilter; DeviceID: DWORD) of object ;
  TOnGraphEXTDeviceModeChange     = procedure(sender: TComponent; NewMode, DeviceID: DWORD) of object ;

  TDSGraph = class(TOleServer)
  private
    FHandle : HWND;
    FVW : TDSVideoWindow;
    // ROT
    dwregister : longint;
    FRotEnabled: boolean;
    // All Events Code
    FOnDSEvent : TOnDSEvent; 
    // Graph Events
    FOnGraphBufferingData           : TOnGraphBufferingData;
    FOnGraphClockChanged            : TOnGraphClockChanged;
    FOnGraphComplete                : TOnGraphComplete;
    FOnGraphDeviceLost              : TOnGraphDeviceLost;
    FOnGraphEndOfSegment            : TOnGraphEndOfSegment;
    FOnGraphErrorStillPlaying       : TOnGraphErrorStillPlaying;
    FOnGraphErrorAbort              : TOnGraphErrorAbort;
    FOnGraphFullscreenLost          : TOnGraphFullscreenLost;
    FOnGraphChanged                 : TOnGraphChanged;
    FOnGraphOleEvent                : TOnGraphOleEvent;
    FOnGraphOpeningFile             : TOnGraphOpeningFile;
    FOnGraphPaletteChanged          : TOnGraphPaletteChanged;
    FOnGraphPaused                  : TOnGraphPaused;
    FOnGraphQualityChange           : TOnGraphQualityChange;
    FOnGraphSNDDevInError           : TOnGraphSNDDevInError;
    FOnGraphSNDDevOutError          : TOnGraphSNDDevOutError;
    FOnGraphStepComplete            : TOnGraphStepComplete;
    FOnGraphStreamControlStarted    : TOnGraphStreamControlStarted;
    FOnGraphStreamControlStopped    : TOnGraphStreamControlStopped;
    FOnGraphStreamErrorStillPlaying : TOnGraphStreamErrorStillPlaying;
    FOnGraphStreamErrorStopped      : TOnGraphStreamErrorStopped;
    FOnGraphUserAbort               : TOnGraphUserAbort;
    FOnGraphVideoSizeChanged        : TOnGraphVideoSizeChanged;
    FOnGraphTimeCodeAvailable       : TOnGraphTimeCodeAvailable;
    FOnGraphEXTDeviceModeChange     : TOnGraphEXTDeviceModeChange;
    procedure WndProc(var Msg: TMessage);
    procedure FDoEvent;
  protected
    procedure DoEvent(Event, Param1, Param2: longint); dynamic;
    procedure SetROT(value: boolean);
  public
    VideoWindow     : IVideoWindow;
    MediaSeeking    : IMediaSeeking;
    MediaEventEx    : IMediaEventEx;
    GraphBuilder    : IGraphBuilder;
    MediaControl    : IMediaControl;
    BasicAudio      : IBasicAudio;
    BasicVideo2     : IBasicVideo2;
    AMGraphStreams  : IAMGraphStreams;
    FilterChain     : IFilterChain;
    FilterMapper2   : IFilterMapper2;
    GraphConfig     : IGraphConfig;
    GraphVersion    : IGraphVersion;
    MediaEventSink  : IMediaEventSink;
    QueueCommand    : IQueueCommand;
    ResourceManager : IResourceManager;
    VideoFrameStep  : IVideoFrameStep;
    function Connected: boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure QueryInterfaces; dynamic;
    procedure ClearGraph; dynamic;
  published
    property RotEnabled: boolean read FRotEnabled write SetRot default false;
    property OnDSEvent: TOnDSEvent read FOnDSEvent write FOnDSEvent;
    property OnGraphBufferingData           : TOnGraphBufferingData           read FOnGraphBufferingData           write FOnGraphBufferingData;
    property OnGraphClockChanged            : TOnGraphClockChanged            read FOnGraphClockChanged            write FOnGraphClockChanged;
    property OnGraphComplete                : TOnGraphComplete                read FOnGraphComplete                write FOnGraphComplete;
    property OnGraphDeviceLost              : TOnGraphDeviceLost              read FOnGraphDeviceLost              write FOnGraphDeviceLost;
    property OnGraphEndOfSegment            : TOnGraphEndOfSegment            read FOnGraphEndOfSegment            write FOnGraphEndOfSegment;
    property OnGraphErrorStillPlaying       : TOnGraphErrorStillPlaying       read FOnGraphErrorStillPlaying       write FOnGraphErrorStillPlaying;
    property OnGraphErrorAbort              : TOnGraphErrorAbort              read FOnGraphErrorAbort              write FOnGraphErrorAbort;
    property OnGraphFullscreenLost          : TOnGraphFullscreenLost          read FOnGraphFullscreenLost          write FOnGraphFullscreenLost;
    property OnGraphChanged                 : TOnGraphChanged                 read FOnGraphChanged                 write FOnGraphChanged;
    property OnGraphOleEvent                : TOnGraphOleEvent                read FOnGraphOleEvent                write FOnGraphOleEvent;
    property OnGraphOpeningFile             : TOnGraphOpeningFile             read FOnGraphOpeningFile             write FOnGraphOpeningFile;
    property OnGraphPaletteChanged          : TOnGraphPaletteChanged          read FOnGraphPaletteChanged          write FOnGraphPaletteChanged;
    property OnGraphPaused                  : TOnGraphPaused                  read FOnGraphPaused                  write FOnGraphPaused;
    property OnGraphQualityChange           : TOnGraphQualityChange           read FOnGraphQualityChange           write FOnGraphQualityChange;
    property OnGraphSNDDevInError           : TOnGraphSNDDevInError           read FOnGraphSNDDevInError           write FOnGraphSNDDevInError;
    property OnGraphSNDDevOutError          : TOnGraphSNDDevOutError          read FOnGraphSNDDevOutError          write FOnGraphSNDDevOutError;
    property OnGraphStepComplete            : TOnGraphStepComplete            read FOnGraphStepComplete            write FOnGraphStepComplete;
    property OnGraphStreamControlStarted    : TOnGraphStreamControlStarted    read FOnGraphStreamControlStarted    write FOnGraphStreamControlStarted;
    property OnGraphStreamControlStopped    : TOnGraphStreamControlStopped    read FOnGraphStreamControlStopped    write FOnGraphStreamControlStopped;
    property OnGraphStreamErrorStillPlaying : TOnGraphStreamErrorStillPlaying read FOnGraphStreamErrorStillPlaying write FOnGraphStreamErrorStillPlaying;
    property OnGraphStreamErrorStopped      : TOnGraphStreamErrorStopped      read FOnGraphStreamErrorStopped      write FOnGraphStreamErrorStopped;
    property OnGraphUserAbort               : TOnGraphUserAbort               read FOnGraphUserAbort               write FOnGraphUserAbort;
    property OnGraphVideoSizeChanged        : TOnGraphVideoSizeChanged        read FOnGraphVideoSizeChanged        write FOnGraphVideoSizeChanged;
    property OnGraphTimeCodeAvailable       : TOnGraphTimeCodeAvailable       read FOnGraphTimeCodeAvailable       write FOnGraphTimeCodeAvailable;
    property OnGraphEXTDeviceModeChange     : TOnGraphEXTDeviceModeChange     read FOnGraphEXTDeviceModeChange     write FOnGraphEXTDeviceModeChange;
  end;

//******************************************************************************
//
// TDSFilterGraph2 declaration
// use IFilterGraph2 only
//******************************************************************************
  TDSFilterGraph2 = class(TDSGraph)
  private
    FTB : TDSTrackBar;
  protected
    procedure InitServerData; override;
    procedure DoEvent(Event, Param1, Param2: longint); override;
  public
    FilterGraph2    : IFilterGraph2;
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure Connect; override;
    procedure Disconnect; override;
    procedure QueryInterfaces; override;
    procedure ClearGraph; override;
  published
  end;

//******************************************************************************
//
// TDSDVDGraph declaration
//
//******************************************************************************
  TOnDVDAudioStreamChange      = procedure(sender: TComponent;stream, lcid: longint; Lang: string) of object;
  TOnDVDCurrentTime            = procedure(sender: TComponent;heures,minutes,secondes,frames,frate : longint) of object;
  TOnDVDTitleChange            = procedure(sender: TComponent;title: longint) of object;
  TOnDVDChapterStart           = procedure(sender: TComponent;chapter: longint) of object;
  TOnDVDDomain                 = procedure(sender: TComponent) of object;
  TOnDVDAngleChange            = procedure(sender: TComponent;total,current : longint) of object;
  TOnDVDValidUOPSChange        = procedure(sender: TComponent;UOPS: TUOPS) of object;
  TOnDVDButtonChange           = procedure(sender: TComponent;total,current: longint) of object;
  TOnDVDChapterAutoStop        = procedure(sender: TComponent) of object;
  TOnDVDStillOn                = procedure(sender: TComponent; NoButtonAvailable: boolean; seconds: longint) of object;
  TOnDVDStillOff               = procedure(sender: TComponent) of object ;
  TOnDVDSubpictureStreamChange = procedure(sender: TComponent; SubNum, lcid: longint; Lang: string) of object;
  TOnDVDError                  = procedure(sender: TComponent) of object;
  TOnDVDNoFP_PGC               = procedure(sender: TComponent) of object;
  TOnDVDWarning                = procedure(sender: TComponent) of object;
  TOnDVDPlaybackRateChange     = procedure(sender: TComponent; rate:  longint) of object;
  TOnDVDParentalLevelChange    = procedure(sender: TComponent; level: longint) of object;
  TOnDVDPlaybackStopped        = procedure(sender: TComponent) of object;
  TOnDVDAnglesAvailable        = procedure(sender: TComponent; available: boolean) of object;
  TOnDVDPlayPeriodAutoStop     = procedure(sender: TComponent) of object;
  TOnDVDButtonAutoActivated    = procedure(sender: TComponent; Button: DWORD) of object;
  TOnDVDCMDStart               = procedure(sender: TComponent; CmdID: DWORD) of object;
  TOnDVDCMDEnd                 = procedure(sender: TComponent; CmdID: DWORD) of object;
  TOnDVDDiscEjected            = procedure(sender: TComponent) of object;
  TOnDVDDiscInserted           = procedure(sender: TComponent) of object;
  TOnDVDCurrentHMSFTime        = procedure(sender: TComponent; HMSFTimeCode: TDVD_HMSF_TIMECODE; TimeCode: TDVD_TimeCode) of object;
  TOnDVDKaraokeMode            = procedure(sender: TComponent; Played: BOOL) of object;

  TDSDVDGraph = class(TDSGraph)
  private
      FOnDVDAudioStreamChange       : TOnDVDAudioStreamChange     ;
      FOnDVDCurrentTime             : TOnDVDCurrentTime           ;
      FOnDVDTitleChange             : TOnDVDTitleChange           ;
      FOnDVDChapterStart            : TOnDVDChapterStart          ;
      FOnDVDAngleChange             : TOnDVDAngleChange           ;
      FOnDVDValidUOPSChange         : TOnDVDValidUOPSChange       ;
      FOnDVDButtonChange            : TOnDVDButtonChange          ;
      FOnDVDChapterAutoStop         : TOnDVDChapterAutoStop       ;
      FOnDVDStillOn                 : TOnDVDStillOn               ;
      FOnDVDStillOff                : TOnDVDStillOff              ;
      FOnDVDSubpictureStreamChange  : TOnDVDSubpictureStreamChange;
      FOnDVDNoFP_PGC                : TOnDVDNoFP_PGC              ;
      FOnDVDPlaybackRateChange      : TOnDVDPlaybackRateChange    ;
      FOnDVDParentalLevelChange     : TOnDVDParentalLevelChange   ;
      FOnDVDPlaybackStopped         : TOnDVDPlaybackStopped       ;