Visual Basic Projects

TransparentBlt: Simulating Microsoft's 'Windows Messenger' Notifications
Step 2: Building the Calling Form
Posted:   Wednesday August 14, 2002
Updated:   Monday December 26, 2011
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows XP
OS restrictions:   None
Author:   Pierre Alexis, VBnet - Randy Birch
 Other project pages:   Step 1: Introduction and Layout
Step 2: Building the Calling Form
Step 3: Building the Notification Form

This form is straightforward in design, so no further electrons need be killed:
 BAS Code

 Form Code: Form1 - the calling form
Form1 needs, at a minimum one command button (Command1) and one image control (Image1). The label is optional. Add the following code:.

Option Explicit
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
'File for the MSIM notify sound
Private sNotifySound As String

Private Const HKEY_CURRENT_USER = &H80000001
Private Const REG_SZ As Long = 1
Private Const ERROR_SUCCESS As Long = 0
Private Const STANDARD_RIGHTS_READ As Long = &H20000
Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const KEY_NOTIFY As Long = &H10
Private Const SYNCHRONIZE As Long = &H100000
Private Const KEY_READ As Long = ((STANDARD_RIGHTS_READ Or _
                                   KEY_QUERY_VALUE Or _
                                   KEY_ENUMERATE_SUB_KEYS Or _
                                   KEY_NOTIFY) And _
                                   (Not SYNCHRONIZE))

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 RegQueryValueEx Lib "advapi32.dll" _
   Alias "RegQueryValueExA" _
  (ByVal hKey As Long, _
   ByVal lpValueName As String, _
   ByVal lpReserved As Long, _
   lpType As Long, _
   lpData As Any, _
   lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" _
  (ByVal hKey As Long) As Long

Private Declare Function lstrlenW Lib "kernel32" _
  (ByVal lpString As Long) As Long

Private Sub Form_Load()
  'obtain from the registry the sound
  'the user has associated with
  'Microsoft Windows Messenger
  'notification messages.
   sNotifySound = GetMsimNotifySound()

End Sub

Private Sub cmdShowMessage_Click()
   Dim msg As String

  'sMsg: string to display
  'ico: Image to display in the notify window -
  '     can be icon or a bitmap
  'ImageX: X coordinate of image relative to
  '     upper left corner of the form
  'ImageY: Y coordinate of image relative to
  '     upper left corner of the form
  'Duration: specify the duration
  'BgColour1: Colour of gradient background (top)
  'BgColour2: Colour of gradient background (bottom)
  'ImgTransColour: specifies the transparency colour
  '     for bitmap image. Ignored for icons
  'msShowTime: milliseconds between reveal increments, default=50
  'msHangTime: milliseconds form remains on-screen, default=4000
  'msHideTime: milliseconds between hide increments, default=50
  'bPlacement: True for top right, false for top left

  'sSound: Path of the sound to be played

   msg = "A newer version of SomeProgram is available." & _
          vbNewLine & vbNewLine & _
         "Click here to install it now."
   Call frmNotify.ShowMessage(sMsg:=msg, _
                              img:=Image1.Picture, _
                              ImageX:=88, _
                              ImageY:=4, _
                              BgColour1:=RGB(133, 112, 243), _
                              BgColour2:=RGB(255, 255, 255), _
                              ImgTransColour:=RGB(255, 0, 0), _
                              msShowTime:=10, _
                              msHangTime:=4000, _
                              msHideTime:=10, _
                              bPlacement:=False, _

  'here's the same call without 
  'the inline variable names
  'Call frmNotify.ShowMessage(msg, _
                              Image1.Picture, _
                              88, _
                              4, _
                              RGB(133, 112, 243), _
                              RGB(255, 255, 255), _
                              RGB(255, 0, 0), _
                              10, _
                              4000, _
                              10, _
                              False, _

End Sub

Private Function GetMsimNotifySound() As String

   Dim hKey As Long
   Dim sKey As String
  'valid values for the second-last member
  'of this string are:
  'You could also use sounds listed under
  'current user \ Schemes \ apps such as"
  'HKEY_CURRENT_USER\AppEvents\Schemes\ _
   sKey = "AppEvents\Schemes\Apps\MSMSGS\MSMSGS_ContactOnline\.Current"
   hKey = OpenRegKey(HKEY_CURRENT_USER, sKey)

   If hKey <> 0 Then

      GetMsimNotifySound = GetRegValue(hKey, vbNullString)
      RegCloseKey hKey
   End If

End Function

Private Function OpenRegKey(ByVal hKey As Long, _
                            ByVal lpSubKey As String) As Long

  Dim hSubKey As Long

  If RegOpenKeyEx(hKey, _
                  lpSubKey, _
                  0, _
                  KEY_READ, _
                  hSubKey) = ERROR_SUCCESS Then

      OpenRegKey = hSubKey

  End If

End Function

Private Function GetRegValue(hSubKey As Long, _
                             sKeyName As String) As String

   Dim lpValue As String   'name of the value to retrieve
   Dim lpcbData As Long    'length of the retrieved value

  'if valid
   If hSubKey <> 0 Then
     'determine the length of the
     'desired registry string
      If RegQueryValueEx(hSubKey, _
                         sKeyName, _
                         0, _
                         0, _
                         ByVal 0, _
                         lpcbData) = 0 Then
        'pad a string long enough to
        'accomdate the return value and
        'its terminating null
         lpValue = Space$(lpcbData + 1)
         lpcbData = Len(lpValue)
        'retrieve & return the value
         If RegQueryValueEx(hSubKey, _
                                  sKeyName, _
                                  0&, _
                                  0&, _
                                  ByVal lpValue, _
                                  lpcbData) = ERROR_SUCCESS Then
            GetRegValue = TrimNull(lpValue)
         End If  'RegQueryValueEx
      End If  'RegQueryValueEx
   End If  'hSubKey

End Function

Public Function TrimNull(startstr As String) As String

   TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
End Function

Save the project and move on to Step 3: Building the Notification Form


PayPal Link
Make payments with PayPal - it's fast, free and secure!


Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy


Hit Counter