'模块代码
Public Type MARGINS
m_Left As Long
m_Right As Long
m_Top As Long
m_Button As Long
End Type
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Const LWA_COLORKEY = &H1
Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_LAYERED = &H80000
Dim Inied As Boolean
Public Declare Function DwmExtendFrameIntoClientArea Lib "dwmapi.dll" (ByVal hwnd As Long, margin As MARGINS) As Long
Public Declare Function DwmIsCompositionEnabled Lib "dwmapi.dll" (ByRef enabledptr As Long) As Long
Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Public Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function SetLayeredWindowAttributesByColor Lib "user32" Alias "SetLayeredWindowAttributes" (ByVal hwnd As Long, ByVal crey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
'Form1代码
Dim m_transparencyKey As Long
Private Sub Form_Load()
m_transparencyKey = RGB(255, 255, 1)
SetWindowLong Me.hwnd, GWL_EXSTYLE, GetWindowLong(Me.hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED
SetLayeredWindowAttributesByColor Me.hwnd, m_transparencyKey, 0, LWA_COLORKEY
On Error GoTo ern
Dim mg As MARGINS, en As Long
mg.m_Left = -1
mg.m_Button = -1
mg.m_Right = -1
mg.m_Top = -1
DwmIsCompositionEnabled en
If en Then
DwmExtendFrameIntoClientArea Me.hwnd, mg
End If
Exit Sub
ern:
MsgBox Err.Description
End Sub
Private Sub Form_Paint()
Dim hBrush As Long, m_Rect As RECT, hBrushOld As Long
hBrush = CreateSolidBrush(m_transparencyKey)
hBrushOld = SelectObject(Me.hdc, hBrush)
GetClientRect Me.hwnd, m_Rect
FillRect Me.hdc, m_Rect, hBrush
SelectObject Me.hdc, hBrushOld
DeleteObject hBrush
End Sub