From fe070b42d2ddea9ec14bb186b6cc0b6d11b490c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Juha=20Vehvil=C3=A4inen?= Date: Tue, 3 Jun 2003 20:46:51 +0000 Subject: *** empty log message *** svn path=/trunk/Framestein/; revision=675 --- Source/fsDcAvi.pas | 3230 ++++++++++++++++++++++++++-------------------------- 1 file changed, 1615 insertions(+), 1615 deletions(-) (limited to 'Source/fsDcAvi.pas') 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. -- cgit v1.2.1