Code: Select all
;Play Avi no audio
Structure AVI_RECT
left.l
top.l
right.l
bottom.l
EndStructure
Structure AVI_STREAM_INFO
fccType.l
fccHandler.l
dwFlags.l
dwCaps.l
wPriority.w
wLanguage.w
dwScale.l
dwRate.l
dwStart.l
dwLength.l
dwInitialFrames.l
dwSuggestedBufferSize.l
dwQuality.l
dwSampleSize.l
rcFrame.AVI_RECT
dwEditCount .l
dwFormatChangeCount.l
szName.s{64}
EndStructure
Global pavi.i
Global psi.AVI_STREAM_INFO
Global pgf.i
Global gSizeAVIData
Global *pAviData
Global gmpf.i
Global srcImg.i
Global glastframe.i
Global gbPlay.i
Global srcAviWidth.i,srcAviHeight.i
Global gSeek.i
Prototype AVIStreamOpenFromFileA(*avi,szFile.s,fccType.l,lParam.l,mode.l,*clsidHandler)
Prototype AVIStreamSampleToTime(*avi,lSample.l)
Prototype AVIFileInit()
Prototype AVIStreamGetFrameOpen(*AVIStream,bih.l)
Prototype AVIStreamGetFrame(*GetFrameObj,lPos.l)
Prototype AVIStreamGetFrameClose(*GetFrameObj)
Prototype AVIStreamInfoA(*AVIStream,*psi,lSize.l)
Prototype AVIStreamStart(*avi)
Prototype AVIStreamLength(*avi)
Prototype AVIStreamRelease(*avi)
Prototype AVIFileRelease(*file)
Prototype AVIFileExit()
Prototype AVIStreamReadFormat(*AVIStream,lPos,*lpFormat,*lpcbFormat)
Global AVIStreamOpenFromFileA.AVIStreamOpenFromFileA
Global AVIStreamSampleToTime.AVIStreamSampleToTime
Global AVIFileInit.AVIFileInit
Global AVIStreamGetFrameOpen.AVIStreamGetFrameOpen
Global AVIStreamGetFrame.AVIStreamGetFrame
Global AVIStreamGetFrameClose.AVIStreamGetFrameClose
Global AVIStreamInfoA.AVIStreamInfoA
Global AVIStreamStart.AVIStreamStart
Global AVIStreamLength.AVIStreamLength
Global AVIStreamRelease.AVIStreamRelease
Global AVIFileRelease.AVIFileRelease
Global AVIFileExit.AVIFileExit
Global AVIStreamReadFormat.AVIStreamReadFormat
Procedure.i avifil32_LoadDLL()
Protected hDLL.i
hDLL = OpenLibrary(#PB_Any, "avifil32.dll")
If hDLL <> 0
AVIStreamOpenFromFileA = GetFunction(hDLL, "AVIStreamOpenFromFileA")
AVIStreamSampleToTime = GetFunction(hDLL, "AVIStreamSampleToTime")
AVIFileInit= GetFunction(hDLL, "AVIFileInit")
AVIStreamGetFrameOpen = GetFunction(hDLL, "AVIStreamGetFrameOpen")
AVIStreamGetFrame = GetFunction(hDLL, "AVIStreamGetFrame")
AVIStreamGetFrameClose = GetFunction(hDLL, "AVIStreamGetFrameClose")
AVIStreamInfoA = GetFunction(hDLL, "AVIStreamInfoA")
AVIStreamStart = GetFunction(hDLL, "AVIStreamStart")
AVIStreamLength = GetFunction(hDLL, "AVIStreamLength")
AVIStreamRelease = GetFunction(hDLL, "AVIStreamRelease")
AVIFileRelease = GetFunction(hDLL, "AVIFileRelease")
AVIFileExit = GetFunction(hDLL, "AVIFileExit")
AVIStreamReadFormat = GetFunction(hDLL, "AVIStreamReadFormat")
ProcedureReturn hDLL
EndIf
ProcedureReturn #False
EndProcedure
#StreamTypeVIDEO = 1935960438
Procedure CopyMemoryToImage(Memory, ImageNumber)
Protected TemporaryDC.L, TemporaryBitmap.BITMAP, TemporaryBitmapInfo.BITMAPINFO
TemporaryDC = CreateDC_("DISPLAY", #Null, #Null, #Null)
GetObject_(ImageID(ImageNumber), SizeOf(BITMAP), TemporaryBitmap.BITMAP)
TemporaryBitmapInfo\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
TemporaryBitmapInfo\bmiHeader\biWidth = TemporaryBitmap\bmWidth
TemporaryBitmapInfo\bmiHeader\biHeight = TemporaryBitmap\bmHeight
TemporaryBitmapInfo\bmiHeader\biPlanes = 1
TemporaryBitmapInfo\bmiHeader\biBitCount = 24
TemporaryBitmapInfo\bmiHeader\biCompression = #BI_RGB
SetDIBits_(TemporaryDC, ImageID(ImageNumber), 0, TemporaryBitmap\bmHeight, Memory, TemporaryBitmapInfo, #DIB_RGB_COLORS)
DeleteDC_(TemporaryDC)
EndProcedure
Procedure OpenAVI(window)
Protected aret=#False,bih.BITMAPINFOHEADER
sfile$ = OpenFileRequester("open file","","AVI (*.avi)|*.avi",1)
If sfile$
AVIFileInit()
AVIStreamOpenFromFileA(@pavi, sFile$, #streamtypeVIDEO, 0, #OF_READ, #Null)
If pavi
AVIStreamInfoA(pavi, @psi, SizeOf(psi))
srcAviWidth = psi\rcFrame\right - psi\rcFrame\left
srcAviHeight = psi\rcFrame\bottom - psi\rcFrame\top
offset = GetSystemMetrics_(#SM_CYMENU)*2
ResizeWindow(window,WindowX(window),WindowY(window),srcAviWidth,srcAviHeight+offset)
ResizeGadget(3,#PB_Ignore,WindowHeight(window)-(offset),WindowWidth(window)-6,#PB_Ignore)
glastframe = AVIStreamLength(pavi)
SetGadgetAttribute(3,#PB_TrackBar_Maximum,glastframe)
gmpf = AVIStreamSampleToTime(pavi, glastframe) / glastframe
gSizeAVIData = srcAviWidth * srcAviHeight * 3
srcImg = CreateImage(#PB_Any,srcAviWidth,srcAviHeight,24)
*pAVIdata = AllocateMemory(gSizeAVIData)
With bih
\biBitCount = 24
\biClrImportant = 0
\biClrUsed = 0
\biCompression = #BI_RGB
\biHeight = psi\rcFrame\bottom - psi\rcFrame\top
\biPlanes = 1
\biSize = 40
\biWidth = psi\rcFrame\right - psi\rcFrame\left
\biXPelsPerMeter = 0
\biYPelsPerMeter = 0
\biSizeImage = (((\biWidth * 3) + 3) & $FFFC) * \biHeight
EndWith
pgf = AVIStreamGetFrameOpen(pavi,@bih)
aret = #True
EndIf
EndIf
ProcedureReturn aret
EndProcedure
Procedure CloseAVI()
If pgf
AVIStreamGetFrameClose(pgf)
AVIStreamRelease(pavi)
AVIFileExit()
pgf=0
EndIf
EndProcedure
Procedure GrabAVIFrame(frame.l)
Protected lpbi.i,mybi.BITMAPINFOHEADER,lt
gbPlay = #True
lt = ElapsedMilliseconds()
gseek = frame
While gbPlay And gSeek < glastframe
If ElapsedMilliseconds() > lt
gSeek+1
lt + gmpf
lpbi = AVIStreamGetFrame(pgf, gSeek)
If lpbi
CopyMemory(lpbi,@mybi,SizeOf(mybi))
Offset = mybi\biSize + (mybi\biClrUsed * 4)
CopyMemoryToImage(lpbi+offset,srcImg)
SetGadgetState(2,ImageID(srcImg))
SetGadgetState(3,gseek)
EndIf
EndIf
Delay(1)
Wend
CloseAVI()
EndProcedure
Define tavi,Event,Evg,MenuID
If avifil32_LoadDLL()
If OpenWindow(0, 300, 200, 640, 480, "test", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
CreateMenu(0, WindowID(0))
MenuTitle("file")
MenuItem(1,"open")
MenuItem(2,"stop")
ImageGadget(2,0,0,640,480,0)
TrackBarGadget(3,3,480-(GetSystemMetrics_(#SM_CYMENU)+20),640-6,20,1,1000)
Repeat
Event = WaitWindowEvent()
MenuID = EventMenu()
EVG = EventGadget()
If Event = #PB_Event_Menu
Select MenuID
Case 1
If Not IsThread(tavi)
If openAvi(0)
tavi = CreateThread(@GrabAVIFrame(),1)
EndIf
Else
gbPlay = #False
WaitThread(tavi)
If openAvi(0)
tavi = CreateThread(@GrabAVIFrame(),1)
EndIf
EndIf
Case 2
gbplay = #False
If IsThread(tavi)
WaitThread(tavi)
EndIf
EndSelect
ElseIf event = #PB_Event_Gadget
If EVG = 3
gSeek = GetGadgetState(3)
EndIf
EndIf
Until Event = #PB_Event_CloseWindow
EndIf
EndIf