Win2K Transparency

This is a demonstration of how to set up alpha transparency and hotkeys on the Windows desktop. It will only work if you have Windows 2000/XP because alpha transparency was not implemented in earlier versions, so it wont work.

Form1 code

Private Sub cmdOK_Click()
  Form1.Hide
End Sub

Private Sub cmdExit_Click()
  End
End Sub

Private Sub Form_Load()
  Me.Hide
  StartHook Me.hWnd

End Sub

Private Sub HScroll1_Change()
  Label3 = HScroll1.Value
  MakeTransparent fhWnd, HScroll1.Value

End Sub

Generated using PrettyCode.Encoder

Hotkey module

'Declare functions
Private Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Private Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long) As Long
Private Declare Function CallWindowProc Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function PostMessage Lib "user32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
'Define constants
Private Const WM_HOTKEY = &H312
Private Const WM_NCDESTROY = &H82
Private Const WM_MOUSEMOVE = &H200
Private Const GWL_WNDPROC = (-4)
'Dim variables
Dim fhWnd As Long
Private m_lpPrevWndProc As Long
Private m_hWndMain As Long

Public Sub StartHook(hWnd As Long)

  m_hWndMain = hWnd
  'Register Ctrl-T as a hotkey
  RegisterHotKey hWnd, 0, vbCtrlMask, vbKeyT
  'Sub-class the window, so it can intercept hotkey presses
  m_lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc)

End Sub

Public Sub StopHook()
  'Unregister the hotkey
  UnregisterHotKey m_hWndMain, 0
  'Stop sub-classing
  SetWindowLong m_hWndMain, GWL_WNDPROC, m_lpPrevWndProc

End Sub

'This is where the window messages are analysed
Public Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long

  Select Case uMsg
    Case WM_NCDESTROY
      'If the window gets an NCDESTROY message (ie: it is being closed)
      'Stop sub-classing
      StopHook
    Case WM_HOTKEY
      'If the window hets a HOTKEY message (ie: the hotkey has been pressed)
      'Get the handle to the top window
      fhWnd = GetForegroundWindow
      'Load the form and give it focus
      Form1.HScroll1.Value = 255
      Form1.Show
      Form1.SetFocus
  End Select

  'Send the window messages on to be processed as normal
  WndProc = CallWindowProc(m_lpPrevWndProc, hWnd, uMsg, wParam, lParam)

End Function

Generated using PrettyCode.Encoder

Transparency Module

'Define the required constants
Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_LAYERED = &H80000
Public Const WS_EX_TRANSPARENT = &H20&
Public Const LWA_ALPHA = &H2&
'Declare the required functions
Private Declare Function GetWindowLong Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

'Pass this a valid window handle and an amount between 0(transparent) and 255(solid)
Public Sub MakeTransparent(hWnd As Long, Amount As Integer)
  Dim NormalWindowStyle As Long
  'Get the 32bit Extended Style value
  NormalWindowStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
  On Error GoTo Er
  'Make the window a layered window, by adding the LAYERED attribute to its extended style
  SetWindowLong hWnd, GWL_EXSTYLE, NormalWindowStyle Or WS_EX_LAYERED
  'Set the transparency level of the window
  SetLayeredWindowAttributes hWnd, 0, Amount, LWA_ALPHA
  Exit Sub

  Er:
  MsgBox "Your version of Windows does not support alpha transparency! You must be using Win 2000 or XP for this to work."
End Sub

Public Sub FadeOut()
  'Fades the window out in 256 steps
  For t = 255 To 0 Step -1
    MakeTransparent Form1.hWnd, t
    DoEvents
  Next t
End Sub
Public Sub FadeIn()
  'Fades the window in in 256 steps
  For t = 0 To 255
    MakeTransparent Form1.hWnd, t
    DoEvents
  Next t
End Sub

Generated using PrettyCode.Encoder