path: root/Source/fsDcAvi.pas

{*******************************************************}
{                                                       }
{  TDCAVIPlayer component                               }
{                                                       }
{  Copyright (c) 1997-1999 Dream Company                }
{  http://www.dream-com.com                             }
{  e-mail: contact@dream-com.com                        }
{                                                       }
{*******************************************************}
{Modified for Framestein, look for '_FS'}

unit fsdcAVI;

interface
{$I dc.inc}
uses
  Windows, Messages, Graphics, Classes, Controls, mmSystem
  {$IFNDEF D3},SysUtils{$ENDIF};

const
  WM_NEXTFRAME = WM_USER + 1;

  cBufSize = 2048;     {audio buffer size}
  CAheadBuffers = 8;

type
   TAudioPlay = class
   private
     fBufferSize    : integer;
     fAVI           : pointer;
     fSampleSize    : integer;
     fEnd           : integer;
     fPlaying       : boolean;
     fWaveOut       : HWAVEOUT;
     fBegin         : integer;
     fCurrent       : integer;

     function   OpenDevice(W : HWND; pAvi : pointer) : boolean;
     function   FillBuffer : boolean;
   public
     destructor Destroy; override;
     procedure  AudioPlayMessage(W : PWAVEHDR);
     procedure  Stop;
     function   Play(W : HWND; pAvi : Pointer; lStart, lEnd : longint) : boolean;
   end;


  TDCAVIPlayer = class(TCustomControl)
  private
    _dc           : THandle;
    fActive       : boolean;
    fAutoSize     : boolean;
    fCenter       : boolean;
    fFileName     : string;
    fOpen         : boolean;
    fRepetitions  : integer;
    fStartFrame   : integer;
    fStopFrame    : integer;
    fTransparent  : boolean;
    fSkipFrames   : boolean;
    fStretch      : boolean;
    fLength       : integer;
    fFrameWidth   : integer;
    fFrameHeight  : integer;
    fPlaySound    : boolean;

    fOnClose      : TNotifyEvent;
    fOnOpen       : TNotifyEvent;
    fOnStart      : TNotifyEvent;
    fOnStop       : TNotifyEvent;

    favifile      : pointer;
    faudiostream  : pointer;
    fvideostream  : pointer;
    fFrame        : integer;
    fTimer        : THandle;
    fgetframe     : pointer;
    fdrawing      : boolean;
    fdrawcontrol  : integer;
    ftempdc       : THandle;
    ftempbitmap   : THandle;
    foldbitmap    : THandle;
    frepeatcount  : integer;
    fdelay        : integer;
    fbackchanged  : boolean;
    fBlockChanges : boolean;
    faudioplay    : TAudioPlay;
    hdrawdib      : THandle;

    fxstart       : integer;
    fystart       : integer;
    fofs          : integer;
    fxofs         : integer;
    fyofs         : integer;
    fiwidth       : integer;
    fiheight      : integer;

    procedure PlayNextFrame(var Msg : TMessage); message WM_NEXTFRAME;
    procedure SaveBackground;
    procedure AdjustControlsize;
    procedure ShowRect;
    procedure KillTempDC;
    procedure HookWndProc;
    procedure UnHookWndProc;
    procedure MMWOM_DONE(var M:TMessage); message MM_WOM_DONE;
    procedure PlayAudio(startframe, endframe : integer);
    procedure CalcFrameLayout;
    procedure DisplayChange(var Msg : TMessage); message WM_DISPLAYCHANGE;
    procedure ValidateFrameNumber(var val : integer);
    procedure UpdateFrameNumber;
    function  ZOrder : integer;
    procedure StartDrawing;
    function GetFrameRate: integer;
  protected
    procedure UpdateOtherAVIPlayers;
    function  PaintDisabled : boolean;
    procedure CreateParams (var Params: TCreateParams); override;
    procedure ShowFrame;
    procedure WMPaint(var Msg : TWMPaint); message WM_PAINT;
    procedure WMEraseBkgnd(var Msg : TMessage); message WM_ERASEBKGND;
    procedure WMMove (var Msg : TMessage); message WM_MOVE;
    procedure WMSize (var Msg : TMessage); message WM_SIZE;

    procedure Loaded; override;
    procedure SetActive (val : boolean);   virtual;
    procedure SetAutoSize (val : boolean); virtual;
    procedure SetCenter (val : boolean);   virtual;
    procedure SetFileName (val : string);  virtual;
    procedure SetRepetitions (val : integer); virtual;
    procedure SetStartFrame (val : integer);  virtual;
    procedure SetStopFrame (val : integer);   virtual;
    procedure SetTransparent (val : boolean); virtual;
    procedure SetStretch (val : boolean); virtual;
    procedure SetPlaySound(val : boolean); virtual;

    procedure OpenFile; virtual;
    procedure CloseFile; virtual;

    procedure DoOpen; virtual;
    procedure DoClose; virtual;
    procedure DoStart; virtual;
    procedure DoStop; virtual;
  public
    procedure DrawFrameToDC(dc : THandle); {_FS - This was private}
    constructor Create (AOwner : TComponent); override;
    destructor  Destroy; override;
    procedure   Play (FromFrame, ToFrame: Word; Count: Integer);
    procedure   Reset;
    procedure   Seek (Frame : integer);
    procedure   Stop;

    {_FS - add: property FrameRate}
    property    FrameRate  : integer read GetFrameRate;
    property    FrameCount : integer read fLength;
    property    FrameHeight: Integer read FFrameHeight;
    property    FrameWidth : Integer read FFrameWidth;

    property    Open : boolean read fOpen;

  published
    property Active      : boolean read fActive write SetActive default false;
    property AutoSize    : boolean read fAutoSize write SetAutoSize default true;
    property Center      : boolean read fCenter write SetCenter default true;
    property FileName    : string  read fFileName write SetFileName;
    property PlaySound   : boolean read fPlaySound write SetPlaySound default true;
    property Repetitions : integer read fRepetitions write SetRepetitions default 0;
    property StartFrame  : integer read fStartFrame write SetStartFrame default 1;
    property StopFrame   : integer read fStopFrame write SetStopFrame default 0;
    property Stretch     : boolean read fStretch write SetStretch default false;
    property Transparent : boolean read fTransparent write SetTransparent default true;

    property Position : integer read fFrame write Seek;
    
    property OnOpen: TNotifyEvent read fOnOpen write fOnOpen;
    property OnClose: TNotifyEvent read fOnClose write fOnClose;
    property OnStart: TNotifyEvent read fOnStart write fOnStart;
    property OnStop: TNotifyEvent read fOnStop write fOnStop;

    property Align;
    property Color;
    property ParentColor;
    property ParentShowHint;
    property ShowHint;
    property Visible;

    property OnMouseDown;
    property OnClick;
  end;

type
  TAVIStream = record
    fccType    : longint;
    fccHandler : longint;
    dwFlags    : longint;
    dwCaps     : longint;
    wPriority  : word;
    wLanguage  : word;
    dwScale    : longint;
    dwRate     : longint;
    dwStart    : longint;
    dwLength   : longint;
    dwInitialFrames : longint;
    dwSuggestedBufferSize : longint;
    dwQuality    : longint;
    dwSampleSize : longint;
    rcFrame      : TRect;
    dwEditCount  : longint;
    dwFormatChangeCount : longint;
    Name : array [0..64] of char;
  end;

  PAVIStream = ^TAVIStream;

  PAVIFile = pointer;

  TAVIFileInfo = record
    dwMaxBytesPerSec : longint; // max. transfer rate
    dwFlags          : longint; // the ever-present flags
    dwCaps           : longint;
    dwStreams        : longint;
    dwSuggestedBufferSize : longint;

    dwWidth          : longint;
    dwHeight         : longint;

    dwScale          : longint;
    dwRate           : longint; // dwRate / dwScale == samples/second
    dwLength         : longint;

    dwEditCount      : longint;

    szFileType       : array[0..63] of char; // descriptive string for file type?
  end;

  PAVIFileInfo = ^TAVIFileInfo;

  TAVIStreamInfo = record
    fccType               : longint;
    fccHandler            : longint;
    dwFlags               : longint; // Contains AVITF_* flags
    dwCaps                : longint;
    wPriority             : word;
    wLanguage             : word;
    dwScale               : longint;
    dwRate                : longint; // dwRate / dwScale == samples/second
    dwStart               : longint;
    dwLength              : longint; // In units above...
    dwInitialFrames       : longint;
    dwSuggestedBufferSize : longint;
    dwQuality             : longint;
    dwSampleSize          : longint;
    rcFrame               : TRect;
    dwEditCount           : longint;
    dwFormatChangeCount   : longint;
    szName  : array[0..63] of char;
  end;

  PAVIStreamInfo = ^TAVIStreamInfo;


//BeginSkipConst
procedure AVIFileInit; stdcall; external 'avifil32.dll' name 'AVIFileInit';

procedure AVIFileExit; stdcall; external 'avifil32.dll' name 'AVIFileExit';

function  AVIFileOpen(avifile : pointer; filename : pchar; mode : integer;
                   CLSID : pointer) : integer; stdcall; external 'avifil32.dll' name 'AVIFileOpen';

function  AVIFileRelease(avifile : pointer) : longint; stdcall; external 'avifil32.dll' name 'AVIFileRelease';

function  AVIFileGetStream(avifile : pointer; avistream : PAVIStream;
                           streamtype : longint; lParam : longint) : integer; stdcall; external 'avifil32.dll' name 'AVIFileGetStream';

function  AVIStreamGetFrameOpen(avistream : PAVIStream; bitmapwanted : pointer) : pointer; stdcall; external 'avifil32.dll' name 'AVIStreamGetFrameOpen';

procedure AVIStreamGetFrameClose(pget : pointer); stdcall; external 'avifil32.dll' name 'AVIStreamGetFrameClose';

function  AVIStreamGetFrame(getframe : pointer; position : longint) : pointer; stdcall; external 'avifil32.dll' name 'AVIStreamGetFrame';

function  AVIStreamOpenFromFile(avistream : PAVIStream; filename : pchar;
                                streamtype : word; lParam : longint;
                                mode : longint; clsid : pointer) : integer; stdcall; external 'avifil32.dll' name 'AVIStreamOpenFromFile';

procedure AVIStreamRelease(avistream : PAVIStream); stdcall; external 'avifil32.dll' name 'AVIStreamRelease';
function  AVIFileInfo(pfile : PAVIFile; pfi : PAVIFileInfo; lSize : longint) : integer; stdcall; external 'avifil32.dll' name 'AVIFileInfo';

function  AVIStreamInfo(pstream : PAVIStream; psi : PAVISTREAMINFO; lsize : longint) : integer; stdcall; external 'avifil32.dll' name 'AVIStreamInfo';
function  AVIStreamRead(pavi : PAVIStream; lStart, lSamples : longint;
                        lpBuffer : pointer; cbBuffer : longint;
                        plBytes,  plSamples : pointer) : integer; stdcall; external 'avifil32.dll' name 'AVIStreamRead';

function  AVIStreamReadFormat(pavi : PAVIStream; lPos : longint;
                              lpFormat : pointer; lpcbFormat : pointer) : integer; stdcall; external 'avifil32.dll' name 'AVIStreamReadFormat';

function  AVIStreamBeginStreaming(pavi : PAVIStream; lStart, lEnd, lRate : longint) : integer; stdcall; external 'avifil32.dll' name 'AVIStreamBeginStreaming';
function  AVIStreamEndStreaming(pavi : PAVIStream) : integer; stdcall; external 'avifil32.dll' name 'AVIStreamEndStreaming';
function  AVIStreamStart(pavi : PAVIStream) : longint; stdcall; external 'avifil32.dll' name 'AVIStreamStart';
function  AVIStreamLength(pavi: PAVIStream) : longint; stdcall; external 'avifil32.dll' name 'AVIStreamLength';
function  AVIStreamSampleToTime(pavi : PAVIStream; lSample : longint) : longint; stdcall; external 'avifil32.dll' name 'AVIStreamSampleToTime';
function  AVIStreamTimeToSample(pavi : PAVIStream; Time : longint) : longint; stdcall; external 'avifil32.dll' name 'AVIStreamTimeToSample';

function  DrawDIBOpen : THandle; stdcall; external 'msvfw32.dll' name 'DrawDibOpen';
procedure DrawDIBClose (h : THandle); stdcall; external 'msvfw32.dll' name 'DrawDibClose';
procedure DrawDibDraw (hdib, dc : THandle; xDst, yDst, dxDst, dyDst : integer;
                       lpbi, lpBits : pointer; xSrc, ySrc, dxSrc, dySrc, wFlags : integer); stdcall; external 'msvfw32.dll' name 'DrawDibDraw';
//EndSkipConst

const
  streamtypeAUDIO : longint = $73647561;
  streamtypeVIDEO : longint = $73646976;

  AVISTREAMREAD_CONVENIENT  = -1;

  DDF_HALFTONE = $1000;

{-----------------------------------------------------------------------}

implementation

function Min(A, B: Integer): Integer;
begin
  if A < B then
    Result := A
  else
    Result := B;
end;

function Max(A, B: Integer): Integer;
begin
  if A > B then
    Result := A
  else
    Result := B;
end;

function RectWidth(const R: TRect): Integer;
begin
  with R do
    Result := Right - Left;
end;

function RectHeight(const R: TRect): Integer;
begin
  with R do
    Result := Bottom - Top;
end;

{$IFNDEF D3}
function TransparentStretchBlt(DstDC: HDC; DstX, DstY, DstW, DstH: Integer;
  SrcDC: HDC; SrcX, SrcY, SrcW, SrcH: Integer; MaskDC: HDC; MaskX,
  MaskY: Integer): Boolean;
const
  ROP_DstCopy = $00AA0029;
var
  MemDC  : THandle;
  MemBmp : THandle;
  Save   : THandle;
  crText : TColorRef;
  crBack : TColorRef;
begin
  Result := True;
  if (Win32Platform = VER_PLATFORM_WIN32_NT) and (SrcW = DstW) and (SrcH = DstH) then
    begin
      MemBmp := CreateCompatibleBitmap(SrcDC, 1, 1);
      MemBmp := SelectObject(MaskDC, MemBmp);
      MaskBlt(DstDC, DstX, DstY, DstW, DstH, SrcDC, SrcX, SrcY, MemBmp, MaskX,
              MaskY, MakeRop4(ROP_DstCopy, SrcCopy));
      MemBmp := SelectObject(MaskDC, MemBmp);
      DeleteObject(MemBmp);
      exit;
    end;

  MemDC := CreateCompatibleDC(0);
  MemBmp := CreateCompatibleBitmap(SrcDC, SrcW, SrcH);
  Save := SelectObject(MemDC, MemBmp);
  StretchBlt(MemDC, 0, 0, SrcW, SrcH, MaskDC, MaskX, MaskY, SrcW, SrcH, SrcCopy);
  StretchBlt(MemDC, 0, 0, SrcW, SrcH, SrcDC, SrcX, SrcY, SrcW, SrcH, SrcErase);
  crText := SetTextColor(DstDC, $0);
  crBack := SetBkColor(DstDC, $FFFFFF);
  StretchBlt(DstDC, DstX, DstY, DstW, DstH, MaskDC, MaskX, MaskY, SrcW, SrcH, SrcAnd);
  StretchBlt(DstDC, DstX, DstY, DstW, DstH, MemDC, 0, 0, SrcW, SrcH, SrcInvert);
  SetTextColor(DstDC, crText);
  SetTextColor(DstDC, crBack);
  SelectObject(MemDC, Save);
  DeleteObject(MemBmp);
  DeleteDC(MemDC);
end;
{$ENDIF}

Procedure TransparentBitBltEx(sourcedc, destdc: THandle; SrcRect,DstRect: TRect;
  atranscolor: longint);
Var
  monobitmap: THandle;
  oldbkcolor: longint;
  monodc: THandle;
  width: integer;
  height: integer;
  oldbitmap: THandle;
Begin
  With SrcRect do
  Begin
    width := RectWidth(SrcRect);
    height := RectHeight(SrcRect);
    monodc := CreateCompatibleDC(sourcedc);
    monobitmap := CreateCompatibleBitmap(monodc, width, height);
    oldbitmap := SelectObject(monodc, monobitmap);
    Try
      oldbkcolor := SetBkColor(sourcedc, atranscolor);
      BitBlt(monodc, 0, 0, width, height, sourcedc, Left, Top, SRCCOPY);
      SetBkColor(sourcedc, oldbkcolor);
      TransparentStretchBlt(destdc, DstRect.Left, DstRect.Top, RectWidth(DstRect),
        RectHeight(DstRect), SourceDC, left, top, width, height, monodc, 0, 0);
    Finally
      SelectObject(monodc, oldbitmap);
      DeleteDC(monodc);
      DeleteObject(monobitmap);
    End;
  End;
End;

Procedure TransparentBitBlt(sourcedc, destdc: THandle; arect: TRect;
  atranscolor: longint; aoriginX,aoriginY: Integer);
begin
  TransparentBitBltEx(sourcedc, destdc,arect,
    Rect(aoriginX,aoriginY,aoriginX+RectWidth(arect),aoriginY+RectHeight(arect)),
    atranscolor);
end;

Function GetTransparentColor(dc: THandle; const arect: TRect): longint;
Begin
  Result := GetPixel(dc, arect.left, arect.bottom);
End;

{-----------------------------------------------------------------------}

function  AVIStreamEnd  (pavi : PAVIStream) : longint;
begin
  result := AVIStreamStart(pavi) + AVIStreamLength(pavi);
end;

{-----------------------------------------------------------------------}

function  AVIStreamFormatSize (pavi : PAVIStream; lPos : longint; plSize : pointer) : longint;
begin
  result := AVIStreamReadFormat(pavi, lPos, nil, plSize);
end;

{-----------------------------------------------------------------------}

constructor TDCAVIPlayer.Create (AOwner : TComponent);
begin
  inherited Create(AOwner);
  width := 100;
  height := 50;

  fAutoSize := true;
  fCenter := true;
  fStartFrame := 1;
  fTransparent := true;
  fSkipFrames := true;
  fAutoSize := true;
  fBackChanged := true;
  fblockchanges := true;
  fPlaySound := true;

  AVIFileInit;
  faudioplay := TAudioPlay.Create;
  HookWndProc;
  hdrawdib := DrawDIBOpen;
end;

{------------------------------------------------------------------}

destructor TDCAVIPlayer.Destroy;
begin
  Stop;
  UnHookWndProc;
  DrawDIBClose(hdrawdib);
  KillTempDC;
  CloseFile;
  faudioplay.Free;
  AVIFileExit;
  inherited Destroy;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;

{------------------------------------------------------------------}

function  TDCAVIPlayer.ZOrder : integer;
begin
  if Parent <> nil then
    with Parent do
      for result := 0 to ControlCount - 1 do
        if Controls[result] = self then
          exit;

  result := -1
end;

{------------------------------------------------------------------}

procedure Timer(uID, uMsg, dwUser, dw1, dw2 : longint); stdcall;
begin
  PostMessage(TDCAVIPlayer(dwUser).Handle, WM_NEXTFRAME, 0, 0);
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.PlayAudio(startframe, endframe : integer);
var
  astart : integer;
  aend   : integer;
begin
  if (faudiostream = nil) or not fPlaySound then
    exit;

  astart := AVIStreamTimeToSample(faudiostream, AVIStreamSampleToTime(fvideostream, startFrame));
  aend   := AVIStreamTimeToSample(faudiostream, AVIStreamSampleToTime(fvideostream, endFrame));
  faudioplay.play(handle, faudiostream, astart, aend);
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.Play (FromFrame, ToFrame: Word; Count: Integer);
var
  info   : TAVIStreamInfo;
  ainfo  : TAVIStreamInfo;
begin
  Stop;
  if not Assigned(fvideostream) then
    exit;

  fFrame := FromFrame;
  fStartFrame := FromFrame;
  fStopFrame := ToFrame;
  frepeatCount := Count;
  AVIStreamInfo(fvideostream, @info, sizeof(info));
  fdelay := MulDiv(info.dwScale, 1000, info.dwRate);

  DoStart;
  fActive := true;
  if Assigned(faudiostream) then
    begin
      AVIStreamInfo(fvideostream, @ainfo, sizeof(info));
      PlayAudio(fFrame, fStopFrame);
    end;

  fTimer := timeSetEvent(fdelay, 0, @Timer, integer(self), TIME_PERIODIC);
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.Stop;
begin
  if ftimer <> 0 then
    begin
      timeKillEvent(fTimer);
      fTimer := 0;
    end;

  if not fActive then
    exit;

  faudioplay.stop;
  fActive := false;
  DoStop;
  ShowFrame;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.Seek (Frame : integer);
begin
  if Frame = fFrame then
    exit;

  Stop;
  ValidateFrameNumber(Frame);
  fFrame := Frame;
  Invalidate;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.Loaded;
var
  _startframe : integer;
  _stopframe  : integer;
begin
  inherited Loaded;

  if ffilename <> '' then
    begin
      fBlockChanges := false;
      _startframe := fstartframe;
      _stopframe := fStopFrame;
      OpenFile;
      fstartframe := _startframe;
      fStopFrame := _stopframe;
      fBlockChanges := true;
    end;


  if fActive then
    if fOpen then
      Play(fStartFrame, fStopFrame, fRepetitions)
    else
      fActive := false;

end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.SetActive(val : boolean);
begin
  if val = fActive then
    exit;

  if not (csReading in ComponentState) then
    if val then
      begin
        Play(fStartFrame, fStopFrame, fRepetitions)
      end
    else
      begin
        Stop;
        if csDesigning in ComponentState then
          begin
            fFrame := 0;
            ShowFrame;
          end;
      end;

end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.SetAutoSize(val : boolean);
begin
  if val = fAutoSize then
    exit;

  fAutoSize := val;
  AdjustControlsize;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.SetCenter(val : boolean);
begin
  if val = fCenter then
    exit;

  fCenter := val;
  if not fTransparent then
    Invalidate;

  ShowFrame;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.SetFileName(val : string);
var
  wasactive : boolean;
begin
  if val = fFileName then
    exit;

  ffilename := val;
  if csReading in ComponentState then
    exit;

  wasactive := fActive;

  Reset;

  Invalidate;
  ShowFrame;

  if val = '' then
    begin
      fbackchanged := true;
      Parent.Invalidate;
      UpdateWindow(Parent.Handle);
    end;

  if wasActive then
    if not (csReading in ComponentState) then
      Active := true
    else
      fActive := true;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.SetRepetitions(val : integer);
begin
  if val = fRepetitions then
    exit;

  fRepetitions := val;
  if csDesigning in ComponentState then
    begin
      Stop;
      fFrame := 0;
      ShowFrame;
    end;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.ValidateFrameNumber(var val : integer);
begin
  if fOpen then
    if val > fLength - 1 then
      val := fLength - 1
    else
      if val < 0 then
        val := 0;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.SetStartFrame(val : integer);
begin
  if (val = fStartFrame) then
    exit;

  ValidateFrameNumber(val);
  fStartFrame := val;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.SetStopFrame(val : integer);
begin
  if val = fStopFrame then
    exit;

  ValidateFrameNumber(val);
  fStopFrame := val;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.SetTransparent(val : boolean);
begin
  if val = fTransparent then
    exit;

  fTransparent := val;
  Invalidate;
  ShowFrame;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.SetStretch (val : boolean);
begin
  if val = fStretch then
    exit;

  fStretch := val;
  if not (csReading in ComponentState) then
    begin
      if not val then
        invalidate;

      if not fActive then
        ShowFrame;
    end;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.SetPlaySound (val : boolean);
begin
  if val = fPlaySound then
    exit;

  fPlaySound := val;
  if fActive then
    if val then
      PlayAudio(fFrame, fStopFrame)
    else
      faudioplay.Stop;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.AdjustControlsize;
var
  info  : TAVIStreamInfo;
  r     : TRect;
  r2    : TRect;
  i     : integer;
  crect : TRect;
begin
  if fautosize and fOpen then
    begin
      AVIStreamInfo(fvideostream, @info, sizeof(info));
      if fblockchanges then
        Parent.Perform(WM_SETREDRAW, 0, 0);
      r := Rect(left, top, left + width, top + height);
      with info.rcframe do
        SetBounds(self.left, self.top, right - left, bottom - top);
      if fblockchanges then
        begin
          Parent.Perform(WM_SETREDRAW, 1, 0);
          r2 := Rect(left, top, left + width, top + height);
          SubtractRect(r, r, r2);
          InvalidateRect(Parent.Handle, @r, true);
          with Parent do
            for i := 0 to ControlCount - 1 do
              begin
                with Controls[i] do
                  crect := Rect(left, top, left + width, top + height);

                if (Controls[i] is TWinControl) and (Controls[i] <> self) and
                InterSectRect(r2, r, crect) then
                  Controls[i].Invalidate;
              end;
        end;
    end;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.OpenFile;
var
  info : TAVIStreamInfo;
begin
  if ffilename = '' then
    exit;

  if (AVIFileOpen(@favifile, @(ffilename[1]), 0, nil) <> 0) then
    exit;

  if (AVIFileGetStream(favifile, @fvideostream, streamtypeVIDEO, 0) <> 0) then
    begin
      AVIFileRelease(favifile);
      exit;
    end;

  fgetframe := AVIStreamGetFrameOpen(fvideostream, nil);

  if fgetframe = nil then
    begin
      AVIStreamRelease(fvideostream);
      AVIFileRelease(favifile);
      exit;
    end;

  AVIFileGetStream(favifile, @faudiostream, streamtypeAUDIO, 0);

  AVIStreamInfo(fvideostream, @info, sizeof(info));
  with info do
    begin
      fLength := dwlength;
      fFrameWidth := rcframe.right - rcframe.left;
      fFrameHeight := rcframe.bottom - rcframe.top;
      fStartFrame := dwStart;
      fStopFrame := fLength - 1;
    end;
  fFrame := fStartFrame;
  fOpen := true;
  SetWindowLong(handle, GWL_EXSTYLE, GetWindowLong(handle, GWL_EXSTYLE) and (not WS_EX_TRANSPARENT));
  AdjustControlsize;
  fbackchanged := true;
  Invalidate;
{  ShowFrame;
  Parent.Invalidate;}
  DoOpen;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.CloseFile;
begin
  if not fOpen then
    exit;

  if fActive then
    Stop;

  if Assigned(fgetframe) then
    AVIStreamGetFrameClose(fgetframe);

  if Assigned(faudiostream) then
    AVIStreamRelease(faudiostream);

  if Assigned(fvideostream) then
    AVIStreamRelease(fvideostream);

  if Assigned(favifile) then
    AVIFileRelease(favifile);

  faudiostream := nil;
  fvideostream := nil;
  favifile := nil;
  fgetframe := nil;
  fOpen := false;
  fLength := 0;
  DoClose;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.CalcFrameLayout;
begin
  fxstart := 0;
  fystart := 0;
  if csDesigning in ComponentState then
    fofs := 1
  else
    fofs := 0;

  if fOpen then
    begin
      fiwidth  := FrameWidth;
      fiheight := FrameHeight;
    end
  else
    begin
      fiwidth  := self.width;
      fiheight := self.height;
    end;

  if not Stretch and fCenter then
    begin
      fxstart := (self.width - fiwidth) div 2;
      fystart := (self.height - fiheight) div 2;
    end;

  if not Transparent then
    begin
      if fxstart > 0  then
        fxofs := 0
      else
        fxofs := fofs;

      if fystart > 0  then
        fyofs := 0
      else
        fyofs := fofs;
    end;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.StartDrawing;
begin
  fdrawing := true;
  fdrawcontrol := ZOrder;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.DrawFrameToDC(dc : THandle);
var
  memdc        : THandle;
  formdc       : THandle;
  image        : pointer;
  imagestart   : integer;
  bitmap       : THandle;
  fbitmap      : THandle;
  oldmemobject : THandle;
  oldfobject   : THandle;
  width        : integer;
  height       : integer;

begin
{_FS - We're not using your window anyway...}
//  if PaintDisabled then
//    exit;

  if fTransparent and (fBackChanged or not fActive) then
    begin
      SaveBackGround;
      fBackChanged := false;
    end;

  StartDrawing;
  memdc := CreateCompatibleDC(dc);
  formdc := CreateCompatibleDC(dc);
  try
    image := AVIStreamGetFrame(fgetframe, fFrame);
    CalcFrameLayout;

    if fStretch then
      begin
        width   := self.width;
        height  := self.height;
      end
    else
      begin
        width  := fiwidth;
        height := fiheight;
      end;

    imagestart := 0;

    if Assigned(image) then
      begin
        SetStretchBltMode(memdc, HALFTONE);
        imagestart := TBitmapInfoHeader(image^).biSize + TBitmapInfoHeader(image^).biClrUsed * 4;
      end;

    if fTransparent then
      begin
        bitmap := CreateCompatibleBitmap(dc, width, height);
        oldmemobject := SelectObject(memdc, bitmap);

        StretchDIBits(memdc, 0, 0, width, height, 0, 0, fiwidth, fiheight, pchar(image) + imagestart,
                  TBitmapInfo(image^), 0, SRCCOPY);

        fbitmap := CreateCompatibleBitmap(dc, self.width, self.height);
        oldfobject := SelectObject(formdc, fbitmap);

        BitBlt(formdc, 0, 0, self.width, self.height, ftempdc, 0, 0, SRCCOPY);

        if Assigned(image) then
          TransparentBitBlt(memdc, formdc, Rect(0, 0, width, height),
                            GetTransparentColor(memdc, Rect(0, 0, width - 1, height - 1)),
                            fxstart, fystart);

        BitBlt(dc, fofs, fofs, self.width - fofs * 2, self.height - fofs * 2, formdc, fofs, fofs, SRCCOPY);

        SelectObject(formdc, oldfobject);
        DeleteObject(fbitmap);
        SelectObject(memdc, oldmemobject);
        DeleteObject(bitmap);
      end
    else
      DrawDibDraw(hdrawdib, dc, fxstart, fystart, width - fxofs * 2, height - fyofs * 2,
                  image, pchar(image) + imagestart, 0, 0, fiwidth, fiheight, DDF_HALFTONE);

  finally
    DeleteDC(memdc);
    DeleteDC(formdc);
    fdrawing := false;
  end;
end;

{------------------------------------------------------------------}

function TDCAVIPlayer.PaintDisabled : boolean;
begin
  result := fDrawing or ([csReading, csLoading] * ComponentState <> []) or (Parent = nil)
    or ([csReading, csLoading] * Parent.ComponentState <> [])
   or not HandleAllocated or not ({_FS-visible or }(csDesigning in ComponentState));
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.ShowFrame;
var
  dc    : THandle;
  brush : THandle;
begin
  if PaintDisabled then
     exit;

  if _dc = 0 then
    dc := GetDC(handle)
  else
    dc := _dc;

  if not (fTransparent or fOpen) then
    begin
      brush := CreateSolidBrush(ColorToRGB(Color));
      FillRect(dc, ClientRect, brush);
      DeleteObject(brush);
    end
  else
    DrawFrameToDC(dc);

  if _dc = 0 then
    ReleaseDC(handle, dc);

  ShowRect;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.UpdateFrameNumber;
begin
  if (fFrame >= fStopFrame) then
    begin
      if frepeatcount > 0 then
        begin
          dec(fRepeatCount);
          if fRepeatCount = 0 then
            begin
              Stop;
              exit;
            end;
        end;

      fFrame := fStartFrame - 1;
      PlayAudio(fStartFrame, fStopFrame);
    end;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.UpdateOtherAVIPlayers;
var
  r : TRect;
  i : integer;
begin
  with Parent do
    for i := ControlCount - 1 downto 0 do
      begin
        if (Controls[i] = self) then
          break;

        if (Controls[i].Visible) and (Controls[i] is TDCAVIPlayer) then
          with TDCAVIPlayer(Controls[i]) do
            if [csDestroying, csLoading] * ComponentState = [] then
              begin
                fbackchanged := true;
                r := ClientRect;
                InvalidateRect(Handle, @r, true);
              end;
      end;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.PlayNextFrame(var Msg : TMessage);
begin
  UpdateFrameNumber;
  inc(fFrame);
  if fActive and not fDrawing then
    begin
      ShowFrame;
      UpdateOtherAVIPlayers;
    end;  
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.SaveBackground;
var
  dc         : THandle;
  formdc     : THandle;
  oldfbitmap : THandle;
  fbitmap    : THandle;
  fdc        : THandle;
begin
  if Parent = nil then
    exit;

  StartDrawing;
  dc := GetDC(handle);
  fdc := GetDC(parent.handle);
  formdc := CreateCompatibleDC(fdc);
  fbitmap := CreateCompatibleBitmap(fdc, parent.width, parent.height);
  oldfbitmap := SelectObject(formdc, fbitmap);

  if ftempdc = 0 then
    begin
      ftempdc := CreateCompatibleDC(dc);
      ftempbitmap := CreateCompatibleBitmap(dc, width, height);
      foldbitmap := SelectObject(ftempdc, ftempbitmap);
    end;
  IntersectClipRect(formdc, left, top, left + width + 1, top + height + 1);


  with parent do
    PaintTo(formdc, 0, 0);

  SetViewPortOrgEx(formDC, 0, 0, nil);
  BitBlt(ftempdc, 0, 0, width, height, formdc, left + 1, top + 1, SRCCOPY);
  SelectObject(formdc, oldfbitmap);
  DeleteObject(fbitmap);
  DeleteDC(formdc);
  ReleaseDC(Parent.Handle, fdc);
  ReleaseDC(handle, dc);

  fdrawing := false;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.WMPaint(var Msg : TWMPaint);
var
  ps : TPaintStruct;
begin
  _dc := Msg.DC;
  if _dc = 0 then
    _dc := BeginPaint(handle, ps);

  try
    Msg.result := 0;

{  if name = 'DCAVIPlay3' then
    asm nop end;}

    ShowFrame;

  finally
    if Msg.DC = 0 then
      EndPaint(handle, ps);
    _dc := 0;  
  end;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.WMEraseBkgnd(var Msg : TMessage);
var
  brush        : THandle;
  r            : TRect;
  dc           : THandle;
  width        : integer;
  height       : integer;
begin
  if PaintDisabled then
     exit;

   if not (fTransparent or fStretch) then
     begin
       CalcFrameLayout;
       if fStretch then
         begin
           width   := self.width;
           height  := self.height;
         end
       else
         begin
           width  := fiwidth;
           height := fiheight;
         end;

       dc := GetDC(handle);
       brush := CreateSolidBrush(ColorToRGB(Color));
       r := rect(fofs, fofs, self.width, fystart);
       FillRect(dc, r, brush);

       r := rect(fofs, fystart, fxstart, self.height);
       FillRect(dc, r, brush);

       r := rect(fxstart, fystart + height, self.width - fofs * 2, self.height - fofs * 2);
       FillRect(dc, r, brush);

       r := rect(fxstart + width, fystart, self.width - fofs * 2, fystart + height);
       FillRect(dc, r, brush);

       DeleteObject(brush);
       ReleaseDC(handle, dc);
   end;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.WMMove (var Msg : TMessage);
begin
  inherited;
  fbackchanged := true;
  ShowFrame;
  UpdateOtherAVIPlayers;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.KillTempDC;
begin
  if ftempdc <> 0 then
    begin
      SelectObject(ftempdc, foldbitmap);
      DeleteObject(ftempbitmap);
      DeleteDC(ftempdc);
      ftempdc := 0;
    end;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.WMSize (var Msg : TMessage);
begin
  StartDrawing;
  KillTempDC;
  inherited;
  fBackChanged := true;
  fdrawing := false;
  AdjustControlsize;
  if not Active then
    ShowFrame;
  UpdateOtherAVIPlayers;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.ShowRect;
var
  DC        : THandle;
  Pen       : THandle;
  SavePen   : THandle;
  SaveBrush : THandle;
begin
  if not (csDesigning in ComponentState) then
    exit;

  dc := GetDC(Handle);
  Pen := CreatePen(PS_DOT, 1, clBlack);
  SavePen := SelectObject(dc, Pen);
  SaveBrush := SelectObject(dc, GetStockobject(HOLLOW_BRUSH));
  Rectangle(dc, 0, 0, width, height);
  SelectObject(DC, SavePen);
  DeleteObject(Pen);
  SelectObject(DC, SaveBrush);
  ReleaseDC(Handle, DC);
end;

{------------------------------------------------------------------}

var
  WHook : HHook;
  hooks : TList;

type TCWPStruct = packed record
    lParam  : LPARAM;
    wParam  : WPARAM;
    message : integer;
    wnd     : HWND;
end;

function CallWndProcHook(nCode : integer; wParam : Longint; var Msg : TCWPStruct) : longint; stdcall;
var
  i  : integer;
  r  : TRect;
  r2 : TRect;

  function IsPaintMsg : boolean;
  var
    c  : TWinControl;
  begin
    result := false;
    c := FindControl(msg.wnd);
    if (c <> nil) and not (c is TDCAVIPlayer) and
       TDCAVIPlayer(hooks[i]).HandleAllocated and
       (TDCAVIPlayer(hooks[i]).owner = c.owner) or
       (TDCAVIPlayer(hooks[i]).owner = c) then
          begin
            GetWindowRect(msg.wnd , r);
            GetWindowRect(TDCAVIPlayer(hooks[i]).handle, r2);
            result := IntersectRect(r, r, r2);
          end;
  end;

begin
  Result := CallNextHookEx(WHook, nCode, wParam, Longint(@Msg));

  if ((msg.message > CN_BASE) and (msg.message < CN_BASE + 500)) or
      (msg.message = WM_PAINT) or (msg.message = WM_SIZE)
{ or     (msg.message = WM_ERASEBKGND)} then
    for i := 0 to hooks.Count - 1 do
      with TDCAVIPlayer(hooks[i]) do
        if HandleAllocated and Transparent and IsPaintMsg then
          begin
            fbackchanged := true;
            r := ClientRect;
            InvalidateRect(Handle, @r, true);
          end;
end;

{------------------------------------------------------------------}

procedure AddHook(o : TDCAVIPlayer);
begin
  if hooks.Count = 0 then
    WHook := SetWindowsHookEx(WH_CALLWNDPROC, @CallWndProcHook, 0, GetCurrentThreadId);
  hooks.Add(o);
end;

{------------------------------------------------------------------}

procedure RemoveHook(o : TDCAVIPlayer);
begin
  hooks.Remove(o);
  if hooks.Count = 0 then
    UnHookWindowsHookEx(WHook);
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.HookWndProc;
begin
  AddHook(self);
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.UnHookWndProc;
begin
  RemoveHook(self);
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.Reset;
begin
  CloseFile;
  OpenFile;
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.DoOpen;
begin
  if Assigned(fOnOpen) then
    fOnOpen(self);
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.DoClose;
begin
  if Assigned(fOnClose) then
    fOnClose(self);
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.DoStart;
begin
  if Assigned(fOnStart) then
    fOnStart(self);
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.MMWOM_DONE(var M:TMessage);
begin
   faudioplay.AudioPlayMessage(PWAVEHDR(M.lParam));
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.DoStop;
begin
  if Assigned(fOnStop) then
    fOnStop(Self);
end;

{------------------------------------------------------------------}

procedure TDCAVIPlayer.DisplayChange(var Msg : TMessage);
begin
  DrawDIBClose(hdrawdib);
  hdrawdib := DrawDIBOpen;
end;

{------------------------------------------------------}

destructor TAudioPlay.Destroy;
begin
  Stop;
  inherited;
end;

{--------------------------------------------------------------}

procedure TAudioPlay.AudioPlayMessage(W : PWAVEHDR);
begin
  waveOutUnprepareHeader(FWaveOut, W, sizeof(TWAVEHDR));
  FreeMem(W, FBufferSize + sizeof(TWAVEHDR));
  if FPlaying then
    FillBuffer;
end;

{--------------------------------------------------------------}

function TAudioPlay.FillBuffer : Boolean;
var
  AudioBuf      : PWAVEHDR;
  SamplesToPlay : integer;
  lRead         : integer;
begin
  Result := false;
  GetMem(AudioBuf, fBufferSize + sizeof(TWAVEHDR));
  with AudioBuf^ do
    begin
      dwuser  := integer(Self);
      dwFlags := WHDR_DONE;
      lpData  := pointer(integer(AudioBuf) + sizeof(TWAVEHDR));
      dwBufferLength := fBufferSize;
    end;
  if waveOutPrepareHeader(FWaveOut, AudioBuf,
                          sizeof(TWAVEHDR)) <> MMSYSERR_NOERROR then
    begin
      FreeMem(AudioBuf, fBufferSize + sizeof(TWAVEHDR));
      exit;
    end;

  SamplesToPlay := Min(fEnd - fCurrent, fBufferSize div fSampleSize);
  if SamplesToPlay > 0 then
    begin
      AVIStreamRead(fAvi, fCurrent, SamplesToPlay, AudioBuf.lpData,
                         fBufferSize, @AudioBuf.dwBufferLength, @lRead);
      if LRead = SamplesToPlay then
        begin
          inc(fCurrent, lRead);
          waveOutWrite(fWaveOut, AudioBuf, sizeof(TWAVEHDR));
        end;
    end;
  fPlaying := true;
  result := true;
end;

{--------------------------------------------------------------}

function  TAudioPlay.OpenDevice(W : HWND; pAvi : pointer) : boolean;
var
  strhdr   : TAVISTREAMINFO;
  lpFormat : pointer;
  cbFormat : longint;
begin
  result := false;
  fAVI := pAvi;
  AVIStreamInfo(pAvi, @StrHdr, sizeof(StrHdr));
  fSampleSize := StrHdr.dwSampleSize;
  if (fSampleSize <= 0) then
    exit;

  fBufferSize := Max(fSampleSize, cBufSize);
  AVIStreamFormatSize(pavi, 0, @cbFormat);
  GetMem(lpFormat, cbFormat);
  FillChar(lpFormat^, cbFormat, 0);
  AVIStreamReadFormat(pAvi, 0, lpFormat, @cbFormat);
  sndPlaySound(nil, 0);
  if waveOutOpen(@FWaveOut, WAVE_MAPPER, lpFormat,
                 W, 0, CALLBACK_WINDOW) = 0 then
   result := true;

  FreeMem(lpFormat, cbFormat);
end;

{--------------------------------------------------------------}

procedure TAudioPlay.Stop;
begin
  if fWaveOut <> 0 then
    begin
      FPlaying := false;
      waveOutReset(FWaveOut);
      waveOutClose(FWaveOut);
      fWaveOut := 0;
    end;
end;

{--------------------------------------------------------------}

function TAudioPlay.Play(W : HWND; pAvi : Pointer; lStart, lEnd : longint) : boolean;
var
  i : integer;
begin
  if fPlaying then
    Stop;

  Result := false;
  if lStart < 0 then
    lStart := AVIStreamStart(pavi);

  if lEnd < 0 then
    lEnd := AVIStreamEnd(pavi);

  if lStart >= lEnd then
    exit;

  if not OpenDevice(W, pAvi) then
    exit;

  waveOutPause(fWaveOut);
  fBegin := lStart;
  FCurrent := lStart;
  fEnd := lEnd;
  fPlaying := true;
  for i := 1 to CAheadBuffers do
    FillBuffer;

  waveOutRestart(FWaveOut);
  result := true;
end;

{---------------------------------------------------------------------}
{_FS: add}
function TDCAVIPlayer.GetFrameRate: integer;
var
  info: TAviStreamInfo;
begin
  Result:=0;
  if not Assigned(fvideostream) then Exit;
  AVIStreamInfo(fvideostream, @info, sizeof(info));
  Result := info.dwRate div info.dwScale;
end;
{_FS: end add}

initialization
  hooks := TList.Create;
finalization
  if hooks.Count > 0 then
    UnHookWindowsHookEx(WHook);
  hooks.Free;
end.