“SetLayeredWindowAttributes函数”这样的效果不可能把办到!
这是受Win9X对窗口绘制的方式的限制!!!
做出比较接近的效果:
http://www.csdn.net/expert/topic/610/610482.xml?temp=.8218195
这是受Win9X对窗口绘制的方式的限制!!!
做出比较接近的效果:
http://www.csdn.net/expert/topic/610/610482.xml?temp=.8218195
Option Explicit
Dim cy As Single
Dim cx As Single
Dim mdown As Boolean
Dim tops, lefts
Private Sub Command1_Click()
Me.Cls
End SubPrivate Sub Form_DblClick()
End
End SubPrivate Sub Form_Load()
aplhi Me
End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
mdown = True
cx = X: cy = Y
Me.ClsEnd SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If mdown Then
Move Left + (X - cx), Top + (Y - cy)
End IfEnd SubPrivate Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i
mdown = False
tops = Me.Top: lefts = Me.Left
Unload Me
For i = 0 To 500000 Step 0.1
Next i
Me.Left = lefts: Me.Top = tops
Me.Show
aplhi Me
End Sub模块里面的代码输入以下
Option ExplicitPublic Type rBlendProps
tBlendOp As Byte
tBlendOptions As Byte
tBlendAmount As Byte
tAlphaType As Byte
End Type
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As LongPublic Declare Function AlphaBlend Lib "msimg32" (ByVal hDestDC 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 widthSrc As Long, _
ByVal heightSrc As Long, ByVal blendFunct As Long) As BooleanPublic Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As LongPublic Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End TypePublic Sub aplhi(frml)
Dim LrProps As rBlendProps
Dim LnBlendPtr As Long
Dim WinRect As RECT
Dim DskHdc As LongDskHdc = GetWindowDC(GetDesktopWindow())
GetWindowRect frml.hwnd, WinRect
'MsgBox WinRect.Left & WinRect.Top
'MsgBox DskHdc
LrProps.tBlendAmount = 150
CopyMemory LnBlendPtr, LrProps, 4
AlphaBlend frml.hDC, 0, 0, 640, 480, DskHdc, WinRect.Left, WinRect.Top, 640, 480, LnBlendPtr
frml.RefreshEnd Sub