Intercettare stato pulsante Riduci a Icona tramite API

di il
16 risposte

Intercettare stato pulsante Riduci a Icona tramite API

Salve a tutti, vorrei intercettare lo state del pulsante riduci a Icona di una Maschera di access con stile Dimensionabile allo scopo di fare delle azioni nel caso sia premuto.
Credo che l' unico modo sia utilizzare l API e guardando in giro ho abbozzato un codice, uso Access 2016 64 Bit
quindi nella Maschera ho messo questo codice di prova in un pulsante
Option Compare Database
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd1 As LongPtr, ByVal wMsg As Long, ByVal wParam _
As LongPtr, lParam As Any) As LongPtr

Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWndS As LongPtr, ByVal nIndex As Long) As Long

Const BM_GETSTATE = &HF2
Const BST_CHECKED = &H1
Const BST_FOCUS = &H8
Const BST_INDETERMINATE = &H2
Const BST_PUSHED = &H4
Const BST_UNCHECKED = &H0

Const GWL_STYLE = -16
Const WS_MAXIMIZEBOX = &H10000
Const WS_MINIMIZEBOX = &H10000

Private Sub Comando3_Click()
Dim styles As Long
Dim state As LongPtr

If (styles And WS_MINIMIZEBOX) = WS_MINIMIZEBOX Then
    Debug.Print " ha il pulsante Riducia Icona"
Else
    Debug.Print "NON ha il pulsante Riducia Icona"
End If

state = SendMessage(WS_MINIMIZEBOX.hwnd1, BM_GETSTATE, ByVal CLng(0), ByVal CLng(0))

If state And BST_CHECK Then
    Debug.Print "The box is checked."
ElseIf state And BST_INDETERMINATE Then
    Debug.Print "The box is in its third state (grayed)."
Else
    Debug.Print "The box is not checked."
End If
If state And BST_FOCUS Then Debug.Print "The box has the keyboard focus."
If state And BST_PUSHED Then Debug.Print "The box is being pushed."

End Sub
la prima parte del codice nel pulsante l ho usata SOLO per sapere se la maschera ha il pulsante riduci a icona "MINIMIZEBOX" e questo funziona
If (styles And WS_MINIMIZEBOX) = WS_MINIMIZEBOX Then
    Debug.Print " ha il pulsante Riducia Icona"
Else
    Debug.Print "NON ha il pulsante Riducia Icona"
End If
l' altra parte del codice che dovrebbe essere il fulcro perchè dovrebbe intercettare lo stato del pulsante NON và
f state And BST_CHECK Then
    Debug.Print "The box is checked."
ElseIf state And BST_INDETERMINATE Then
    Debug.Print "The box is in its third state (grayed)."
Else
    Debug.Print "The box is not checked."
End If
If state And BST_FOCUS Then Debug.Print "The box has the keyboard focus."
If state And BST_PUSHED Then Debug.Print "The box is being pushed."
che pensavo di mettere SU Corrente o SU Ridimensionamento in modo da intercettare il pulsante quando viene premuto.

Ma non funziona se clicco sul pulsante mi dice qualificatore non valido evidenziando "WS_MINIMIZEBOX"
quindi secondo voi dove sbaglio?

grazie sempre per i consigli

