appbar.frm

大量优秀的vb编程

VERSION 5.00
Begin VB.Form frmAppBar 
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   3192
   ClientLeft      =   12
   ClientTop       =   12
   ClientWidth     =   4680
   ControlBox      =   0   'False
   Icon            =   "AppBar.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3192
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer tmrHide 
      Interval        =   1
      Left            =   240
      Top             =   240
   End
   Begin VB.PictureBox picFrame 
      BorderStyle     =   0  'None
      Height          =   732
      Left            =   240
      ScaleHeight     =   732
      ScaleWidth      =   3972
      TabIndex        =   0
      Top             =   1320
      Width           =   3972
      Begin VB.CommandButton Command2 
         Caption         =   "运行程序"
         Height          =   360
         Left            =   1200
         Picture         =   "AppBar.frx":000C
         TabIndex        =   2
         Top             =   120
         Width           =   912
      End
      Begin VB.CommandButton Command1 
         Caption         =   "退出程序"
         Height          =   360
         Left            =   120
         Picture         =   "AppBar.frx":0606
         TabIndex        =   1
         Top             =   120
         Width           =   912
      End
      Begin VB.Image Image1 
         Height          =   384
         Left            =   2280
         Picture         =   "AppBar.frx":0C00
         Top             =   120
         Width           =   384
      End
   End
End
Attribute VB_Name = "frmAppBar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Dim BarData As APPBARDATA

Dim bAutoHide As Boolean
Dim bAnimate As Boolean

Private Sub Command1_Click()
End
End Sub

Private Sub Form_Load()

    Dim lResult As Long

    Move 0, 0, 0, 0
    Screen.MousePointer = vbDefault
    
    bAutoHide = True
    bAnimate = True
    
    BarData.cbSize = Len(BarData)
    BarData.hwnd = hwnd
    BarData.uCallbackMessage = WM_MOUSEMOVE
    lResult = SHAppBarMessage(ABM_NEW, BarData)
    lResult = SetRect(BarData.rc, 0, 0, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN))
    BarData.uEdge = ABE_TOP
    lResult = SHAppBarMessage(ABM_QUERYPOS, BarData)
    If bAutoHide Then
        BarData.rc.Bottom = BarData.rc.Top + 10 'tbrToolBar.Bands("ToolBar").Height + 6
        lResult = SHAppBarMessage(ABM_SETPOS, BarData)
        BarData.lParam = True
        lResult = SHAppBarMessage(ABM_SETAUTOHIDEBAR, BarData)
        If lResult = 0 Then
            bAutoHide = False
        Else
            lResult = SetWindowPos(BarData.hwnd, HWND_TOP, BarData.rc.Left, BarData.rc.Top - 42, BarData.rc.Right - BarData.rc.Left, 44, SWP_NOACTIVATE)
        End If
    End If
    If Not bAutoHide Then
        BarData.rc.Bottom = BarData.rc.Top + 42
        lResult = SHAppBarMessage(ABM_SETPOS, BarData)
        lResult = SetWindowPos(BarData.hwnd, HWND_TOP, BarData.rc.Left, BarData.rc.Top, BarData.rc.Right - BarData.rc.Left, 42, SWP_NOACTIVATE)
    End If
End Sub


Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

    Static bRecieved As Boolean
    Dim lResult As Long
    Dim newRC As RECT
    Dim lMessage As Long
    
    lMessage = x / Screen.TwipsPerPixelX
    
    If bRecieved = False Then
        bRecieved = True
        Select Case lMessage
            Case WM_ACTIVATE
                lResult = SHAppBarMessage(ABM_ACTIVATE, BarData)
            Case WM_WINDOWPOSCHANGED
                lResult = SHAppBarMessage(ABM_WINDOWPOSCHANGED, BarData)
            Case ABN_STATECHANGE
                lResult = SetRect(BarData.rc, 0, 0, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN))
                BarData.uEdge = ABE_TOP
                lResult = SHAppBarMessage(ABM_QUERYPOS, BarData)
                If bAutoHide Then
                    BarData.rc.Bottom = BarData.rc.Top + 2
                    lResult = SHAppBarMessage(ABM_SETPOS, BarData)
                    BarData.lParam = True
                    lResult = SHAppBarMessage(ABM_SETAUTOHIDEBAR, BarData)
                    If lResult = 0 Then
                        bAutoHide = False
                    Else
                        lResult = SetWindowPos(BarData.hwnd, HWND_TOP, BarData.rc.Left, BarData.rc.Top - 42, BarData.rc.Right - BarData.rc.Left, 44, SWP_NOACTIVATE)
                    End If
                End If
                If Not bAutoHide Then
                    BarData.rc.Bottom = BarData.rc.Top + 42
                    lResult = SHAppBarMessage(ABM_SETPOS, BarData)
                    lResult = SetWindowPos(BarData.hwnd, HWND_TOP, BarData.rc.Left, BarData.rc.Top, BarData.rc.Right - BarData.rc.Left, 42, SWP_NOACTIVATE)
                End If
            Case ABN_FULLSCREENAPP
                Beep
        End Select
        bRecieved = False
    End If
End Sub

Private Sub Form_Resize()
    picFrame.Move 0, 0, Width, Height
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If BarData.hwnd <> 0 Then SHAppBarMessage ABM_REMOVE, BarData
End Sub


Private Sub picFrame_DblClick()
    Unload Me
End Sub

Private Sub picFrame_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim lResult As Long
    Dim iCounter As Integer
    If Top < 0 Then
        If bAnimate Then
            For iCounter = -36 To -1
                BarData.rc.Top = iCounter
                lResult = SetWindowPos(BarData.hwnd, 0&, BarData.rc.Left, BarData.rc.Top, BarData.rc.Right - BarData.rc.Left, 42, SWP_NOACTIVATE)
            Next
        End If
        BarData.rc.Top = 0
        lResult = SetWindowPos(BarData.hwnd, HWND_TOPMOST, BarData.rc.Left, BarData.rc.Top, BarData.rc.Right - BarData.rc.Left, 42, SWP_SHOWWINDOW)
        tmrHide.Enabled = True
    End If
End Sub


Private Sub tmrHide_Timer()
    Dim lResult As Long
    Dim lpPoint As POINTAPI
    Dim iCounter As Integer
    lResult = GetCursorPos(lpPoint)
    If lpPoint.x < Left \ Screen.TwipsPerPixelX Or lpPoint.x > (Left + Width) \ Screen.TwipsPerPixelX Or lpPoint.y < Top \ Screen.TwipsPerPixelY Or lpPoint.y - 10 > (Top + Height) \ Screen.TwipsPerPixelY Then
        If bAnimate Then
            For iCounter = -1 To -37 Step -1
                BarData.rc.Top = iCounter
                lResult = SetWindowPos(BarData.hwnd, 0&, BarData.rc.Left, BarData.rc.Top, BarData.rc.Right - BarData.rc.Left, 42, SWP_NOACTIVATE)
            Next
        End If
        BarData.rc.Top = -42
        lResult = SetWindowPos(BarData.hwnd, HWND_TOPMOST, BarData.rc.Left, BarData.rc.Top, BarData.rc.Right - BarData.rc.Left, 44, SWP_NOACTIVATE)
        tmrHide.Enabled = False
    End If
End Sub