XL 2016 VBA - Tester si le Menu Système est présent dans un UserForm

[Dudu2]

Bonjour,

J'arrive à ajouter le Menu Système à un UserForm par contre je suis incapable de déterminer a postériori si ce Menu Système est présent ou pas.
Je ne sais pas comment traiter le iStyle pour retourner un booléen.
Voir le fichier joint (modifié à 22h30 car initialement bugué)

 

[Dranreb]

Alors je ne sais pas.
La démo UFmProg marche encore chez vous ?
Si elle marche essayer avant de lancer un UFmProg.Tâche de faire un UFmProg.AbandonPossible = False
Si ça n'enlève pas la croix de fermeture c'est que mes api ne sont plus bonnes en 64 bits.

 

[Dudu2]

Je pense avoir une idée, suite à des tests de suppression du Menu Système.
En fait le masque WS_SYSMENU est toujours présent sur un UserForm. La croix pas exemple c'est le Menu Système.
Pour ajouter de la minimisation ou maximisation ou redimensionnement, il n'est pas nécessaire de placer le masque WS_SYSMENU. Ce sont les masques WS_MINIMIZEBOX, WS_MAXIMIZEBOX et WS_SIZEBOX seuls qui sont nécessaires.
Encore une certitude (de copier coller Internet) qui s'envole !

 

[Dudu2]

Merci pour ta participation à cette discussion d'un problème mal posé !
Comme quoi, des certitudes non basées sur des vérifications peuvent conduire à faire n'importe quoi et perdre des heures de recherche.

 

[Dranreb]

Vous pouvez simplifier une instruction :

UserFormHasSystemMenuMinMaxSize = CBool(iStyle And (WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or WS_SIZEBOX))

Ça m'intéresserait quand même de savoir que mes api ne tournent plus en 64 bits.

 

[Dudu2]

Ça m'intéresserait quand même de savoir que mes api ne tournent plus en 64 bits.

Tu veux que je teste quelque chose ?
Je pense qu'elles fonctionnent car si je ne garde que le GetWindowLongA retournant un Long ça passe tout aussi bien. Je ne comprends pas très bien l'utilité du GetWindowLongPtrA.

 

[Dranreb]

Oui, si le bouton "Démo UFmProg" de ma feuille "Histoire de temps" marche toujours,
dans la Sub DémoUFmProg du module ADémo, changer UFmProg.AbandonPossible = True en UFmProg.AbandonPossible = False et voir si ça marche toujours mais sans la croix de fermeture.

 

[Dudu2]

Oui dans les 2 cas ça fonctionne et quand UFmProg.AbandonPossible = False il n'y a pas la croix de fermeture du UserForm qui est présente dans le cas contraire. Très joli les couleurs !

 

[Dranreb]

Merci.

Il y a plein de conneries, me semble t-il, sur le net quant aux changements à apporter aux API pour le 64 bits …

 

[Dudu2]

Bonjour @Dranreb,
Symétriquement, peux-tu vérifier qu'il n'y a pas de plantage avec cette version qui ne déclare QUE les GetWindowLongPtrA dont la doc Windows citée en Post #9 prétend que ça s'applique aussi au 32 bits (si VBA7 bien sûr).

 

[jurassic pork]

Hello,
dans une discussion récente j'avais mis un bout de code qui devait s'adapter à tous les cas :

Option Explicit
#If VBA7 Then
    #If Win64 Then
        Public Declare PtrSafe Function GWLA Lib "USER32" Alias "GetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
        Public Declare PtrSafe Function SWLA Lib "USER32" Alias "SetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #Else
        Public Declare PtrSafe Function GWLA Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
        Public Declare PtrSafe Function SWLA Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #End If
#Else
    Public Declare Function GWLA Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Public Declare Function SWLA Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#End If

Ami calmant, J.P

 

[Dranreb]