16 Risposte

  • Re: Intercettare stato pulsante Riduci a Icona tramite API

    Da ignorantone di API evidenzio solo alcune stranezze

    eternityck ha scritto:


    
    Const WS_MAXIMIZEBOX = &H10000 '<=== due costanti, stesso valore? 
    Const WS_MINIMIZEBOX = &H10000 '<===
    

    eternityck ha scritto:


    
    Private Sub Comando3_Click()
    Dim styles As Long
    Dim state As LongPtr
    
    If (styles And WS_MINIMIZEBOX) = WS_MINIMIZEBOX Then
    ...
    Hai appena dichiarato la variabile styles, come Long, quindi vale 0, che bit vuoi verificare con quell'AND logico?
    Metti sempre OPTION EXPLICIT all'inizio di ogni modulo, aiuta a non sbagliare a digitare i nomi delle variabili.
  • Re: Intercettare stato pulsante Riduci a Icona tramite API

    Devi usare una tecnica differente o meglio aggiuntiva...
    Non so dove hai copiato il codice, ma sei molto lontano dal concetto.
    Per intercettare il minimize devi subclassare i messaggi di Windows da e per la maschera oggetto dell'intercettazione.

    La tecnica del subclassing con Access non è SAFE in quanto interagisce fortemente con l'ide.
    Ai tempi in cui ci lavoravo preferivo usare una DLL esterna come Oggetto COM sviluppato appositamente in vb6 da istanziare nel progetto.
    In ogni caso se vuoi fare esperienza trovi un sacco di cose in questo mio vecchissimo DEMO... nel quale trovi anche diversi esempi ed all'interno anche uno che mostra proprio come intercettare i messaggi alla Form come Close/Minimize/Maximize/Resize ecc.

    Fai attenzione perché oltre a spaventarti per la discreta complessità servirà prendere confidenza con SPY++

    forum.masterdrive.it/access-79/vba-access-subclassing-18549/

    Io ormai sono tantissimi anni che non ci gioco più quindi... in bocca al lupo.
  • Re: Intercettare stato pulsante Riduci a Icona tramite API

    Grazie Alex!
    Ora ci inizio a giocherellare.
    Comunque mi confermi che è l 'unico metodo per intercettare i messaggi di close minimizza e massimizza?
  • Re: Intercettare stato pulsante Riduci a Icona tramite API

    No il CLOSE lo puoi intercettare con l'evento UNLOAD.
  • Re: Intercettare stato pulsante Riduci a Icona tramite API

    Caio Alex sto lavorando sul tuo demo ho preso il demo Abilita Messaggi su un pc a 32 bit ho selezionato i soli codici che mi servono, ora però in fase di conversione a 64 bit ho un problema, ho convertito le dichiarazioni delle subclass così
    Option Explicit
    
    ' ---------------- DICHIARAZIONE A LIVELLO DI MODULO ----------------
    'WIN 64
    Private Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hwnd As LongPtr, _
    ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    
    Public Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As LongLong
    
    Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal nCount As Long)
    
    'win 32
    'Public Declare PtrSafe 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
    
    'Public Declare PtrSafe Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long
    'Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal nCount As Long)
    
    Public Const WM_SYSCOMMAND = &H112
    Public Const SC_MINIMIZE = &HF020&
    Public Const SC_MAXIMIZE = &HF030&
    Public Const SC_RESTORE = &HF120&
    
    
    Public Const GWL_WNDPROC  As Long = (-4)
    ' Imposta il nuovo indirizzo per la WindowProc
    Public OldWindowProc    As Long
    
    'Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPtr
    
    Const WM_WINDOWPOSCHANGED = &H47
    
    Dim mret    As Boolean
    Dim retVal  As Long
    
    Select Case Msg
        Case WM_SYSCOMMAND
            mret = Forms!AbilitaMessaggi.GetMessage(Msg, wParam)
            If mret Then Exit Function
            retVal = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, lParam)
        Case Else
            retVal = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, lParam)
    End Select
    ' Continua il normale processamento. IMPORTANTISSIMO!
    NewWindowProc = retVal
    End Function
    
    


    ed invece i codice nella maschera così
    Private Sub Form_Load()
       ' Attivazione del SubClassing sulla Form
       OldWindowProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
    End Sub
    
    Private Sub Form_Unload(Cancel As Integer)
        SetWindowLong Me.hwnd, GWL_WNDPROC, OldWindowProc
    End Sub
    
    Public Function GetMessage(ByVal uMsg As Long, ByVal wParam As LongPtr) As Boolean
       
       Select Case uMsg
          Case WM_SYSCOMMAND
             Select Case wParam
                Case SC_MINIMIZE
                   Me.lstMessage.AddItem "Ricevuto SC_MINIMIZE = " & SC_MINIMIZE & IIf(ck_SC_MINIMIZE, " Attivo", " Disattivato")
                   GetMessage = Not ck_SC_MINIMIZE
                Case SC_MAXIMIZE
                   Me.lstMessage.AddItem "Ricevuto SC_MAXIMIZE = " & SC_MAXIMIZE & IIf(ck_SC_MAXIMIZE, " Attivo", " Disattivato")
                   GetMessage = Not ck_SC_MAXIMIZE
                Case SC_RESTORE
                   Me.lstMessage.AddItem "Ricevuto SC_RESTORE = " & SC_RESTORE & IIf(ck_SC_RESTORE, " Attivo", " Disattivato")
                   GetMessage = Not ck_SC_RESTORE
                Case Else
                   GetMessage = False
                End Select
       End Select
    End Function
    
    ma mi dà l' errore tipo non corispondente in
    AddressOf NewWindowProc
    sicuramente è un problema di conversione ma non riesco a capire dove.
    non è che mi potresti dare una dritta?
  • Re: Intercettare stato pulsante Riduci a Icona tramite API

    Ehehehe sembra facile.
    Non ho nemmeno preso in considerazione la conversazione in 64Bit... quindi è da fare ex-novo armandosi di voglia e conoscenza.
  • Re: Intercettare stato pulsante Riduci a Icona tramite API

    Ho già scritto che non sono esperto di API e che è @Alex quello che ne sa di più?

    eternityck ha scritto:


    AddressOf NewWindowProc
    sicuramente è un problema di conversione ma non riesco a capire dove.
    Prova a guardare questo link:
    Riporto la parte che secondo me è da analizzare
    This is one of the few API functions that requires the Win64 compile constant:
    #If VBA7 Then
        #If Win64 Then
            Private Declare PtrSafe Function SetWindowLongPtr Lib "USER32" Alias "SetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
        #Else
            Private Declare Function SetWindowLongPtr Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
        #End If
    #Else
        Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    #End If
    Poi c'è anche il rimando alla specifica pagina di Microsoft.
    Poi ci sono altre dritte (per la conversine da 32 a 64 bit): https://codekabinett.com/rdumps.php?Lang=2&targetDoc=windows-api-declaration-vba-64-bit
  • Re: Intercettare stato pulsante Riduci a Icona tramite API

    Le variabili tipo la NewWindowProc devono diventare LongPtr ma se sviluppi in modalità ibrida ovvero compatibile sia 32 che 64 devi scrivere tutto il codice condizionato non solo le chiamate API...
    Il lavoro da fare non è banale...
  • Re: Intercettare stato pulsante Riduci a Icona tramite API

    In realtà a me interessa poco la doppia compatibilità perchè i pc che usiamo sono tutti 64 bit
  • Re: Intercettare stato pulsante Riduci a Icona tramite API

    Cito la prima cosa che ho visto, non ho guardato oltre...
    Secondo te, è dichiarata correttamente la chiamata a NewWindowProc in versione 64Bit...?
    
    Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPtr
    Sapendo che una chiamata strutturata uguale [CallWindowProc ] ha queste dichiarazioni...? (solo a titolo di riflessione sui parametri)
    Private Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Temo sia da dichiarare così
    
    Public Function NewWndProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Non ho guardato l'imbottitura...

    Proseguo, la Variabile [OldWindowProc] come è dichiarata..?
    Ecc...
  • Re: Intercettare stato pulsante Riduci a Icona tramite API

    La variabile
    Public OldWindowProc As LongPtr (errore che avevo già visto)



    e la costante era Long e l ho rinominata

    Public Const GWL_WNDPROC As LongPtr = (-4)

    ma ancora errore in address
  • Re: Intercettare stato pulsante Riduci a Icona tramite API

    Ti ho segnalato altro io...
  • Re: Intercettare stato pulsante Riduci a Icona tramite API

    Allora continuando sugli aggrionamento ho visto che la function SetWindowLongA è stata sostituita con SetWindowLongPtrA
    Public Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, _
    ByVal dwNewLong As LongPtr) As LongPtr
    
    ma se metto questa mi va in crash invece se metto la
    Public Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtr" (ByVal hWnd As LongPtr, ByVal nIndex As Long, _
    ByVal dwNewLong As LongPtr) As LongPtr
    
    Impossibile trovare il punto d' ingresso della DLL in user 32.
    Credo che dici mi sto avvinando e mi sto allontanando?
  • Re: Intercettare stato pulsante Riduci a Icona tramite API

    Se usi questa...?
    Public Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    Sei certo di aver chiara la differenza tra il nome della funzione e l'Alias...?

    Non so se sei vicino o lontano... ma di certo pare tunstia andando a tentativi più o meno casuali... e forse manca qualchr nozione tecnica per renderti le cose semplici.

    Spero tu ti renda conto a cosa vai incontro subclassando i messaggi di Windows...
Devi accedere o registrarti per scrivere nel forum
16 risposte