popmenu.bas

Usb Key loock vb soucrse code. ocx not found

Attribute VB_Name = "PopMenu"
Declare Function CreatePopupMenu Lib "user32" () As Long

Declare Function TrackPopupMenu Lib "user32" _
        (ByVal hMenu As Long, _
        ByVal wFlags As Long, _
        ByVal X As Long, _
        ByVal Y As Long, _
        ByVal nReserved As Long, _
        ByVal hwnd As Long, _
        ByVal lprc As Any) As Long
        
Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" _
        (ByVal hMenu As Long, _
        ByVal wFlags As Long, _
        ByVal wIDNewItem As Long, _
        ByVal lpNewItem As Any) As Long
        
Declare Function ModifyMenu Lib "user32" Alias "ModifyMenuA" _
        (ByVal hMenu As Long, _
        ByVal nPosition As Long, _
        ByVal wFlags As Long, _
        ByVal wIDNewItem As Long, _
        ByVal lpString As Any) As Long
        
Public Declare Function DestroyMenu Lib "user32" _
        (ByVal hMenu As Long) As Long
        
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

Declare Function BitBlt Lib "gdi32" _
        (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 dwRop As Long) As Long

Declare Function SetRect Lib "user32" (lpRect As RECT, _
        ByVal X1 As Long, _
        ByVal Y1 As Long, _
        ByVal X2 As Long, _
        ByVal Y2 As Long) As Long

Declare Function DrawCaption Lib "user32" _
        (ByVal hwnd As Long, _
        ByVal hdc As Long, _
        pcRect As RECT, _
        ByVal un As Long) As Long
        
Declare Function GetMenuItemRect Lib "user32" _
        (ByVal hwnd As Long, ByVal hMenu As Long, _
        ByVal uItem As Long, _
        lprcItem As RECT) As Long

Declare Function GetMenuItemCount Lib "user32" _
        (ByVal hMenu As Long) As Long

Declare Function GetPixel Lib "gdi32" _
        (ByVal hdc As Long, _
        ByVal X As Long, _
        ByVal Y As Long) As Long
        
Declare Function SetPixel Lib "gdi32" _
        (ByVal hdc As Long, _
        ByVal X As Long, _
        ByVal Y As Long, _
        ByVal crColor As Long) As Long

Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Type MEASUREITEMSTRUCT
    CtlType As Long
    CtlID As Long
    itemID As Long
    itemWidth As Long
    itemHeight As Long
    itemData As Long
End Type

Type DRAWITEMSTRUCT
    CtlType As Long
    CtlID As Long
    itemID As Long
    itemAction As Long
    itemState As Long
    hwndItem As Long
    hdc As Long
    rcItem As RECT
    itemData As Long
End Type

Public Type POINTAPI
    X As Long
    Y As Long
End Type

Const MF_APPEND = &H100&
Const MF_BYCOMMAND = &H0&
Const MF_BYPOSITION = &H400&
Const MF_DEFAULT = &H1000&
Const MF_DISABLED = &H2&
Const MF_ENABLED = &H0&
Const MF_GRAYED = &H1&
Const MF_MENUBARBREAK = &H20&
Const MF_OWNERDRAW = &H100&
Const MF_POPUP = &H10&
Const MF_REMOVE = &H1000&
Const MF_SEPARATOR = &H800&
Const MF_STRING = &H0&
Const MF_UNCHECKED = &H0&
Const MF_BITMAP = &H4&
Const MF_USECHECKBITMAPS = &H200&

Public Const MF_CHECKED = &H8&
Public Const MFT_RADIOCHECK = &H200&

Const TPM_RETURNCMD = &H100&

Const DC_GRADIENT = &H20
Const DC_ACTIVE = &H1
Const DC_ICON = &H4
Const DC_SMALLCAP = &H2
Const DC_TEXT = &H8

Public hMenu As Long
Public hSubmenu As Long
Public chkMnuFlags(2) As Long
Public MP As POINTAPI, sMenu As Long
Public mnuHeight As Single

Public Sub MeasureMenu(ByRef lp As Long) '汽狼 CAPTION蔼阑 扑诀皋春 哭率俊 弊扼捞带飘肺 焊咯淋
    

    
    Dim MIS As MEASUREITEMSTRUCT

    CopyMemory MIS, ByVal lp, Len(MIS)
        MIS.itemWidth = 5

    
 
    CopyMemory ByVal lp, MIS, Len(MIS)
    
End Sub

Public Sub DrawMenu(ByRef lp As Long)
    
    Dim DIS As DRAWITEMSTRUCT, rct As RECT, lRslt As Long
    
    CopyMemory DIS, ByVal lp, Len(DIS)
    
    With AppForm

        GetMenuItemRect .hwnd, hMenu, 1, rct
        mnuHeight = (rct.Bottom - rct.Top) * (GetMenuItemCount(hMenu) - GetMenuItemCount(hSubmenu) - 1)
   
        GetMenuItemRect .hwnd, hMenu, 3, rct
        mnuHeight = mnuHeight + (rct.Bottom - rct.Top) * 2
 
        SetRect rct, 0, 0, mnuHeight, 18
        
        
        DrawCaption .hwnd, .hdc, rct, DC_SMALLCAP Or DC_ACTIVE Or DC_TEXT Or DC_GRADIENT
        
        Dim X As Single, Y As Single
        Dim nColor As Long
        
      
        For X = 0 To mnuHeight
            For Y = 0 To 17
                nColor = GetPixel(.hdc, X, Y)
                SetPixel DIS.hdc, Y, mnuHeight - X, nColor
            Next Y
        Next X
    
        .Cls
  
     End With

End Sub

Public Sub MenuPopUp()
    '皋春积己钦聪促.
    hMenu = CreatePopupMenu() '皋牢皋春积己
    hSubmenu = CreatePopupMenu() '辑宏皋春积己
    
    AppendMenu hMenu, MF_OWNERDRAW Or MF_DISABLED, 1000, 0& '浇扼捞靛官
    AppendMenu hMenu, MF_POPUP Or MF_MENUBARBREAK, hSubmenu, "瘤盔季磐"
    AppendMenu hMenu, MF_SEPARATOR, 0&, 0& '胶蒲磐
    AppendMenu hMenu, 0&, 1300, "包窍咯"
    AppendMenu hMenu, MF_SEPARATOR, 0&, 0& '胶蒲磐
    AppendMenu hMenu, 0&, 1400, "辆丰"
    AppendMenu hSubmenu, chkMnuFlags(0), 1101, "权其捞瘤"
    AppendMenu hSubmenu, chkMnuFlags(1), 1102, "档框富"
 End Sub

Public Sub MenuTrack(frm As Form) '皋春狼 Flages甫 捞侩秦辑 皋春甫 努腐茄 瓤苞甫 唱鸥辰促.
    
    GetCursorPos MP
    
    sMenu = TrackPopupMenu(hMenu, TPM_RETURNCMD, MP.X, MP.Y, 0, frm.hwnd, 0&)
    Select Case sMenu
         Case 1300 '档框富
              frmabout.Show 1
     
        Case 1400 '辆丰
             If MsgBox("USB System Lock Agent 橇肺弊伐阑 辆丰窍矫摆嚼聪鳖?", vbYesNo, frmmain.Caption) = vbYes Then _
                UnHook
                Unload AppForm
                Exit Sub
            ' Else
            ' End If
        Case Else
    
    End Select
    

    
    If sMenu <> 0 Then frm.Print sMenu  'Flages狼 蔼阑 汽俊 免仿秦霖促.
    
End Sub