zsx's Old Blog

黑历史逐步隐藏中_(:з」∠)_仅保留部分可能有些价值的文章,并不保证将来的可访问性。

VB实现Aero效果(for Vista、2008、7)

'Module1代码
 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   
'[DllImport("dwmapi.dll", PreserveSig=false)]    
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  
     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
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

5750533774199341025

控制面板
您好,欢迎到访网站!
  查看权限
Google Adsense
文章归档
站点信息
  • 文章总数:259
  • 页面总数:10
  • 分类总数:17
  • 标签总数:136
  • 评论总数:1644
  • 浏览总数:216659

Powered By Z-BlogPHP 1.5.1 Zero

闽ICP备15006942号   闽公网安备 35010302000147号