diff options
Diffstat (limited to 'Source/fsDcAvi.pas')
| -rw-r--r-- | Source/fsDcAvi.pas | 3230 |
1 files changed, 1615 insertions, 1615 deletions
diff --git a/Source/fsDcAvi.pas b/Source/fsDcAvi.pas index 889ed82..ddb7028 100644 --- a/Source/fsDcAvi.pas +++ b/Source/fsDcAvi.pas @@ -1,1615 +1,1615 @@ -{*******************************************************} -{ } -{ 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. +{*******************************************************}
+{ }
+{ 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.
|