{*******************************************************} { } { 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.