Desktop 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.runsetup:
Sub runsetup()
  'extern WindowGroupRef GetWindowGroupOfClass(WindowClass windowClass)                AVAILABLE_MAC_OS_X_VERSION_10_0_AND_LATER;
  'extern OSStatus SetWindowGroupLevel(WindowGroupRef   inGroup,SInt32           inLevel)                                   AVAILABLE_MAC_OS_X_VERSION_10_0_AND_LATER;
  'CGWindowLevel CGWindowLevelForKey( CGWindowLevelKey key )
  'extern OSStatus SetWindowGroupLevel(WindowGroupRef   inGroup,SInt32           inLevel)                                   AVAILABLE_MAC_OS_X_VERSION_10_0_AND_LATER;
  'extern OSStatus SetWindowGroup(WindowRef        inWindow,WindowGroupRef   inNewGroup)                                AVAILABLE_MAC_OS_X_VERSION_10_0_AND_LATER;
  'extern OSStatus CreateWindowGroup(WindowGroupAttributes   inAttributes,WindowGroupRef *        outGroup)                           AVAILABLE_MAC_OS_X_VERSION_10_0_AND_LATER;
  
  const kCGBaseWindowLevelKey  = 0
  const kCGMinimumWindowLevelKey = 1
  const kCGDesktopWindowLevelKey = 2 
  const kCGBackstopMenuLevelKey = 3
  const kCGNormalWindowLevelKey = 4 
  const kCGFloatingWindowLevelKey = 5
  const kCGTornOffMenuWindowLevelKey = 6
  const kCGDockWindowLevelKey = 7
  const kCGMainMenuWindowLevelKey = 8
  const kCGStatusWindowLevelKey = 9
  const kCGModalPanelWindowLevelKey = 10
  const kCGPopUpMenuWindowLevelKey = 11
  const kCGDraggingWindowLevelKey = 12
  const kCGScreenSaverWindowLevelKey = 13
  const kCGMaximumWindowLevelKey = 14
  const kCGOverlayWindowLevelKey = 15
  const kCGHelpWindowLevelKey = 16 
  const kCGUtilityWindowLevelKey = 17
  const kCGDesktopIconWindowLevelKey = 18 
  const kCGCursorWindowLevelKey = 19
  const kCGNumberOfWindowLevelKeys = 20
  
  dim s as softDeclareMBS
  dim m,n as memoryBlock
  dim w,h as integer
  dim WindowLevel as integer
  dim mode as integer
  
  IgnoreClicksMBS=true // MBS Plugin 3.2pr11 or newer!
  
  'select case app.mode
  'case 0
  mode=kCGDesktopWindowLevelKey
  'case 1
  'mode=kCGDesktopIconWindowLevelKey
  'case 2
  'mode=kCGDockWindowLevelKey
  'case 3
  'mode=kCGMainMenuWindowLevelKey
  'case 4
  'mode=kCGOverlayWindowLevelKey
  'end select
  
  left=0
  top=0
  w=screen(0).width
  h=screen(0).height
  width=w
  height=h
  
  s=new softDeclareMBS
  if s.loadlibary("ApplicationServices.framework") then
    if s.loadfunction("CGWindowLevelForKey") then
      m=newmemoryBlock(4)
      m.long(0)=mode
      if s.callFunction(1,m) then
        WindowLevel=s.result
      end if
    end if
  end if
  
  s=new softDeclareMBS
  if s.loadlibary("ApplicationServices.framework") then
    if s.loadfunction("CreateWindowGroup") then
      n=newmemoryBlock(4)
      m=newmemoryBlock(8)
      m.long(0)=0
      m.long(4)=n.addressMBS(0)
      if s.callFunction(2,m) then
        windowgroup=n.long(0)
      end if
    end if
  end if
  
  SetWindowGroupLevel windowgroup,WindowLevel
  
  s=new softDeclareMBS
  if s.loadlibary("ApplicationServices.framework") then
    if s.loadfunction("SetWindowGroup") then
      m=newmemoryBlock(8)
      m.long(0)=me.MacWindowPtr
      m.long(4)=windowgroup
      if s.callFunction(2,m) then
      end if
    end if
  end if
  
  
End Sub

MainWindow.SetWindowGroupLevel:
Sub SetWindowGroupLevel(g as integer, l as integer)
  dim s as softDeclareMBS
  dim m as memoryBlock
  
  s=new softDeclareMBS
  if s.loadlibary("ApplicationServices.framework") then
    if s.loadfunction("SetWindowGroupLevel") then
      m=newmemoryBlock(8)
      m.long(0)=g
      m.long(4)=l
      if s.callFunction(2,m) then
      end if
    end if
  end if
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,s.width/m.baseMovieWidth)
  
  w=m.baseMoviewidth*f
  h=m.baseMovieHeight*f
  x=(s.width-w)/2
  y=(s.height-h)/2
  
  player.left=x
  player.top=y
  player.width=w
  player.height=h
  
  if not secondmovie then
    player.movie=m
    player.Volume=volume
    player.play
  end if
  
  ObscureCursorMBS
  
  if ti<>"" then
    Title=ti // for dock menu
  end if
  
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.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
  if key=chr(27) then
    quit
  end if
End Function

MainWindow.Open:
Sub Open()
  Runsetup
  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.makefilelist:
Sub makefilelist(f as folderItem)
  redim files(0)
  
  RunFileList f
  
  ReSortFileList
  
  mainwindow.run nil,f.DisplayName
  
Exception
  quit
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
  
  'DebugMessageEnableMBS true
  'for i=1 to c
  'DebugMessageMBS str(i)+": "+files(i).Name
  'next
  
  count=0
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=".mpg" or n4=".mp4" 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.StaticText7.MouseUp:
Sub MouseUp(X As Integer, Y As Integer)
  me.TextColor=rgb(0,0,255)
  ShowURL "http://www.monkeybreadsoftware.de"
End Sub

AboutDialog.StaticText7.MouseDown:
Function MouseDown(X As Integer, Y As Integer) As Boolean
  me.TextColor=rgb(255,0,0)
  Return true
End Function

NextTimer.Action:
Sub Action()
  MainWindow.nextmovie
End Sub




Links
MBS Xojo Plugins