Public Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
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
Private Declare Function ShowWindow Lib "user32" (ByVal Hwnd As Long, ByVal nCmdShow As Long) As Long
Private Const SW_HIDE = 0 '隐藏窗口
Private Const SW_SHOW = 5 '显示窗口
Private Const GWL_EXSTYLE = (-20) '设置一个新的扩展窗口样式
Private Const WS_EX_LAYERED = &H80000 '窗口必须要具有此扩展属性才能设置透明
Private Const LWA_ALPHA = &H2 '使用bAlpha作为透明度
Private Const LWA_COLORKEY = &H1 '使用crKey作为透明色
'窗口透明模式常量枚举
Public Enum conWindowTransMode
conTransNone = 0 '清除窗口透明样式,之后必须刷新窗口
conTransAlpha = 1 '窗口整体以指定透明度透明
conTransColor = 2 '窗口中指定颜色完全透明
conTransAlphaAndColor = 3 '窗口中指定颜色完全透明,其它地方以指定透明度透明
End Enum
Public Const conMsgBoxTitle As String = "驾驶人科目一(汽车类)模拟考试系统"
'==========================================================================================================================
'-函数名称: SetWindowTrans
'-功能描述: 设置窗口透明
'-输入参数: hwnd 窗口句柄
' Color 要设为透明的颜色,Mode参数为1(或其它非0值)时有效
' Alpha 窗口透明度,Mode参数设0时有效
' Mode 透明模式
'-返回参数: 返回true表示函数调用成功,否则调用失败
'-使用示例: SetWindowTrans Me.hwnd
'-相关调用: apiGetWindowLong(), apiSetWindowLong(), apiSetLayeredWindowAttributes()
'-使用注意: 直接对MDI窗口中的非弹出式子窗口使用无效,将hwnd参数设为MDI父窗口的句柄时,效果作用于父窗口及其所有非弹
' 出式子窗口
'-兼 容 性: Windows 2000以上系统
'-参考资料:
'-作 者: 红尘如烟
'-创建日期; 2009-3-10
'==========================================================================================================================
Public Function SetWindowTrans(Hwnd As Long, Optional Color As Long = 0, Optional Alpha As Byte = 230, _
Optional Mode As conWindowTransMode = conTransAlpha) As Boolean
On Error GoTo Err_SetWindowTrans
Dim rtn As Long
Dim Flags As Long
If Mode = conTransNone Then
rtn = 0
Else
rtn = GetWindowLong(Hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
End If
Call SetWindowLong(Hwnd, GWL_EXSTYLE, rtn)
Select Case Mode
Case conTransAlpha
Flags = LWA_ALPHA
Case conTransColor
Flags = LWA_COLORKEY
Case conTransAlphaAndColor
Flags = LWA_ALPHA Or LWA_COLORKEY
Case Else
Flags = 0
End Select
SetWindowTrans = CBool(SetLayeredWindowAttributes(Hwnd, Color, Alpha, Flags))
If rtn = 0 Then
ShowWindow Hwnd, SW_HIDE
ShowWindow Hwnd, SW_SHOW
End If
Exit_SetWindowTrans:
Exit Function
Err_SetWindowTrans:
MsgBox "#" & Err & vbCr & Err.Description, vbCritical, conMsgBoxTitle
Resume Exit_SetWindowTrans
End Function