屏幕右下角浮出式小消息窗口,透明式消失
来源:互联网 发布:网络视频会议软件 编辑:程序博客网 时间:2024/05/05 10:32
'任务栏高度[此部分相关代码转载自 枕善居]
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
- 屏幕右下角浮出式小消息窗口,透明式消失
- 右下角浮出窗口
- 超酷右下角浮出窗口《修订版》--关闭时缓慢下降并消失
- winform 屏幕右下角弹出消息框,自动消失
- winform C#屏幕右下角弹出消息框,自动消失
- winform C#屏幕右下角弹出消息框并自动消失
- 一款新浪博客右下角浮出窗口源代码
- 网页右下角向上浮出一个消息框
- 屏幕右下角消息提示
- 窗口右下角消息弹出框
- MFC实现类似qq的在屏幕右下角动画显示消息窗口
- MFC实现类似qq的在屏幕右下角动画显示消息窗口 .
- 弹出右下角JS小窗口
- 右下角弹出窗口小示例
- Winform 屏幕右下角弹出提示窗口
- Winform 屏幕右下角弹出提示窗口
- javascript实现屏幕右下角消息提示框
- 从右下角缓缓升起的小窗口
- 在动荡中为研制我国大型飞机奋斗了近20年,最后还是不能实现抱负。到后来他也悟出了中国要发展大民机决不是单凭技术人员的赤忱之心所能办到,还要取决于国家意志,终因积劳成疾,壮志未酬而英年早逝。
- 创造一个完全不可能重复的整数(以更新公式说明部分)
- 在整天的忙忙碌碌中,我们是否已经被时代淘汰了?
- J2ME 进度条与线程化模型实例解析
- 他只能作先驱者,不能享受胜利,这是中华人民共和国的悲哀!
- 屏幕右下角浮出式小消息窗口,透明式消失
- 笑死不犯法!中国惠普客服笑话
- TNS-03505: Failed to resolve name --不小心的错误!
- 如何判定你是否具备有学习Linux的素质
- IT程序员35岁后的三条活路
- 中达电通CT500-RD白色款路由设置办法
- SonyEricsson_K700模拟器中文补丁
- jforum 运行于 WAS6的研究.....进行中
- 告慰马凤山同志的在天之灵