[VBnet Projects] TransparentBlt: Simulating Microsoft's 'Windows Messenger' Notifications

	Visual Basic Projects TransparentBlt: Simulating Microsoft's 'Windows Messenger' Notifications Step 3: Building the Notification 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

Prerequisites

None.

This form is also pretty straightforward in design .. requiring only a timer (Timer1) and a label (Label1). The label is shown as yellow in the illustration - you want to set its BackStyle to transparent. Be sure to name this form frmNotify.

See Step 1: Introduction and Layout for explanations of properties that must be set for this form.

BAS Code

None.

Form Code: frmNotify - the notification form

frmNotify needs only a label (Label1) positioned anywhere, and a timer. 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.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private msHangDuration As Long
Private msShowDuration As Long
Private msHideDuration As Long

Private twipsx As Long
Private twipsy As Long

Private Const notify_mode_show = 1
Private Const notify_mode_wait = 2
Private Const notify_mode_hide = 3
Private notify_mode As Long

Private Const HWND_TOPMOST = -1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOACTIVATE = &H10
Private Const SW_SHOWNA = 8
Private Const SPI_GETWORKAREA = 48
Private Const SND_ASYNC = &H1          'play asynchronously
Private Const SND_FILENAME = &H20000   'sound is file name
Private Const GRADIENT_FILL_RECT_V = &H1

Private Type BITMAP
   bmType As Long
   bmWidth As Long
   bmHeight As Long
   bmWidthBytes As Long
   bmPlanes As Integer
   bmBitsPixel As Integer
   bmBits As Long
End Type

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

Private Type TRIVERTEX
   X As Long
   Y As Long
   Red As Integer    'ushort value
   Green As Integer  'ushort value
   Blue As Integer   'ushort value
   Alpha As Integer  'ushort value
End Type

Private Type GRADIENT_RECT
   UpperLeft As Long  
   LowerRight As Long
End Type

Private Declare Function ShowWindow Lib "user32" _
  (ByVal hwnd As Long, _
   ByVal nCmdShow As Long) As Long
   
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
   
Private Declare Function SystemParametersInfo Lib "user32" _
   Alias "SystemParametersInfoA" _
  (ByVal uAction As Long, _
   ByVal uParam As Long, _
   ByRef lpvParam As Any, _
   ByVal fuWinIni As Long) As Long
   
Private Declare Function PlaySound Lib "winmm.dll" _
   Alias "PlaySoundA" _
  (ByVal lpszName As String, _
   ByVal hModule As Long, _
   ByVal dwFlags As Long) As Long
   
Private Declare Function GradientFill Lib "msimg32" _
  (ByVal hdc As Long, _
   pVertex As TRIVERTEX, _
   ByVal dwNumVertex As Long, _
   pMesh As GRADIENT_RECT, _
   ByVal dwNumMesh As Long, _
   ByVal dwMode As Long) As Long
   
Private Declare Function CreateCompatibleDC Lib "gdi32" _
  (ByVal hdc As Long) As Long
   
Private Declare Function DeleteDC Lib "gdi32" _
  (ByVal hdc As Long) As Long
   
Private Declare Function GetObject Lib "gdi32" _
   Alias "GetObjectA" _
  (ByVal hObject As Long, _
   ByVal nCount As Long, _
   lpObject As Any) As Long
   
Private Declare Function SelectObject Lib "gdi32" _
  (ByVal hdc As Long, _
   ByVal hObject As Long) As Long
   
Private Declare Function DeleteObject Lib "gdi32" _
  (ByVal hObject As Long) As Long
   
Private Declare Function TransparentBlt Lib "msimg32.dll" _
  (ByVal hdc As Long, _
   ByVal X As Long, _
   ByVal Y As Long, _
   ByVal nWidth As Long, _
   ByVal nHeight As Long, _
   ByVal hSrcDC As Long, _
   ByVal xSrc As Long, _
   ByVal ySrc As Long, _
   ByVal nSrcWidth As Long, _
   ByVal nSrcHeight As Long, _
   ByVal crTransparent As Long) As Boolean
   
Private Declare Function SetCapture Lib "user32" _
  (ByVal hwnd As Long) As Long
  
Private Declare Function GetCapture Lib "user32" () As Long

Private Declare Function ReleaseCapture Lib "user32" () As Long