Bonjour.
Premier bouton: message Erreur d'exécution '453':
Point d'entrée GetWindowLongPtrA d'une DLL introuvable dans user 32
au : iStyle = GetWindowLongPtr(UserFormHandle, GWL_STYLE)
Avec le second bouton la même erreur arrive plus tard, quand on clique sur le bouton dans l'UserForm.

 

[Dranreb]

Bonjour.

dans une discussion récente j'avais mis un bout de code qui devait s'adapter à tous les cas

Sauf que je vois vraiment pas pourquoi un paramètre qui s'appelle en plus dwNewLong (signifiant double mot nouveau Long) devrait passer LongPtr qui équivaut à LongLong pour #If Win64
Pareil pour le type de leurs valeurs retournées.

 

[patricktoulon]

Bonjour à tous
@Dudu2
perso pour savoir si un userform a été modifier je capt e le getwindowlong en style normal(-16)
le style complet normal (donc juste la croix) c'est &H94C80080
tiens j'ai essayé de les refaire en api déclarées car perso je les utilise en macro 4

'*****************************************************************************************************
'    ___     _     _______  __      _   ____  _   _  _______  ___     _   _   _    ___     _     _.
'   //  \\  /\\      //    // \\   //  //    //  //    //    //  \\  //  //  //   //  \\  //|   //
'  //___// //__\    //    //__//  //  //    //__//    //    //   // //  //  //   //   // // |  //
' //      //   \\  //    //  \\  //  //    //  \\    //    //   // //  //  //   //   // //  | //
'//      //    // //    //   // //  //___ //    \\  //     \\__// //__//  //___ \\__// //   |//
'****************************************************************************************************
'extrait du module Arrange Userform de 2019
'
'liste des style
'&H94C80080  'Normal à l'origine (juste le bouton fermer)
'&H94CA0080  'seulement le bouton reduire
'&H94C90080  'seulement le bouton agrandir
'&H94CB0080  'seulement les deux boutons agrandir & reduire
'&H94CC0080  'seulement l'elasticité
'&H94CE0080  'seulement l bouton reduire et l'élasticité
'&H94CD0080  'seulement le bouton agranfir et l'élasticité
'&H94C00080  'pas de bouton dans la barre de titre
'&H94080080  'pas de cadre pas de barre de titre
'&H140F0101  'pas de barre de titre mais le cadre et elasticié
'&H1010080   'barre de titre et cadre facon  Old Windows
'&H400100    'bouton et titre inversé avec le gwstyle(-20)
'&H94CF0080'La totale
#If VBA7 Then
    Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    #If Win64 Then
        Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal HwnD As LongPtr, ByVal nIndex As Long) As LongPtr
        Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal HwnD As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #Else
        Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal HwnD As LongPtr, ByVal nIndex As Long) As LongPtr
        Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HwnD As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #End If
    Dim HwnD As LongPtr
#Else
    Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal HwnD As Long, ByVal nIndex As Long) As Long
    Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HwnD As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Dim HwnD As Long
#End If

Function IsSystemMenuModified(usf) As Boolean
    HwnD = FindWindow(vbNullString, usf.Caption)
    IsSystemMenuModified = GetWindowLong(HwnD, -16) <> &H94C80080
End Function


Sub SystemMenuArrange(usf, NewLong)
    HwnD = FindWindow(vbNullString, usf.Caption)
    SetWindowLong HwnD, -16, NewLong
End Sub

demo dans un userform avec 3 bouton (normal/complet) et bouton tester

 

[Dranreb]

Un autre test m'intéresserait :

Sub TestTypHwnd()
   MsgBox "Sur votre système la fenêtre de votre application est" _
      & vbLf & "reconnue de Windows d'après une clé de type " & TypeName(Application.Hwnd), vbInformation
   End Sub

 

[patricktoulon]

Bonjour @Dranreb
excel32 vba7 (2013 pro plus)

et pour info en 64 ça devrait te donner exactement la même chose
c'est les api qui on besoin de doubler