Newsgroup: it.comp.lang.visual-basic
Titolo: Application toolbar in VB? (Mooooolto lungo, scusate)

Chiedo scusa per la lunghezza del post ma vi e' allegato parecchio
codice. Il problema e' questo: non riesco a realizzare una application
toolbar (tipo office per intenderci). Il codice l'ho ripreso quasi
tutto da un esempio in C++ nel CD MSDN che danno col Visual Studio.
Evidentemente di C++ non ne capisco molto. Sembra che alla WindowProc
non arrivi mai il messaggio WM_APPBAR. Qualche Idea?
Grazie e scusate ancora per la lunghezza del messagio.
Shrike
PS: Per provare il codice create un nuovo progetto (standard EXE) e
metteteci un form ed un modulo BAS. Nel form inserite il seguente
codice:
Option Explicit
Private Sub Form_Load()
    Call InitAppbar(Me)
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If UnloadMode = vbFormControlMenu Then
        Call ResetAppbar
    End If
End Sub
Nel modulo invece inserite questo:
Option Explicit
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Type APPBARDATA
    cbSize As Long
    hwnd As Long
    uCallbackMessage As Long
    uEdge As Long
    rc As RECT
    lParam As Long
End Type
Private Const ABE_BOTTOM = 3
Private Const ABE_LEFT = 0
Private Const ABE_RIGHT = 2
Private Const ABE_TOP = 1
Private Const ABM_ACTIVATE = &H6
Private Const ABM_GETAUTOHIDEBAR = &H7
Private Const ABM_GETSTATE = &H4
Private Const ABM_GETTASKBARPOS = &H5
Private Const ABM_NEW = &H0
Private Const ABM_QUERYPOS = &H2
Private Const ABM_REMOVE = &H1
Private Const ABM_SETAUTOHIDEBAR = &H8
Private Const ABM_SETPOS = &H3
Private Const ABM_WINDOWPOSCHANGED = &H9
Private Const ABN_FULLSCREENAPP = &H2
Private Const ABN_POSCHANGED = &H1
Private Const ABN_STATECHANGE = &H0
Private Const ABN_WINDOWARRANGE = &H3
Private Const ABS_ALWAYSONTOP = &H2
Private Const ABS_AUTOHIDE = &H1
Private Const WM_USER = &H400
Private Const WM_APPBAR = WM_USER + 1
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
Private Const HWND_TOPMOST = -1
Private Const HWND_BOTTOM = 1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOACTIVATE = &H10
Private Const GWL_WNDPROC = (-4)
Private Declare Function SHAppBarMessage Lib "shell32.dll" (ByVal
dwMessage As Long, pData As APPBARDATA) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex
As Long) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long,
ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight
As Long, ByVal bRepaint As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As
Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long,
ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As
Long, lpRect As RECT) As Long
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 CallWindowProc Lib "user32" Alias
"CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long,
ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private mfrmTheForm As Form
Private mlngOldWindowProc As Long
Private mfAppRegistered As Boolean
Private mlngSide As Long
'funzione che inizializza la appbar
Public Function InitAppbar(ByRef frmToInit As Form) As Boolean
    Dim fReturn As Boolean
    Dim tABD As APPBARDATA
    Dim tRect As RECT
 
    'inizializzazione
    fReturn = False
 
    'salva un riferimento al form
    Set mfrmTheForm = frmToInit
 
    'subclassing
    mlngOldWindowProc = GetWindowLong(mfrmTheForm.hwnd, GWL_WNDPROC)
    If SetWindowLong(mfrmTheForm.hwnd, GWL_WNDPROC, AddressOf
WindowProc) <> 0 Then
 
        'registrazione della appbar
        If RegisterAccessBar(mfrmTheForm.hwnd, True) Then
 
            'posizionamento della appbar
            tABD.cbSize = Len(tABD)
            tABD.hwnd = mfrmTheForm.hwnd
            Call AppBarQuerySetPos(ABE_TOP, tRect, tABD)
 
            'valore ritornato
            fReturn = True
        End If
    End If
 
    'ritorno
    InitAppbar = fReturn
End Function
'funzione che resetta la appbar
Public Sub ResetAppbar()
    'rimozione della appbar
    Call RegisterAccessBar(mfrmTheForm.hwnd, False)
 
    'ripristino della WindowProc originale
    Call SetWindowLong(mfrmTheForm.hwnd, GWL_WNDPROC,
mlngOldWindowProc)
End Sub
'WindowProc del form
Private Function WindowProc(ByVal lngHWnd As Long, _
                           ByVal lngMsg As Long, _
                           ByVal lngWParm As Long, _
                           ByVal lngLParm As Long) As Long
 
    Select Case lngMsg
    Case WM_APPBAR      'messaggio Appbar
        Call AppBarCallback(lngHWnd, lngWParm, lngLParm)
 
    Case Else           'altri messaggi
        WindowProc = CallWindowProc(mlngOldWindowProc, lngHWnd,
lngMsg, lngWParm, lngLParm)
    End Select
End Function
'funzione di registrazione della Appbar
Private Function RegisterAccessBar(ByVal lngHWndAccessBar As Long,
ByVal fRegister As Boolean) As Boolean
    Dim fReturn As Boolean
    Dim tABD As APPBARDATA
 
    'inizializzazioni
    fReturn = True
    tABD.cbSize = Len(tABD)
    tABD.hwnd = lngHWndAccessBar
 
    If fRegister Then
 
        'messaggio di call-back
        tABD.uCallbackMessage = WM_APPBAR
 
        'registrazione
        If SHAppBarMessage(ABM_NEW, tABD) = 0 Then
            fReturn = False
        Else
            mlngSide = ABE_TOP
            mfAppRegistered = True
        End If
    Else
 
        'rimozione
        Call SHAppBarMessage(ABM_REMOVE, tABD)
        mfAppRegistered = False
    End If
    'ritorno
    RegisterAccessBar = fReturn
