teevideoplayer.pas

BCB第三方组件

{**********************************************}
{   TVideoPlayerTool component.                }
{   Copyright (c) 2006-2007 by David Berneda   }
{**********************************************}
unit TeeVideoPlayer;
{$I TeeDefs.inc}

interface

// {$MINENUMSIZE 4}
// {$ALIGN ON}

uses
  {$IFNDEF LINUX}
  Windows, Messages,
  {$ENDIF}
  SysUtils, Classes,
  {$IFDEF CLX}
  QGraphics, QControls, QExtCtrls, QForms, QDialogs, QStdCtrls, QButtons,
  QComCtrls, Qt,
  {$ELSE}
  Graphics, Controls, ExtCtrls, Forms, Dialogs, StdCtrls, Buttons, ComCtrls,
  {$ENDIF}
  TeeFilters, TeEngine, TeeVideo, TeCanvas;

type
  TVideoPlayerTool=class(TTeeCustomTool)
  private
    FFileName : String;
    FFilters  : TFilterItems;
    FLoop     : Boolean;
    FOnFrame  : TNotifyEvent;
    FPicture  : TPicture;

    IBitmap   : TBitmap;
    ICount    : Integer;
    IPaused   : Boolean;
    IPlaying  : Boolean;
    ITimer    : TTimer;
    IEndFrame : Integer;

    IGetFrame : PGETFRAME;
    IStream   : PAVIStream;
    IFile     : PAVIFile;

    procedure Finish;
    function GetEnd: Integer;
    function GetStart: Integer;
    procedure Open;
    procedure TimerEvent(Sender: TObject);
    function GetDelay: Integer;
    procedure SetDelay(const Value: Integer);
    procedure SetFilters(const Value: TFilterItems);
    procedure SetPicture(const Value: TPicture);
  protected
    class Function GetEditorClass:String; override;

    function GetFrame(FrameNumber: Integer):TBitmap; overload;
    procedure GetFrame(FrameNumber: Integer; var b:TBitmap); overload;
  public
    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    class Function Description:String; override;

    procedure Pause;
    procedure Play;
    procedure Stop;

    property Paused:Boolean read IPaused;
    property Picture:TPicture read FPicture write SetPicture;
    property Playing:Boolean read IPlaying;
    property Position:Integer read ICount write ICount;

    property StartFrame:Integer read GetStart;
    property EndFrame:Integer read GetEnd;

  published
    property Delay:Integer read GetDelay write SetDelay default 1;
    property FileName:String read FFileName write FFileName;
    property Filters:TFilterItems read FFilters write SetFilters stored False;
    property Loop:Boolean read FLoop write FLoop default False;

    property OnFrame:TNotifyEvent read FOnFrame write FOnFrame;
  end;

  TVideoPlayerEditor = class(TForm)
    Label1: TLabel;
    EName: TEdit;
    SpeedButton1: TSpeedButton;
    BPlay: TButton;
    Button1: TButton;
    CBLoop: TCheckBox;
    Label2: TLabel;
    EDelay: TEdit;
    UDDelay: TUpDown;
    OpenDialog1: TOpenDialog;
    LFrame: TLabel;
    GroupBox1: TGroupBox;
    RBBack: TRadioButton;
    RBOther: TRadioButton;
    CBDisplay: TComboFlat;
    CBItem: TComboFlat;
    procedure BPlayClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CBLoopClick(Sender: TObject);
    procedure EDelayChange(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ENameChange(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure RBOtherClick(Sender: TObject);
    procedure RBBackClick(Sender: TObject);
    procedure CBDisplayChange(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure CBItemChange(Sender: TObject);
  private
    { Private declarations }
    OldOnFrame : TNotifyEvent;
    Player     : TVideoPlayerTool;
    VideoSize  : Integer;

    procedure PlayerFrame(Sender: TObject);
    procedure SetupPlay;
  public
    { Public declarations }
  end;

implementation

{$IFNDEF CLX}
{$IFNDEF LCL}
{$R *.DFM}
{$ENDIF}
{$ELSE}
{$R *.xfm}
{$ENDIF}

uses
  Chart, TeeConst, TeeProCo, TeeTools, TeeFiltersEditor;

{ TVideoPlayerTool }

Constructor TVideoPlayerTool.Create(AOwner:TComponent);
begin
  inherited;

  InitVideoForWindows;

  FFilters:=TFilterItems.Create(Self,TTeeFilter);

  ITimer:=TTimer.Create(nil);
  ITimer.Interval:=1;
  ITimer.Enabled:=False;
  ITimer.OnTimer:=TimerEvent;
end;

procedure TVideoPlayerTool.TimerEvent(Sender: TObject);
begin
  if not Assigned(IBitmap) then
     IBitmap:=TBitmap.Create;

  // Copy video frame to IBitmap
  GetFrame(ICount,IBitmap);

  if Assigned(FPicture) then
     FPicture.Assign(IBitmap)
  else
  begin
    ParentChart.BackImage.Assign(IBitmap);

    if (not ParentChart.BackImage.Inside) and ParentChart.Gradient.Visible then
       ParentChart.Gradient.Visible:=False;
  end;

  if Assigned(FOnFrame) then
     FOnFrame(Self);

  if ICount=IEndFrame then  // last frame?
  begin
    if Loop then
       ICount:=StartFrame  // start again
    else
       Stop
  end
  else
     Inc(ICount);  // continue to next frame
end;

procedure TVideoPlayerTool.Open;
var
  P : PBitmapInfoHeader;
  BitmapInfoHeader : TBitmapInfoHeader;
  StreamInfo       : TAviStreamInfoA;
begin
  AVIFileInit;
  AviCheck(AVIFileOpen(IFile, PChar(FFileName), OF_READ or OF_SHARE_DENY_WRITE, nil));
  AviCheck(AVIFileGetStream(IFile, IStream, streamtypeVIDEO, 0));
  AviCheck(AVIStreamInfo(IStream, StreamInfo, SizeOf(StreamInfo)));

  P:=@BitmapInfoHeader;

  ZeroMemory(P, SizeOf(BitmapInfoHeader));
  With BitmapInfoHeader do
  begin
    biSize:=SizeOf(TBitmapInfoHeader);
    biBitCount:=24;
    biClrImportant:=0;
    biClrUsed:=0;
    biCompression:=BI_RGB;
    biHeight:=streamInfo.rcFrame.Bottom - streamInfo.rcFrame.Top;
    biWidth:=streamInfo.rcFrame.Right - streamInfo.rcFrame.Left;
    biPlanes:=1;
    biXPelsPerMeter:=0;
    biYPelsPerMeter:=0;
    biSizeImage:=(((biWidth * (biBitCount div 8)) + (biBitCount div 8)) And $FFFC) * biHeight;
  end;

  try
    IGetFrame:=AVIStreamGetFrameOpen(IStream, P);
  except
    on Exception do
       IGetFrame:=nil;
  end;

  if not Assigned(IGetFrame) then
     Raise Exception.Create('Error GetFrameOpen AVI file stream');
end;

procedure TVideoPlayerTool.Finish;
begin
  if Assigned(IGetFrame) then
  begin
    AVIStreamGetFrameClose(IGetFrame);
    IGetFrame:=nil;
  end;

  if Assigned(IStream) then
  begin
    AVIStreamRelease(IStream);
    IStream:=nil;
  end;

  if Assigned(IFile) then
  begin
    AVIFileRelease(IFile);
    IFile:=nil;
  end;

  AVIFileExit;
end;

function TVideoPlayerTool.GetFrame(FrameNumber: Integer):TBitmap;
begin
  result:=TBitmap.Create;
  GetFrame(FrameNumber,result);
end;

procedure TVideoPlayerTool.GetFrame(FrameNumber: Integer; var b:TBitmap);
var Info: PBITMAPINFOHEADER;
begin
  Info:=AVIStreamGetFrame(IGetFrame, FrameNumber);

  if Assigned(Info) then
  with b do
  begin
    Height:=Info.biHeight;
    Width:=Info.biWidth;

    SetDIBits( {$IFDEF CLX}QPainter_handle{$ENDIF}(Canvas.Handle),
               {$IFDEF CLX}QPixmap_hbm{$ENDIF}(Handle),
               0,Height,
               Pointer(Integer(Info) + SizeOf(TBITMAPINFOHEADER)),
               PBITMAPINFO(Info)^, DIB_RGB_COLORS);

  end
  else
  begin
    ITimer.Enabled:=False;

    raise Exception.Create('Error GetFrame AVI file stream');
  end;

  Filters.ApplyTo(b);
end;

Destructor TVideoPlayerTool.Destroy;
begin
  FFilters.Free;
  IBitmap.Free;
  ITimer.Free;
  Finish;

  inherited;
end;

function TVideoPlayerTool.GetEnd:Integer;
begin
  result:=GetStart;

  if Assigned(IStream) then
     Inc(result,AVIStreamLength(IStream)-1);
end;

function TVideoPlayerTool.GetStart:Integer;
begin
  if Assigned(IStream) then
     result:=AVIStreamStart(IStream)
  else
     result:=-1;
end;

class function TVideoPlayerTool.Description: String;
begin
  result:=TeeMsg_VideoPlayerTool;
end;

procedure TVideoPlayerTool.Pause;
begin
  ITimer.Enabled:=False;
  IPaused:=True;
end;

procedure TVideoPlayerTool.Play;
begin
  if Paused then