FORM LATERAL FIXO NO DESKTOP

  Option Explicit

Public Const TH32CS_SNAPPROCESS As Long = 2&
Public Const MAX_PATH As Long = 260

Public Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
     th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * MAX_PATH
End Type

Public Const PROCESS_ALL_ACCESS As Long = &H1F0FFF

Public Declare Function CreateToolhelp32Snapshot Lib "kernel32" _
   (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Public Declare Function ProcessFirst Lib "kernel32" _
    Alias "Process32First" _
   (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Public Declare Function ProcessNext Lib "kernel32" _
    Alias "Process32Next" _
   (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Public Declare Function OpenProcess Lib "kernel32" _
   (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
    ByVal dwProcessId As Long) As Long
Public Declare Function TerminateProcess Lib "kernel32" _
   (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Public Declare Sub CloseHandle Lib "kernel32" _
   (ByVal hPass As Long)

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

  
'For intellisense
Public Enum AppBarPos
    abpLeft = 0&
    abpTop = 1&
    abpRight = 2&
    abpBottom = 3&
End Enum
  
'A rect(angle)
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
  
'AppBarData struct
Private Type APPBARDATA
    cbSize As Long
    hwnd As Long
    ucallbackMessage As Long
    uEdge As Long
    rc As RECT
    lParam As Long '  message specific
End Type
  
'This function makes it happen. Nothing can be done without it
Private Declare Function SHAppBarMessage Lib "shell32" ( _
    ByVal dwMessage As Long, _
    pData As APPBARDATA) As Long
'We dont *have* to subclass, but we do want to do things right, dont we?
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
    ByVal hwnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long
  
'Used to forward window messages to the next window proc in the queue
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( _
    ByVal lpPrevWndFunc As Long, _
    ByVal hwnd As Long, _
    ByVal Msg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long
'Move the window
Private Declare Function SetWindowPos Lib "user32" ( _
    ByVal hwnd As Long, _
    ByVal hWndInsertAfter As Long, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal cx As Long, _
    ByVal cy As Long, _
    ByVal wFlags As Long) As Long
'Get the window dimensions
Private Declare Function GetWindowRect Lib "user32" ( _
    ByVal hwnd As Long, _
    lpRect As RECT) As Long
'Get desktop window
Private Declare Function GetDesktopWindow Lib "user32" () As Long
  
Const ABM_NEW = &H0
Const ABM_REMOVE = &H1
Const ABM_QUERYPOS = &H2
Const ABM_SETPOS = &H3
Const ABM_GETSTATE = &H4
Const ABM_GETTASKBARPOS = &H5
Const ABM_ACTIVATE = &H6               '  lParam == TRUE/FALSE means activate/deactivate
Const ABM_GETAUTOHIDEBAR = &H7
Const ABM_SETAUTOHIDEBAR = &H8          '  this can fail at any time.  MUST check the result
Const ABM_WINDOWPOSCHANGED = &H9
  
Const ABN_STATECHANGE = &H0
Const ABN_POSCHANGED = &H1
Const ABN_FULLSCREENAPP = &H2
Const ABN_WINDOWARRANGE = &H3 '  lParam == TRUE means hide
  
Const ABS_AUTOHIDE = &H1
Const ABS_ALWAYSONTOP = &H2
  
Const WM_USER = &H400
Const WM_ACTIVATE = &H6
Const WM_SIZE = &H5
Const WM_MOVE = &H3
  
Const GWL_WNDPROC = (-4)
  
Const HWND_TOP = 0&
Const HWND_BOTTOM = 1&
  
Const SWP_NOSIZE = &H1&
Const SWP_NOMOVE = &H2&
Const SWP_NOZORDER = &H4
  
'The old windowproc
Dim lOldProc As Long
'The hWnd
Dim lhWnd As Long
'Since we need this so much, just keep a copy permanently
Dim abdAppBar As APPBARDATA

Public Function CloseProcess(EXEName As String, Optional bOnlyFirstInstance As Boolean = False) As Boolean
Dim hSnapShot  As Long
Dim uProcess   As PROCESSENTRY32
Dim hProcess   As Long

   CloseProcess = False
  hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
   If hSnapShot = -1 Then Exit Function

   uProcess.dwSize = Len(uProcess)
   If ProcessFirst(hSnapShot, uProcess) = 1 Then
      Do
         If LCase$(Left$(uProcess.szExeFile, InStr(1, uProcess.szExeFile, vbNullChar) - 1)) = LCase$(EXEName) Then
            hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, uProcess.th32ProcessID)
            CloseProcess = TerminateProcess(hProcess, ByVal 0&) > 0
            If bOnlyFirstInstance = True Then Exit Do
         End If
      Loop While ProcessNext(hSnapShot, uProcess)
   End If

   Call CloseHandle(hSnapShot)
End Function


  
Public Sub StartAppBar(frm As Form, position As AppBarPos)
    'Dont want to subclass twice
   On Error GoTo sErr

    If lOldProc = 0 Then
        Dim rScreen As RECT
        Dim rFrm As RECT
          
        GetWindowRect GetDesktopWindow, rScreen
        GetWindowRect frm.hwnd, rFrm
          
        rFrm.Bottom = rFrm.Bottom - rFrm.Top
        rFrm.Right = rFrm.Right - rFrm.Left
        rFrm.Top = 0
        rFrm.Left = 0
      
        lhWnd = frm.hwnd
        'Subclass !
        lOldProc = SetWindowLong(lhWnd, GWL_WNDPROC, AddressOf AppBarProc)
          
        abdAppBar.cbSize = Len(abdAppBar)
        abdAppBar.hwnd = lhWnd
        abdAppBar.ucallbackMessage = WM_USER
          
        If SHAppBarMessage(ABM_NEW, abdAppBar) = 0 Then
            'Uh-oh, something went wrong!
            StopAppBar
            Exit Sub
        End If
          
        'Where is the taskbar?
        SHAppBarMessage ABM_GETTASKBARPOS, abdAppBar
          
        'Size our window so its in the right place
        With abdAppBar.rc
          
            If .Top > rScreen.Top Then
                'Taskbar is at the bottom
                rScreen.Bottom = .Top
            ElseIf .Bottom < rScreen.Bottom Then
                'Taskbar is at the top
                rScreen.Top = .Bottom
            ElseIf .Right < rScreen.Right Then
                'Taskbar is at the left
                rScreen.Left = .Right
            Else
                'Taskbar is at the right
                rScreen.Right = .Left
            End If
                  
            abdAppBar.rc = rScreen
      
            Select Case position
            Case AppBarPos.abpLeft
                .Right = rFrm.Right
                  
            Case AppBarPos.abpTop
                .Bottom = rFrm.Bottom
                  
            Case AppBarPos.abpRight
                .Left = .Right - rFrm.Right
                  
            Case AppBarPos.abpBottom
                .Top = .Bottom - rFrm.Bottom
                  
            End Select
        End With
          
        'Which edge are we using?
        abdAppBar.uEdge = position
                  
        'Ask the OS to find us a space to put the AppBar
        SHAppBarMessage ABM_QUERYPOS, abdAppBar
        'Tell the OS we're putting our AppBar there (OS reduces desktop space to fit)
        SHAppBarMessage ABM_SETPOS, abdAppBar
        'Move our window
        SetWindowPos lhWnd, 0, abdAppBar.rc.Left, _
                     abdAppBar.rc.Top, abdAppBar.rc.Right - abdAppBar.rc.Left, _
                     abdAppBar.rc.Bottom - abdAppBar.rc.Top, SWP_NOZORDER
    End If

sErr:
   If err.Number <> 0 Then mSYS_Err err, "StartAppBar": Exit Sub
End Sub

Public Sub StopAppBar()
    'Dont want to unsubclass a non-subclassed window
   On Error GoTo sErr
   
    If lOldProc Then
        'Tell the OS we're done with the AppBar
        SHAppBarMessage ABM_REMOVE, abdAppBar
        'Unsubclass
        SetWindowLong lhWnd, GWL_WNDPROC, lOldProc
        'Reset so we can do it all again
        lOldProc = 0
    End If

sErr:
   If err.Number <> 0 Then mSYS_Err err, "StopAppBar": Exit Sub
End Sub
  
Public Function AppBarProc(ByVal hwnd As Long, ByVal uMsg As Long, _
                           ByVal wParam As Long, ByVal lParam As Long) As Long
      
   On Error GoTo sErr

    Select Case uMsg
    Case WM_ACTIVATE
        'Window got activated
        SHAppBarMessage ABM_ACTIVATE, abdAppBar
    Case WM_USER
        'Special AppBar message
          
        Select Case wParam
        Case ABN_STATECHANGE
            'Notifies an appbar that the taskbar's autohide or _
                always-on-top state has changed-that is,
            'the user has selected or cleared the "Always on top" or _
            "Auto hide" check box on the taskbar's property sheet.
          
        Case ABN_POSCHANGED
            'Notifies an appbar when an event has occurred that may affect _
             the appbar's size and position.
            'Events include changes in the taskbar's size, position, and visibility _
             state, as well as the
            'addition, removal, or resizing of another appbar on the same side of the screen.
          
            GetWindowRect lhWnd, abdAppBar.rc
            SHAppBarMessage ABM_QUERYPOS, abdAppBar
            SHAppBarMessage ABM_SETPOS, abdAppBar
            SetWindowPos lhWnd, 0, abdAppBar.rc.Left, abdAppBar.rc.Top, _
                    abdAppBar.rc.Right, abdAppBar.rc.Bottom, SWP_NOZORDER
          
        Case ABN_FULLSCREENAPP
            'Notifies an appbar when a full-screen application is opening or closing.
            'This notification is sent in the form of an application-defined _
             message that is set by the ABM_NEW message.
              
            If CBool(lParam) Then
                'Fullscreen app is loading!
                'Pop