Private Sub Form_Initialize()
    
  'position the elements and
  'set some initial settings
   twipsx = Screen.TwipsPerPixelX
   twipsy = Screen.TwipsPerPixelY
   
   Me.KeyPreview = True
   Me.AutoRedraw = True
   
   With Label1
      .Move 4 * twipsx, _
            40 * twipsx, _
            Me.ScaleWidth - (7 * twipsx), _
            Me.ScaleHeight - (44 * twipsx)
            
      .AutoSize = False
      .WordWrap = False
      .BackStyle = vbTransparent
      .Alignment = vbCenter
   End With
   
End Sub


Private Sub Form_Click()

   Timer1.Enabled = False
   Call ReleaseCapture
   Unload Me

End Sub


Private Sub Form_KeyPress(KeyAscii As Integer)

   If KeyAscii = vbKeyEscape Then
      Unload Me
   End If
End Sub


Private Sub Form_MouseMove(Button As Integer, _
                           Shift As Integer, _
                           X As Single, Y As Single)

  'trap the mouse movements while
  'in the form
   If GetCapture() = Me.hwnd Then
      If X < 0 Or X > Me.Width Or Y < 0 Or Y > Me.Height Then
         Call ReleaseCapture
         Label1.ForeColor = &H80000012
         Label1.Font.Underline = False
      End If
   Else
      Label1.ForeColor = RGB(0, 0, 255)
      Label1.Font.Underline = True
      SetCapture Me.hwnd
   End If
    
End Sub


Private Sub Form_MouseUp(Button As Integer, _
                         Shift As Integer, _
                         X As Single, Y As Single)

   Timer1.Enabled = False
   Call ReleaseCapture
   Unload Me

End Sub

Private Sub Form_Unload(Cancel As Integer)

   Set frmNotify = Nothing
    
End Sub


Private Sub Label1_MouseMove(Button As Integer, _
                             Shift As Integer, _
                             X As Single, Y As Single)
    
  Call Form_MouseMove(Button, Shift, X, Y)
    
End Sub

Private Sub Timer1_Timer()

   Select Case notify_mode
         
      Case notify_mode_show:
   
         If Me.Height + 4 * twipsx < 1800 Then
            Me.Height = Me.Height + 4 * twipsx
         Else
            
            Me.Height = 1800
            
            Timer1.Enabled = False
            Timer1.Interval = msHangDuration
            notify_mode = notify_mode_wait
            Timer1.Enabled = True
            
         End If
         
      Case notify_mode_wait:
   
            Timer1.Enabled = False
            Timer1.Interval = msHideDuration
            notify_mode = notify_mode_hide
            Timer1.Enabled = True
         
      Case notify_mode_hide:
      
         If (Me.Height - _
            (Me.Height - Me.ScaleHeight * twipsx)) - 4 * _
             twipsx > _
            (Me.Height - Me.ScaleHeight * twipsx) Then
         
            Me.Height = Me.Height - 4 * twipsx
         
         Else
            Me.Height = 0
            notify_mode = 0
            Timer1.Enabled = False
            Unload Me
         End If
   
   End Select

End Sub


Private Sub DrawGradientBackground(Colour1 As Long, Colour2 As Long)
    
   Dim vert(0 To 1) As TRIVERTEX
   Dim grc As GRADIENT_RECT
   
  'gradient start colour
   With vert(0)
      .X = 0
      .Y = 0
      .Red = LongToSignedShort(CLng((Colour1 And &HFF&) * 256))
      .Green = LongToSignedShort(CLng(((Colour1 And &HFF00&) \ &H100&) * 256))
      .Blue = LongToSignedShort(CLng(((Colour1 And &HFF0000) \ &H10000) * 256))
      .Alpha = 0
   End With
   
   
  'gradient end colour
   With vert(1)
      .X = Me.ScaleWidth \ twipsx
      .Y = Me.ScaleHeight \ twipsx
      .Red = LongToSignedShort(CLng((Colour2 And &HFF&) * 256))
      .Green = LongToSignedShort(CLng(((Colour2 And &HFF00&) \ &H100&) * 256))
      .Blue = LongToSignedShort(CLng(((Colour2 And &HFF0000) \ &H10000) * 256))
      .Alpha = 0
   End With
   
   grc.UpperLeft = 0
   grc.LowerRight = 1
   
   GradientFill frmNotify.hdc, vert(0), 2, grc, 1, GRADIENT_FILL_RECT_V

End Sub


