VB窗体透明问题！

Posted 2023-03-13

可以透明窗体、控件不透明、就是不能调节透明度、要么透明度0、要么不透明、不可以调节透明度、但是有的游戏在弹出另一个窗口的时候却是半透明的、而控件不透明、这些是怎么做到的、是动画框么？？？

窗体透明，控件不透明的代码：
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 SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1
Private Sub Form_Load()
Me.BackColor = &HFF0000
Dim rtn As Long
Dim BorderStyler
BorderStyler = 0
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hwnd, &HFF0000, 0, LWA_COLORKEY
End Sub

窗体逐渐变透明：
'添加一个PicturebBox，依它为容器添加一个shape，背景色设为蓝色
'添加一个时钟控件
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 SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Const WS_EX_LAYERED = &H80000
Const GWL_EXSTYLE = (-20)
Const LWA_ALPHA = &H2
Const LWA_COLORKEY = &H1
Dim tmd As Long
Private Sub Form_Load()
Show
Shape1.BackColor = &H80000002
Shape1.BackStyle = 1
tmd = 255
Timer1.Interval = 50
Shape1.Width = Picture1.Width
SetWindowLong hwnd, GWL_EXSTYLE, WS_EX_LAYERED
SetLayeredWindowAttributes hwnd, 0, tmd, LWA_ALPHA '越少越透明，限制0-255
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
tmd = tmd - 1
SetLayeredWindowAttributes hwnd, 0, tmd, LWA_ALPHA
Shape1.Width = Shape1.Width - Picture1.Width / 255
If tmd < 0 Then
Timer1.Enabled = False
MsgBox "OK!"
End If
End Sub 参考技术A 'form上有Command1, command2两个Button并事先设定form之BorderStyle = 0

Option Explicit
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 GWL_EXSTYLE = (-20)
Const WS_EX_TRANSPARENT = &H20&
Private PreValue As Long

Private Sub Command2_Click() '还原变成不透明
Call SetWindowLong(Me.hwnd, GWL_EXSTYLE, PreValue)
Me.Hide
Me.Show
End Sub

Private Sub Form_Load()
Dim i As Long

i = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
'变成透明的Form
PreValue = SetWindowLong(Me.hwnd, GWL_EXSTYLE, i Or WS_EX_TRANSPARENT)
Me.Show
DoEvents
Command1.Refresh '令Command1可见
Command2.Refresh '令Command2可见
End Sub 参考技术B SetLayeredWindowAttributes
Me.hwnd,
0,
150,
LWA_ALPHA
'150为透明度(0-255)
不能让控件单独透明。只能随你的窗体半透明
SetLayeredWindowAttributes
Me.hwnd,
&Hff00ff,
0,
&H1
这样会让是＆HFF00FF(VB常数vbMagenta的值)一样颜色，都透明
你可以试试以下代码
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
SetLayeredWindowAttributes
Lib
"user32"
(ByVal
hwnd
As
Long,
ByVal
crKey
As
Long,
ByVal
bAlpha
As
Byte,
ByVal
dwFlags
As
Long)
As
Long
Const
WS_EX_LAYERED
=
&H80000
Const
GWL_EXSTYLE
=
(-20)
Const
LWA_ALPHA
=
&H2
'Const
LWA_COLORKEY
=
&H1
Private
Sub
Form_Load()
me.backcolor=&Hff00ff
SetWindowLong
Me.hwnd,
GWL_EXSTYLE,
WS_EX_LAYERED
SetLayeredWindowAttributes
Me.hwnd,
&HFF00FF,
0,
&H1
End
Sub