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