Fullscreen Movie Player 2.2 Sourcecode
MainWindow.run: Sub run(m as movie,ti as string) if m<>nil then runmovie m,ti,false Return end if nextmovie IsPlaylist=true End Sub MainWindow.findnextmovie: Function findnextmovie() As movie dim m as movie dim f as FolderItem if MovieRepeatthisone.Checked then Return nil else app.count=app.count+1 if app.count>UBound(app.files) then app.ReSortFileList app.count=1 end if f=app.files(app.count) m=f.OpenAsMovie if m<>nil then Return m else DebugMessageEnableMBS true DebugMessageMBS "Failed to open movie: "+f.Name end if end if Exception End Function MainWindow.nextmovie: Sub nextmovie() dim m as movie setup=true m=findnextmovie if m<>nil then player.movie=m else Player.Position=0 end if player.Volume=volume player.play runmovie m,"",true setup=false Exception setup=false End Sub MainWindow.runmovie: Sub runmovie(m as movie, ti as string, secondmovie as boolean) dim f as double dim s as screen dim w,h,x,y as integer s=screen(0) f=min(s.height/(m.baseMovieHeight+16),s.width/m.baseMovieWidth) w=m.baseMoviewidth*f h=m.baseMovieHeight*f x=(s.width-w)/2 y=(s.height-h)/2 if x<16 then x=0 end if player.left=x player.top=y player.width=w player.height=h player.movie=m player.play ObscureCursorMBS Title=ti // for the dock menu End Sub MainWindow.MouseMove: Sub MouseMove(X As Integer, Y As Integer) if y<50 then MenuBarVisible=true else MenuBarVisible=false end if End Sub MainWindow.EnableMenuItems: Sub EnableMenuItems() MovieLoop.Enable MovieLoop.Checked=player.Looping MovieNextinList.Enable MovieRepeatthisone.Enable MovieMute.Enable MovieVolumedown.Enable MovieVolumeUp.Enable MovieVolumeMax.Enable End Sub MainWindow.KeyDown: Function KeyDown(Key As String) As Boolean dim a as integer a=asc(key) if a=27 then quit Return true elseif a=32 then if Player.Rate=0 then player.play else player.stop end if Return true end if End Function MainWindow.Open: Sub Open() volume=255 End Sub MainWindow.Player.Stop: Sub Stop() if IsPlaylist and not setup then if player.Position>=me.Movie.DurationMBS-1 then time=new NextTimer time.Period=10 time.Mode=1 // RB 4.5 still crashes if you change the movie in the stop event! end if end if End Sub MainWindow.Player.Play: Sub Play() ObscureCursorMBS // hide the mouse till it's moved. End Sub MainWindow.Timer1.Action: Sub Action() QuickTimePollMBS // This improves performance as more CPU time is given to QuickTime End Sub App.ReSortFileList: Sub ReSortFileList() dim i,c,cc as integer dim m,n as integer dim f,ff as FolderItem // Resorts the file list to be random c=UBound(files) ff=files(c) // get last played movie cc=c*c for i=1 to cc m=rnd*c+1 n=rnd*c+1 f=files(m) files(m)=files(n) files(n)=f next if ff=files(1) and c>1 then // if last is next, fix it! m=1 n=rnd*(c-1)+2 f=files(m) files(m)=files(n) files(n)=f end if count=0 End Sub App.makefilelist: Sub makefilelist(f as folderitem) redim files(0) RunFileList f ReSortFileList mainwindow.run nil,f.DisplayName Exception quit End Sub App.RunFileList: Sub RunFileList(f as folderitem) dim i,c as integer dim g as FolderItem dim n4,n5,mt,mc as string c=f.Count for i=1 to c g=f.Item(i) if g<>nil then if g.Directory then RunFileList g else n4=right(g.name,4) n5=right(g.name,5) mc=g.MacCreator mt=g.MacType if g.Visible and left(g.name,1)<>"." and (mt="MooV" or mc="TVOD" or mt="MPEG" or n5=".mpeg" or n4=".avi" or n4=".mp4" or n4=".mpg" or n4=".mov") then files.Append g end if end if end if next End Sub App.Open: Sub Open() RegisterPlugins // Remove this line. #if DebugBuild OpenDocument DesktopFolder.Child("movies") #endif End Sub App.EnableMenuItems: Sub EnableMenuItems() AppleAboutthisapplication.Enable FileOpen.Enable FileOpenfolder.Enable FileOpenmoviefolder.Enable End Sub App.OpenDocument: Sub OpenDocument(item As FolderItem) dim m as movie if item<>nil and item.Exists then if item.Directory then makefilelist item else m=item.openasmovie if m<>NIL THEN mainwindow.run m,item.DisplayName else quit end if end if end if Exception quit End Sub App.NewDocument: Sub NewDocument() dim f as FolderItem f=GetFolderItem("Autoplay movies") if f<>nil and f.Exists then OpenDocument f end if Exception End Sub AboutDialog.Open: Sub Open() #if TargetWin32 title="Fullscreen Movie Player" #else title=app.longVersion #endif StaticText1.text=Title End Sub AboutDialog.Canvas1.Paint: Sub Paint(g As Graphics) dim f as FolderItem f=app.ApplicationFileMBS if f<>Nil then f.DrawIconMBS g,me.left,me.top end if End Sub AboutDialog.StaticText4.Open: Sub Open() me.text="Realbasic "+rbVersionString End Sub AboutDialog.StaticText5.Open: Sub Open() me.text=mbspluginversion End Sub AboutDialog.PushButton1.Action: Sub Action() close End Sub NextTimer.Action: Sub Action() MainWindow.nextmovie End Sub
Links
MBS Xojo Chart Plugins