VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "TransparentFPC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'Win32 API
Private Declare Function ShellExecute Lib "shell32" _
   Alias "ShellExecuteA" _
  (ByVal hwnd As Long, _
   ByVal lpOperation As String, _
   ByVal lpFile As String, _
   ByVal lpParameters As String, _
   ByVal lpDirectory As String, _
   ByVal nShowCmd As Long) As Long
   
Private Declare Function FPC_CreateWindow Lib "f_in_box.dll" _
   Alias "FPC_CreateWindowA" _
  (ByVal hFPC As Long, _
   ByVal dwExStyle As Long, _
   ByVal lpWindowName As String, _
   ByVal dwStyle As Long, _
   ByVal x As Long, ByVal y As Long, _
   ByVal nWidth As Long, _
   ByVal nHeight As Long, _
   ByVal hWndParent As Long, _
   ByVal hMenu As Long, _
   ByVal hInstance As Long, _
   lpParam As Any) As Long
   
Private Declare Function FPC_UnloadCode Lib "f_in_box.dll" _
    (ByVal hFPC As Long) As Long
   
Private Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long

Private Declare Function SetWindowLong Lib "user32" _
    Alias "SetWindowLongA" _
   (ByVal hwnd As Long, _
    ByVal nIndex As Long, _
    ByVal wNewLong As Long) As Long
    
