|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
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. |
|
|
|
|||||
|
|||||
|
|||||
Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved. |