End Function
 
'imposta la posizione della Appbar
Private Sub AppBarQuerySetPos(ByVal lngEdge As Long, ByRef tRect As
RECT, ByRef tABD As APPBARDATA)
    Dim lngHeight As Long
    Dim lngWidth As Long
 
    'inizializzazioni
    lngHeight = 0
    lngWidth = 0
    tABD.rc = tRect
    tABD.uEdge = lngEdge
 
    With tABD.rc
 
        'copia le coordinate della appbar nella struttura tABD
        If lngEdge = ABE_LEFT Or lngEdge = ABE_RIGHT Then
            lngWidth = .Right - .Left
            .Top = 0
            .Bottom = GetSystemMetrics(SM_CYSCREEN)
        Else
            lngHeight = .Bottom - .Top
            .Left = 0
            .Right = GetSystemMetrics(SM_CXSCREEN)
        End If
 
        'richiede al sistema una posizione e delle dimensioni valide
        Call SHAppBarMessage(ABM_QUERYPOS, tABD)
 
        'corregge le dimensioni
        Select Case lngEdge
        Case ABE_LEFT
            .Right = .Left + lngWidth
 
        Case ABE_RIGHT
            .Left = .Right - lngWidth
 
        Case ABE_TOP
            .Bottom = .Top + lngHeight
 
        Case ABE_BOTTOM
            .Top = .Bottom - lngHeight
        End Select
    End With
 
    'reimposta posizione e dimensioni
    Call SHAppBarMessage(ABM_SETPOS, tABD)
 
    'sposta opportunamente la finestra
    Call MoveWindow(tABD.hwnd, tABD.rc.Left, tABD.rc.Top,
tABD.rc.Right - tABD.rc.Left, tABD.rc.Bottom - tABD.rc.Top, True)
End Sub
 
'processa i messaggi inviati dal sistema
Private Sub AppBarCallback(ByVal lngHWndAccessBar, ByVal lngNotifyMsg
As Long, ByVal lngLParam As Long)
    Dim tABD As APPBARDATA
    Dim lngState As Long
 
    tABD.cbSize = Len(tABD)
    tABD.hwnd = lngHWndAccessBar
 
    Select Case lngNotifyMsg
 
    Case ABN_STATECHANGE
 
        'controlla se il parametro "sempre in primo piano" della
taskbar è cambiato e, nel caso,
        'cambia opportunamente lo stato della appbar
        lngState = SHAppBarMessage(ABM_GETSTATE, tABD)
        Call SetWindowPos(lngHWndAccessBar, _
                          IIf((ABS_ALWAYSONTOP And lngState) <> 0,
HWND_TOPMOST, HWND_BOTTOM), _
                          0, _
                          0, _
                          0, _
                          0, _
                          SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE)
 
    Case ABN_FULLSCREENAPP
 
        'una applicazione full-screen è stata avviata o conclusa.
Imposta l'appropriato z-order della appbar
        If lngLParam <> 0 Then
            Call SetWindowPos(lngHWndAccessBar, _
                              IIf((ABS_ALWAYSONTOP And lngState) <> 0,
HWND_TOPMOST, HWND_BOTTOM), _
                              0, _
                              0, _
                              0, _
                              0, _
                              SWP_NOMOVE Or SWP_NOSIZE Or
SWP_NOACTIVATE)
        Else
            lngState = SHAppBarMessage(ABM_GETSTATE, tABD)
            If (lngState And ABS_ALWAYSONTOP) <> 0 Then
                Call SetWindowPos(lngHWndAccessBar, _
                                  HWND_TOPMOST, _
                                  0, _
                                  0, _
                                  0, _
                                  0, _
                                  SWP_NOMOVE Or SWP_NOSIZE Or
SWP_NOACTIVATE)
            End If
        End If
 
    Case ABN_POSCHANGED
 
        'la taskbar o un'altra appbar ha cambiato dimensioni e/o
posizione
        Call AppBarPosChanged(tABD)
    End Select
End Sub
 
'corregge dimensioni e posizione della appbar
Private Sub AppBarPosChanged(ByRef tABD As APPBARDATA)
    Dim tRc As RECT
    Dim tRcWindow As RECT
    Dim lngHeight As Long
    Dim lngWidth As Long
 
    'inizializzazioni
    tRc.Top = 0
    tRc.Left = 0
    tRc.Right = GetSystemMetrics(SM_CXSCREEN)
    tRc.Bottom = GetSystemMetrics(SM_CYSCREEN)
 
    'legge le coordinate della appbar e calcola le sue dimensioni
    Call GetWindowRect(tABD.hwnd, tRcWindow)
    lngHeight = tRcWindow.Bottom - tRcWindow.Top
    lngWidth = tRcWindow.Right - tRcWindow.Left
 
    'a seconda del lato su cui risiede la appbar corregge il valore
opportuno
    Select Case mlngSide
    Case ABE_TOP
        tRc.Bottom = tRc.Top + lngHeight
    Case ABE_BOTTOM
        tRc.Top = tRc.Bottom - lngHeight
 
    Case ABE_LEFT
        tRc.Right = tRc.Left + lngWidth
 
    Case ABE_RIGHT
        tRc.Left = tRc.Right - lngWidth
    End Select
 
    'reimpostazione
    Call AppBarQuerySetPos(mlngSide, tRc, tABD)
End Sub

...