Private Declare Function CallWindowProc Lib "user32" _
    Alias "CallWindowProcA" _
   (ByVal lpPrevWndFunc As Long, _
    ByVal hwnd As Long, _
    ByVal uMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long
    
Private Declare Function GetSystemMetrics Lib "user32" _
   (ByVal nIndex As Long) As Long
   
Private Declare Function SetWindowText Lib "user32" _
   Alias "SetWindowTextA" _
  (ByVal hwnd As Long, _
   ByVal lpString As String) As Long
   
Private Declare Function DestroyWindow Lib "user32" _
   (ByVal hwnd As Long) As Long
    
Private Declare Function ShowWindow Lib "user32" _
   (ByVal hwnd As Long, _
    ByVal nCmdShow As Long) As Long
    
Private Declare Function GetCursorPos Lib "user32" _
  (lpPoint As POINT) As Long
  
Private Declare Function GetWindowRect Lib "user32" _
  (ByVal hwnd As Long, _
   lpRect As RECT) As Long
   
Private Declare Function SetCapture Lib "user32" _
  (ByVal hwnd As Long) As Long
  
Private Declare Function ReleaseCapture Lib "user32" _
  () As Long
  
Private Declare Function MoveWindow Lib "user32" _
  (ByVal hwnd As Long, _
   ByVal x As Long, _
   ByVal y As Long, _
   ByVal nWidth As Long, _
   ByVal nHeight As Long, _
   ByVal bRepaint As Long) As Long

'Win32 constants
Private Const WS_VISIBLE As Long = &H10000000
Private Const WS_POPUP As Long = &H80000000
Private Const WS_BORDER As Long = &H800000
Private Const WS_EX_LAYERED As Long = &H80000
Private Const WM_LBUTTONDOWN As Long = &H201
Private Const WM_LBUTTONUP As Long = &H202
Private Const WM_RBUTTONUP As Long = &H205
Private Const WM_MOUSEMOVE As Long = &H200
Private Const WM_USER As Long = &H400
'GetSystemMetrics() codes
Private Const SM_CXFULLSCREEN As Long = 16
Private Const SM_CYFULLSCREEN As Long = 17
Private Const GWL_WNDPROC = (-4)
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOW = 5

'Struct POINT
Private Type POINT
   x As Long
   y As Long
End Type

'Struct RECT
Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

'FlashPlayerControl API
Private Declare Function FPCLoadMovieFromResource Lib "f_in_box.dll" _
    Alias "FPCLoadMovieFromResourceA" _
   (ByVal hwndFlashPlayerControl As Long, _
    ByVal layer As Integer, _
    ByVal hInstance As Long, _
    ByVal lpName As String, _
    ByVal lpType As String) As Boolean

'FlashPlayerControl constants
Private Const FPCM_FIRST As Long = WM_USER + &H1000
Private Const FPCM_PUT_STANDARD_MENU As Long = FPCM_FIRST + 5

'Struct SFPCPutStandardMenu
Private Type SFPCPutStandardMenu
    StandardMenu As Boolean
End Type

Private FlashPlayerControlWnd As Long
Private PrevWindowProc As Long
Private Captured As Boolean
Private PtLeftTop As POINT
Private PtStart As POINT

Public hFPC As Long

Public Property Get PrevWindowProcVal() As Long
    PrevWindowProcVal = PrevWindowProc
End Property

Public Sub Create()
    Const Width As Long = 640
    Const Height As Long = 480
    
    Dim MaxX As Long
    Dim MaxY As Long
    MaxX = GetSystemMetrics(SM_CXFULLSCREEN)
    MaxY = GetSystemMetrics(SM_CYFULLSCREEN)
    'Create flash player window
    FlashPlayerControlWnd = FPC_CreateWindow( _
                                        hFPC, _
                                        WS_EX_LAYERED, _
                                        vbNullString, _
                                        WS_POPUP Or WS_VISIBLE, _
                                        (MaxX - Width) / 2, (MaxY - Height) / 2, _
                                        Width, _
                                        Height, _
                                        0, 0, 0, _
                                        ByVal 0)
    
    Call SetWindowText(FlashPlayerControlWnd, "Sample 4 - Translucency")
    
    'Also you can use FPCM_LOADMOVIEFROMMEMORY
    'FPCLoadMovieFromResource is useful for loading from resources,
    'use FPCM_LOADMOVIEFROMMEMORY to load movie from any memory block
    Call FPCLoadMovieFromResource(FlashPlayerControlWnd, 0, 0, "MOVIE", "SWF")
    
    'Disable standard flash context menu
    Dim FPCPutStandardMenu As SFPCPutStandardMenu
    FPCPutStandardMenu.StandardMenu = False
    Call SendMessage(FlashPlayerControlWnd, FPCM_PUT_STANDARD_MENU, 0&, FPCPutStandardMenu)
    'Initialize variables
    Captured = False
End Sub

Private Sub Class_Terminate()
    Call SetWindowLong(FlashPlayerControlWnd, GWL_WNDPROC, PrevWindowProc)
    Call DestroyWindow(FlashPlayerControlWnd)

    If hFPC <> 0 Then
        FPC_UnloadCode hFPC
    End If
End Sub

Public Sub SubclassWindow()
    PrevWindowProc = SetWindowLong(FlashPlayerControlWnd, GWL_WNDPROC, AddressOf TransparentFlashPlayerControlWindowProc)
End Sub

Public Sub Minimize()
    Call ShowWindow(FlashPlayerControlWnd, SW_SHOWMINIMIZED)
End Sub

Public Sub MoreAboutFlashPlayerControl()
    ShellExecute FlashPlayerControlWnd, vbNullString, "http://f-in-box.com/dll/", vbNullString, vbNullString, SW_SHOW
End Sub

Public Sub OrderFlashPlayerControl()
    ShellExecute FlashPlayerControlWnd, vbNullString, "http://f-in-box.com/dll/order.html", vbNullString, vbNullString, SW_SHOW
End Sub

Public Sub VisitOurForum()
    ShellExecute FlashPlayerControlWnd, vbNullString, "http://f-in-box.com/forum/", vbNullString, vbNullString, SW_SHOW
End Sub

Public Sub OnLButtonDown()
    Dim pt As POINT
    GetCursorPos pt

    PtStart.x = pt.x
    PtStart.y = pt.y

    Dim rc As RECT
    GetWindowRect FlashPlayerControlWnd, rc

    PtLeftTop.x = rc.Left
    PtLeftTop.y = rc.Top

    Captured = True

    SetCapture FlashPlayerControlWnd
End Sub

Public Sub OnLButtonUp()
    Captured = False
    ReleaseCapture
End Sub

Public Sub OnMouseMove()
    If Captured Then
        Dim pt As POINT
        GetCursorPos pt

        Dim ptDelta As POINT
        ptDelta.x = pt.x - PtStart.x
        ptDelta.y = pt.y - PtStart.y
        
        Dim rc As RECT
        GetWindowRect FlashPlayerControlWnd, rc

        Dim nWidth As Integer
        Dim nHeight As Integer
        
        nWidth = rc.Right - rc.Left
        nHeight = rc.Bottom - rc.Top
        
        rc.Left = PtLeftTop.x + ptDelta.x
        rc.Top = PtLeftTop.y + ptDelta.y
        rc.Right = rc.Left + nWidth
        rc.Bottom = rc.Top + nHeight

        MoveWindow FlashPlayerControlWnd, rc.Left, rc.Top, nWidth, nHeight, True
    End If
End Sub


