Trust Me!! Trust You!!

Option Explicit

Dim WithEvents IEDoc As HTMLDocument

Private bolTheater As Boolean
Private Const REG_SZ As Long = 1
Private Const REG_DWORD As Long = 4

Private Const HKEY_CURRENT_USER = &H80000001


Private Const ERROR_NONE = 0
Private Const ERROR_BADDB = 1
Private Const ERROR_BADKEY = 2
Private Const ERROR_CANTOPEN = 3
Private Const ERROR_CANTREAD = 4
Private Const ERROR_CANTWRITE = 5
Private Const ERROR_OUTOFMEMORY = 6
Private Const ERROR_INVALID_PARAMETER = 7
Private Const ERROR_ACCESS_DENIED = 8
Private Const ERROR_INVALID_PARAMETERS = 87
Private Const ERROR_NO_MORE_ITEMS = 259

Private Const KEY_ALL_ACCESS = &H3F

Private Const REG_OPTION_NON_VOLATILE = 0

   Private Declare Function RegCloseKey Lib "advapi32.dll" _
   (ByVal hKey As Long) As Long
   Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias _
   "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
   ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions _
   As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes _
   As Long, phkResult As Long, lpdwDisposition As Long) As Long
   Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
   "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
   ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As _
   Long) As Long
   Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias _
   "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
   String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
   As String, lpcbData As Long) As Long
   Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias _
   "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
   String, ByVal lpReserved As Long, lpType As Long, lpData As _
   Long, lpcbData As Long) As Long
   Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias _
   "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
   String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
   As Long, lpcbData As Long) As Long
   Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias _
   "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
   ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As _
   String, ByVal cbData As Long) As Long
   Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias _
   "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
   ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, _
   ByVal cbData As Long) As Long



Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As _
   String, vValue As Variant) As Long
       Dim cch As Long
       Dim lrc As Long
       Dim lType As Long
       Dim lValue As Long
       Dim sValue As String

       On Error GoTo QueryValueExError

       ' Determine the size and type of data to be read
       lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
       If lrc <> ERROR_NONE Then Error 5

       Select Case lType
           ' For strings
           Case REG_SZ:
               sValue = String(cch, 0)
   lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, _
   sValue, cch)
               If lrc = ERROR_NONE Then
                   vValue = Left$(sValue, cch - 1)
               Else
                   vValue = Empty
               End If
           ' For DWORDS
           Case REG_DWORD:
   lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, _
   lValue, cch)
               If lrc = ERROR_NONE Then vValue = lValue
           Case Else
               'all other data types not supported
               lrc = -1
       End Select

QueryValueExExit:
       QueryValueEx = lrc
       Exit Function
QueryValueExError:
       Resume QueryValueExExit
End Function

Private Sub Theater()
Dim lRetVal As Long         'result of the API functions
Dim hKey As Long         'handle of opened key
Dim vValue As Variant      'setting of queried value

lRetVal = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Main", 0, KEY_ALL_ACCESS, hKey)
lRetVal = QueryValueEx(hKey, "Fullscreen", vValue)
If UCase$(Trim$(vValue)) = "NO" Then
    SendKeys "{F11}"
    bolTheater = False
Else
    bolTheater = True
End If
RegCloseKey (hKey)

End Sub


Private Function IEDoc_onclick() As Boolean
On Error Resume Next
If bolTheater = False Then
    SendKeys "{F11}"
End If

End Function

Private Sub Label1_Click()
On Error Resume Next
If bolTheater Then
    SendKeys "{F11}"
End If
End Sub

Private Sub UserControl_Initialize()
Call Theater
End Sub


Private Sub UserControl_Show()
Set IEDoc = UserControl.Parent.Script.document
IEDoc.body.bgColor = "black"

End Sub











------------------------------------------------------------
Private WithEvents WB As MSHTML.HTMLWindow2

Private bolTheater As Boolean
Private Const REG_SZ As Long = 1
Private Const REG_DWORD As Long = 4

Private Const HKEY_CURRENT_USER = &H80000001


