用VB实现QQ一样的菜单(半透明窗口)

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 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() ' '''''窗口半透明代码开始      Dim  rtn  As   Long     rtn  =  GetWindowLong(hwnd, GWL_EXSTYLE)    rtn  =  rtn  Or  WS_EX_LAYERED    SetWindowLong hwnd, GWL_EXSTYLE, rtn    SetLayeredWindowAttributes hwnd,  0 ,  180 , LWA_ALPHA  '   透明度为 0--255 之间的数 ' '''''窗口半透明代码结束 With  Me.Width  =   1200   +   155 .Height  =   4860   +   355 .BorderStyle  =   3 .ScaleMode  =   1 .BackColor  =   & H80C0FF.FillStyle  =   1 End   With With  Picture1.Width  =   1200   +   60 .Height  =   4860 End   With Dim  i  As   Integer For  i  =  Command1.Count  -   1   To   0  Step  - 1 With  Command1(i).Width  =   1200 .Height  =   300 .Top  =  Picture1.ScaleHeight  -   300   *  (Command1.Count  -  i).Left  =   0 .Caption  =   " 分组  "   &  i  +   1 End   With Next  iCommand1( 0 ).Top  =   0 End Sub Private   Sub  Command1_Click(Index  As   Integer )Picture1.SetFocus ' 把焦点给Picture1是为了不让按钮出现难看的黑框 Dim  i  As   Integer For  i  =   1   To  IndexCommand1(i).Top  =   300   *  i Next  i For  i  =  Command1.Count  -   1   To  Index  +   1  Step  - 1 Command1(i).Top  =  Picture1.ScaleHeight  -   300   *  (Command1.Count  -  i) Next  i End Sub