`

VB 实现屏幕右下角浮出式消息窗口,透明淡出效果。

    博客分类:
  • vb
VB 
阅读更多
'任务栏高度[此部分相关代码转载自 枕善居]
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 Const
SPI_GETWORKAREA = 48

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

'透明
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function
GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function
SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Const
WS_EX_LAYERED = &H80000
Const GWL_EXSTYLE = (-20)
Const LWA_ALPHA = &H2
Const LWA_COLORKEY = &H1

'延迟
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds 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 Const
HWND_BOTTOM = 1
Private Const HWND_BROADCAST = &HFFFF&
Private Const HWND_DESKTOP = 0
Private Const HWND_NOTOPMOST = -2
Private Const HWND_TOP = 0
Private Const HWND_TOPMOST = -1

'可见区域
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function
SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function
DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Dim
MyRect As Long
Dim
MyRgn As Long

Dim
X1 As Integer, Y1 As Integer
Dim
X2 As Integer, Y2 As Integer
Dim
OpenSpeed As Integer
Dim
CloseSpeed As Integer

Dim
WiteLong As Integer


Private Sub
Form_Load()
'------------------------------------------------------------------
OpenSpeed = 10 '出现时速度
CloseSpeed = 10 '关闭时淡出的速度
Timer1.Interval = 10 '出现时显示平滑度
WiteLong = 30 '关闭前等待时间(秒),为0则不会自动关闭
'------------------------------------------------------------------

'计算任务栏高
Dim lRes As Long
Dim
rectVal As RECT
Dim TaskbarHeight As Integer

lRes = SystemParametersInfo(SPI_GETWORKAREA, 0, rectVal, 0)
TaskbarHeight = Screen.Height - rectVal.Bottom * Screen.TwipsPerPixelY

'确定位置
Me.Move Screen.Width * 0.75, Screen.Height * 0.75 - TaskbarHeight, _
Screen.Width \
4, Screen.Height \ 4

'永在最前
SetWindowPos Me.hWnd, HWND_TOPMOST, Me.Left \ Screen.TwipsPerPixelX, Me.Top \ Screen.TwipsPerPixelY, Me.Width, Me.Height, 1

'为遮蔽窗体计算坐标
X1 = 0
Y1 = Me.Width \ Screen.TwipsPerPixelX

X2 = Me.Width \ Screen.TwipsPerPixelX
Y2 = Me.Height \ Screen.TwipsPerPixelY -
1

'遮蔽部分窗体为不可见
MyRect = CreateRectRgn(X1, Y1, X2, Y2)
MyRgn = SetWindowRgn(Me.hWnd, MyRect,
True)
End Sub

Private Sub
Form_Unload(Cancel As Integer)
Call CloseMe(1) '以什么样的方式关闭自己,有 1-淡出 和 2-收缩 可选
Call DeleteObject(MyRect)
End Sub


Private Sub
Timer1_Timer()
Y2 = Y2 - OpenSpeed

If Y2 <= 0 Then
MyRect = CreateRectRgn(0, 0, Me.Width \ Screen.TwipsPerPixelX, Y2)
MyRgn = SetWindowRgn(Me.hWnd, MyRect,
True)

Timer1.Enabled =
False

'----------------------
If WiteLong <> 0 Then
Timer2.Interval = 1000
Timer2.Enabled = True
End If
End If

MyRect = CreateRectRgn(X1, Y1, X2, Y2)
MyRgn = SetWindowRgn(Me.hWnd, MyRect,
True)
End Sub

Private Sub
Timer2_Timer()
Static NL As Integer
NL = NL + 1

If NL >= WiteLong Then Unload Me

End Sub


'==============================================
'0 - 不使用卸载效果
'1 - 使用透明淡出效果
'2 - 使用收缩效果
'==============================================
Private Sub CloseMe(Optional N As Integer = 1)
Select Case N
Case 0
Exit Sub
Case
1
Dim rtn As Long

rtn = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
rtn = rtn
Or WS_EX_LAYERED
SetWindowLong Me.hWnd, GWL_EXSTYLE, rtn

For I = 255 To 10 Step -10
SetLayeredWindowAttributes Me.hWnd, 0, I, LWA_ALPHA
DoEvents
Sleep CloseSpeed
Next I
Case 2
While Y2 < (Me.Height / Screen.TwipsPerPixelY)
Y2 = Y2 + OpenSpeed
MyRect = CreateRectRgn(X1, Y1, X2, Y2)
MyRgn = SetWindowRgn(Me.hWnd, MyRect,
True)
Sleep OpenSpeed
Wend
Case Else

End Select
End Sub

 

分享到:
评论

相关推荐

    VB仿QQ屏幕右下角弹消息窗口

    【VB仿QQ屏幕右下角弹消息窗口】是一种在Visual Basic (VB)环境中实现的编程技术,用于模拟QQ软件在用户屏幕右下角显示消息通知的功能。这种技术通常用于开发具有即时通讯功能的应用程序,以便在有新消息或事件发生...

    VB 6 窗口右下角气泡式弹出提示源码.rar

    VB弹出右下角窗口的例子,是一个模仿以前MSN风格的VB 弹出式气泡提示,弹出后显示在屏幕的右下角窗口,可自定义右下角的气泡提示的样式、文字等,右下角窗口渐变色显示,设置窗口功能很多,不一一介绍了,截图只是...

    vb仿qq的右下角信息提示框源码 vb提示框

    要让提示框出现在屏幕右下角,我们需要获取屏幕的分辨率,并计算出合适的位置。可以使用Screen对象的Width和Height属性来获取屏幕尺寸,然后根据需要设置Form的Left和Top属性。 在设计提示框的外观时,可以使用...

    VB 窗口淡入淡出效果示例

    在VB(Visual Basic)编程中,窗口淡入淡出效果是一种常见的用户界面增强技术,它可以使应用程序的窗口在显示或隐藏时平滑过渡,提升用户体验。这种效果是通过改变窗口的透明度来实现的,逐渐增加或减少窗口的不透明...

    vb托盘气球提示,右下角有提示框框

    这种提示通常以一个小图标的形式出现在屏幕右下角的任务栏附近,当鼠标悬停或触发特定事件时,会弹出一个小型的信息窗口,即“气球提示”。 创建托盘气球提示涉及到以下几个关键知识点: 1. **创建系统托盘图标**:...

    vb.net 窗口淡入淡出效果

    在VB.NET中实现窗口的淡入淡出效果是一项常见的任务,可以增强用户的交互体验。淡入淡出效果是指窗口在显示或隐藏时逐渐显现或消失,给人一种平滑过渡的感觉。以下将详细介绍如何在VB.NET环境下,特别是在VB2005中...

    vb代码---仿MSN右下角弹出窗口(文件带dll)

    本主题探讨的是如何利用VB代码实现一个类似于MSN(Microsoft Messenger)右下角弹出窗口的效果。MSN的这种通知窗口是即时通讯软件中常见的一种设计,用于向用户展示消息或提醒,而无需打开主应用窗口。 首先,我们...

    VB淡入淡出窗口动画的效果实现.rar

    这个"VB淡入淡出窗口动画的效果实现.rar"压缩包提供了一个实现这一效果的示例代码。 首先,淡入淡出效果是通过调整窗口的透明度来实现的。在VB中,我们可以使用API函数或者自定义控件来控制窗口的Alpha值,Alpha值...

    C# winform 右下角弹出消息框

    C# WinForm 消息提示功能,类似QQ的消息提醒样式,可定时关闭,消息框弹出从下往上,关闭从上往下,有动画效果。当用户鼠标停放在提示框上时,自动关闭功能停止 ,当移走鼠标时,重新开始自动关闭功能 。有C#源码;...

    VB 精仿QQ右下角弹出新闻功能 提示窗口

    VB 精仿QQ右下角弹出新闻功能 用VB语言编写的QQ右下角弹出新闻功能,程序会自动检测QQ是否允许弹出,如果不允许则本程序不会弹出!可远程更改QQ新闻的内容,有延迟效果,程序显示一定时间将自动退出。  尚需完美的...

    VB源码右下角显示托盘程序.rar

    用VB实现屏幕右下角的托盘图标,一个显示托盘的气泡提示程序源码,鼠标放在托盘的图标上,会弹出像Windows XP系统中的托盘提示,一个很漂亮的气泡文字,鼠标移走后会自动消失,在各大VB开发的应用程序中,似乎你都...

    在屏幕右下角弹出广告

    标题中的“在屏幕右下角弹出广告”指的是在用户浏览网页时,广告会在计算机屏幕的右下角突然出现的一种广告展示方式。这种方式通常利用JavaScript或者其他前端技术来实现,以吸引用户的注意力。广告可能以弹窗、浮动...

    模仿QQ消息提示右下角弹出窗口提示代码源文件4种不同方式

    "模仿QQ消息提示右下角弹出窗口提示代码源文件4种不同方式"是一个专注于实现这一功能的资源,它提供了多种实现此类通知的技术手段。下面将详细阐述这四种不同的实现方式以及它们在实际应用中的价值。 首先,右下角...

    易语言模拟qq右下角提示框

    在这个“易语言模拟qq右下角提示框”项目中,我们将探讨如何使用易语言来实现类似QQ软件右下角弹出提示框的功能。 首先,我们需要了解QQ右下角提示框的基本特性。这种提示框通常会出现在屏幕右下角,显示一些简短的...

    VB滑出右下角系统信息【带网络】

    【VB滑出右下角系统信息【带网络】】是一个基于Visual Basic(VB)编程语言设计的应用程序,它能够在电脑屏幕的右下角滑出一个窗口,模仿QQ消息提示的效果。这种技术通常用于创建系统通知或者提醒用户某些信息。下面...

    ASP.NET版 仿QQ MSN 右下角 弹出窗口 提示小窗口 控件

    ASP.NET版 仿QQ MSN 右下角 弹出窗口 提示小窗口 控件仿MSN右下角的弹出窗口控件,实际上不仅仅局限于右下角,网页的其它地方都可以用,这是Asp.net修正版。  源代码中包括C#、VB.net两种代码的示例,以及控件源...

    VB实现图片透明动画渐变淡出效果.rar

    在VB6.0中,开发人员经常需要处理图形和图像,比如实现动态的视觉效果,如图片的透明渐变淡出。本项目提供了一个实例,展示了如何利用AlphaBlend函数来创建这种效果。AlphaBlend是一种高级的图形操作技术,它允许...

    如何实现淡入淡出效果Visual Basic6.0程序,VB6.0源代码

    在Visual Basic 6.0(VB6)中实现淡入淡出效果主要涉及到对图形界面控件的透明度控制和定时器组件的应用。淡入淡出效果通常用于窗口或者控件的显示和隐藏,给用户带来平滑的视觉体验。下面我们将详细探讨如何通过VB...

    VB.NET窗口淡入淡出

    在VB.NET编程环境中,我们可以创建具有视觉效果的窗口应用程序,比如实现窗口的淡入淡出效果。这将为用户带来更优雅、更吸引人的交互体验。"VB.NET窗口淡入淡出"是一个关于如何在VB.NET窗体应用中实现这种特效的主题...

    半透明窗口 vb vb vb

    在VB(Visual Basic)编程中,创建半透明窗口是一项常用的技术,可以为应用程序带来更为现代和吸引人的视觉效果。半透明窗口允许用户看到窗口背后的元素,同时仍然保持窗口的可见性和交互性。以下是对这个主题的详细...

Global site tag (gtag.js) - Google Analytics