Private Const ERROR_NONE = 0
Private Const ERROR_BADDB = 1
Private Const ERROR_BADKEY = 2
Private Const ERROR_CANTOPEN = 3
Private Const ERROR_CANTREAD = 4
Private Const ERROR_CANTWRITE = 5
Private Const ERROR_OUTOFMEMORY = 6
Private Const ERROR_INVALID_PARAMETER = 7
Private Const ERROR_ACCESS_DENIED = 8
Private Const ERROR_INVALID_PARAMETERS = 87
Private Const ERROR_NO_MORE_ITEMS = 259

Private Const KEY_ALL_ACCESS = &H3F

Private Const REG_OPTION_NON_VOLATILE = 0

  Private Declare Function RegCloseKey Lib "advapi32.dll" _
  (ByVal hKey As Long) As Long
  Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias _
  "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
  ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions _
  As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes _
  As Long, phkResult As Long, lpdwDisposition As Long) As Long
  Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
  "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
  ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As _
  Long) As Long
  Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias _
  "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
  String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
  As String, lpcbData As Long) As Long
  Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias _
  "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
  String, ByVal lpReserved As Long, lpType As Long, lpData As _
  Long, lpcbData As Long) As Long
  Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias _
  "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
  String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
  As Long, lpcbData As Long) As Long
  Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias _
  "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
  ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As _
  String, ByVal cbData As Long) As Long
  Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias _
  "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
  ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, _
  ByVal cbData As Long) As Long



Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As _
  String, vValue As Variant) As Long
      Dim cch As Long
      Dim lrc As Long
      Dim lType As Long
      Dim lValue As Long
      Dim sValue As String

      On Error GoTo QueryValueExError

      ' Determine the size and type of data to be read
      lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
      If lrc <> ERROR_NONE Then Error 5

      Select Case lType
          ' For strings
          Case REG_SZ:
              sValue = String(cch, 0)
  lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, _
  sValue, cch)
              If lrc = ERROR_NONE Then
                  vValue = Left$(sValue, cch - 1)
              Else
                  vValue = Empty
              End If
          ' For DWORDS
          Case REG_DWORD:
  lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, _
  lValue, cch)
              If lrc = ERROR_NONE Then vValue = lValue
          Case Else
              'all other data types not supported
              lrc = -1
      End Select

QueryValueExExit:
      QueryValueEx = lrc
      Exit Function
QueryValueExError:
      Resume QueryValueExExit
End Function

Private Sub Theater()
Dim lRetVal As Long         'result of the API functions
Dim hKey As Long         'handle of opened key
Dim vValue As Variant      'setting of queried value

lRetVal = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Main", 0, KEY_ALL_ACCESS, hKey)
lRetVal = QueryValueEx(hKey, "Fullscreen", vValue)
If UCase$(Trim$(vValue)) = "NO" Then
   SendKeys "{F11}"
   bolTheater = False
Else
   bolTheater = True
End If
RegCloseKey (hKey)

End Sub

Private Sub UserControl_Initialize()
Call Theater
End Sub

Private Sub UserControl_Show()
Set IEDoc = UserControl.Parent.Script.document
Set WB = IEDoc.parentWindow
End Sub

Private Sub WB_onbeforeunload()
If bolTheater = False Then
    SendKeys "{F11}"
End If
End Sub



-----------------------------------------------------------------------------------

Private IE As InternetExplorer
Private bolTheater As Boolean
Private Sub GrabWindow(URL As String)
On Error Resume Next
Dim i As Integer
Dim shWin As SHDocVw.ShellWindows

Set shWin = New SHDocVw.ShellWindows
For i = 1 To shWin.Count
    Dim LocUrl As String
    LocUrl = UCase$(Replace(shWin.Item(i).LocationURL, "%20", " "))
    If LocUrl = UCase$("file:///" & URL) Then
        Set IE = shWin.Item(i)
        bolTheater = IE.TheaterMode
        IE.TheaterMode = True
        Exit For
    End If
Next i
End Sub


Private Sub UserControl_Initialize()
'Call Theater
End Sub


Private Sub UserControl_Show()
Dim IEDoc As Object
Set IEDoc = UserControl.Parent.Script.document
Set WB = IEDoc.parentWindow

' mid and replace functions are used because is a
' local reference.
' We need to use WB.Location.href in internet.
GrabWindow Replace(Mid$(WB.location.pathname, 2), "\", "/")
End Sub

Private Sub WB_onbeforeunload()
IE.TheaterMode = bolTheater
End Sub