Private Sub DrawIconPicture(img As StdPicture, _
                            ImageX As Long, _
                            ImageY As Long, _
                            ImgTransColour As Long)
    
   Dim hbmDc As Long
   Dim hBmp As Long
   Dim hBmpOld As Long
   Dim bmp As BITMAP

  'if the picture is a bitmap...
   If img.Type = vbPicTypeBitmap Then
    
      hBmp = img.Handle
      
     'create a memory device context
      hbmDc = CreateCompatibleDC(0&)
      
      If hbmDc <> 0 Then
         
        'select the bitmap into the context
         hBmpOld = SelectObject(hbmDc, hBmp)
   
        'retrieve information for the
        'specified graphics object
         If GetObject(hBmp, Len(bmp), bmp) <> 0 Then
      
           'draw the bitmap with the
           'specified transparency colour
            Call TransparentBlt(Me.hdc, _
                                ImageX, _
                                ImageY, _
                                bmp.bmWidth, _
                                bmp.bmHeight, _
                                hbmDc, _
                                0, 0, _
                                bmp.bmWidth, _
                                bmp.bmHeight, _
                                ImgTransColour)
         
         End If  'GetObject
      
         Call SelectObject(hbmDc, hBmpOld)
      
         DeleteObject hBmpOld
         DeleteDC hbmDc
      
      End If  'hbmDc
      
   ElseIf img.Type = vbPicTypeIcon Then
   
     'if the picture is an icon
      Call Me.PaintPicture(img, ImageX, ImageY)
      
   End If  'img.Type        

End Sub


Private Function LongToSignedShort(dwUnsigned As Long) As Integer
    
  'convert from long to signed short
   If dwUnsigned < 32768 Then
      LongToSignedShort = CInt(dwUnsigned)
   Else
      LongToSignedShort = CInt(dwUnsigned - &H10000)
   End If
    
End Function


Public Sub ShowMessage(sMsg As String, _
                       Optional img As StdPicture, _
                       Optional ImageX As Long = 0, _
                       Optional ImageY As Long = 0, _
                       Optional BgColour1 As Long = &HFFFFFF, _
                       Optional BgColour2 As Long = &HFFFFFF, _
                       Optional ImgTransColour As Long = &HFFFFFF, _
                       Optional msShowTime As Long = 50, _
                       Optional msHangTime As Long = 4000, _
                       Optional msHideTime As Long = 50, _
                       Optional bPlacement As Boolean = False, _
                       Optional sSound As String)
    
   Dim rc As RECT
   
  'ensure the notification window
  'is not already visible
   If Me.Visible = False Then
      
     'clear form
      Me.Cls
   
     'draw gradient background
      Call DrawGradientBackground(BgColour1, BgColour2)
       
     'draw picture
      If Not img Is Nothing Then
         Call DrawIconPicture(img, ImageX, ImageY, ImgTransColour)
      End If
       
     'set the sMsg
      Label1.Caption = sMsg
        
     'assign the intervals for the
     'respective timer events
      msShowDuration = msShowTime
      msHangDuration = msHangTime
      msHideDuration = msHideTime
    
     'ready to go, so first play
     'the notification sound
      If Len(sSound) > 0 Then
         Call PlaySound(sSound, ByVal 0&, SND_FILENAME Or SND_ASYNC)
      End If
      
     'retrieve the work area (the
     'available real estate available)
      Call SystemParametersInfo(SPI_GETWORKAREA, 0, rc, 0)
      
     'move the form in the upper-right corner
     'of the work area and set the form as
     '"topmost" (always on top). We pass
     'SWP_NOACTIVATE so the form does not
     'take focus from the active app. The
     'initial height of the form is 0
      Select Case bPlacement
      
         Case True
           'show top left
            Call SetWindowPos(Me.hwnd, _
                              HWND_TOPMOST, _
                              0, _
                              rc.Top, _
                             (Me.Width / twipsx), _
                              0, _
                              SWP_NOACTIVATE)
         Case False
           'show top right
            Call SetWindowPos(Me.hwnd, _
                              HWND_TOPMOST, _
                              rc.Right - (Me.Width / twipsx), _
                              rc.Top, _
                             (Me.Width / twipsx), _
                              0, _
                              SWP_NOACTIVATE)
      End Select
            
     'show the form without activating
      Call ShowWindow(Me.hwnd, SW_SHOWNA)
   
   
     'begin the animation by setting
     'the notify mode to notify_mode_show,
     'and setting the interval to the value
     'passed as msShowDuration, and starting
     'the timer
      notify_mode = notify_mode_show
      Timer1.Interval = msShowDuration
      Timer1.Enabled = True
   
   End If
    
End Sub

Comments

Save the project and run. Using the default settings the notification form should appear in the top-right of the screen.

PayPal Link