XL 2016 VBA - Redimensionner un UserForm après le retrait de la barre du menu système (Caption)

[Dudu2]

Bonjour,

Suite à un sujet récent sur une barre de progression dont on peut retirer le Caption (la barre de menu système) via l'API, se pose la question de redimensionner le UserForm à sa taille sans le Caption.

En faisant un fichier de test j'ai (je pense) trouvé une solution qui n'est pas simple du tout et sur laquelle j'ai passé pas mal de temps.

Edit: je retire les commentaires de ce post car une solution beaucoup plus simple est proposée au post suivant.

Il y a peut-être un moyen encore plus simple en jouant sur les flags lors du retrait de la barre de menu système (le Caption) du UserForm via l'API. Avis aux experts !

 

[Dudu2]

En fait, la différence des Inside suffit à redimensionner le UserForm après le retrait de la barre du menu système (Caption).

Il faut juste arbitrairement modifier une des dimensions du UserForm pour provoquer le recalcul des Inside (et pourquoi ça ???).

Au final il faut:

1. Conserver le .InsideHeight et .InsideWidth du UserForm complet.
2. Retirer la barre de menu système (le Caption) du UserForm via l'API.
3. Redimensionner le UserForm:
   - Modifier arbitrairement l'une des dimensions (Width ou Height) du UserForm (+1 point puis -1 point par exemple) pour provoquer le recalcul des Inside.
   - Retirer la différence des Inside après et avant car les Inside après ont inclus les marges et autres zones dont la barre de menu système (le Caption) du UserForm complet

 

[patricktoulon]

re
c'est dommage que tu n’écoute qu'a moitié
je te l'ai dit en 2021 et 2023 et même cette année me semble t il
depuis le dwmapi.dll la DrawMenuBar redessine la partie supprimée en bas de l'userform
c'est à dire depuis qu'est i sorti le 1er thème aero longhorn on va dire depuis VISTA

je remplace ton usine à gaz par ceci et j'obtiens exactement le même résultat

#If Win64 Then
    Public Declare PtrSafe Function SetWindowLongA Lib "user32" Alias "SetWindowLongptrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    Public Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
    Public Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Public Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If


Sub NoTitleBar(form)
    #If Win64 Then
        Dim hwnd As LongPtr
    #Else
        Dim hwnd As Long
    #End If
    Dim W#, H#, EcX#
    With form
        EcX = .Width - .InsideWidth
        W = .InsideWidth
        H = .InsideHeight
        hwnd = FindWindowA(vbNullString, form.Caption)
        SetWindowLongA hwnd, -16, &H94080080 'on retire la barre de titre
        .Move .Left, .Top, W, H + EcX
    End With
End Sub

on rajoute ecx par ce que là je n’enlève pas le petit cadre fin , sinon ça ne serait pas nécessaire
je vais le calculer le newlong pour enlever le petit cadre aussi et je vous le donnerais
Terminé

 

[Dudu2]

Re,
C'est dommage que tu ne testes qu'à moitié.

Le UserForm initial:

Le Userform tel qu'il doit être après retrait du Caption:

Le UserForm tel que ton code le formate:

Edit:

depuis le dwmapi.dll la DrawMenuBar redessine la partie supprimée en bas de l'userform

La DrawMenuBar redessine certes la partie supprimée mais ne réduit le UserForm.

 

[Dudu2]

En plus, s'il faut tout faire dans une seule séquence comme tu l'as fait, voilà le code.

Sub RetirerCaption() 
    Dim CaptionInsideWidth As Double
    Dim CaptionInsideHeight As Double

    With UserForm1
        'Récupération des Inside du UserForm complet
        CaptionInsideWidth = .InsideWidth
        CaptionInsideHeight = .InsideHeight
 
        Call RemoveBordersAndSystemBar(UserForm1)
 
        'Il faut modifier une des dimensions du UserForm pour provoquer le recalcul des Inside (pourquoi ???)
        .Width = .Width + 1
        .Width = .Width - 1
 
        'Retirer les différences des Inside avec le UserForm complet car les Inside ont inclus les marges du UserForm complet
        .Width = .Width - (.InsideWidth - CaptionInsideWidth)
        .Height = .Height - (.InsideHeight - CaptionInsideHeight)
    End With
End Sub

Private Sub RemoveBordersAndSystemBar(UserForm As Object)
    Dim UserFormHandle As Variant
    Dim iStyle As Variant
 
    UserFormHandle = GetUserFormHandleByCaption(UserForm)
    iStyle = GetWindowLongPtr(UserFormHandle, GWL_STYLE)
    SetWindowLongPtr UserFormHandle, GWL_STYLE, iStyle And Not WS_CAPTION
End Sub

Function GetUserFormHandleByCaption(UserForm As Object) As Variant
    Dim UserFormHandle As Variant
    Dim ClassName As String
 
    ClassName = "Thunder" & IIf(Application.Version Like "8*", "X", "D") & "Frame"
    UserFormHandle = FindWindow(ClassName, UserForm.Caption)
 
    'UserForm Parent is the Application ?
    If UserFormHandle = 0 Then
        UserFormHandle = FindWindowEx(Application.hwnd, 0, ClassName, UserForm.Caption)
    End If
 
    GetUserFormHandleByCaption = UserFormHandle
End Function

J'appelle pas ça une usine à gaz !
D'autant que la capture du Handle supporte aussi les UserForms dont le Parent a été modifié et que je ne code pas en ZIP code en déclarant les variables ligne par ligne avec 1 seule instruction par ligne et que je commente et aère avec des lignes vides.

 

[Dudu2]

Bonjour les réducteurs de têtes de UserForm,

J'ai ajouté la remise du Caption après sa suppression.
C'est très simple, juste à valoriser le Caption et remettre le Top et le Left aux valeurs précédentes.
On obtient exactement le même UserForm complet qu'au départ.

 

[patricktoulon]

re
que dire ?

 

[patricktoulon]

re
j'ai ajouté ceci dans ton code pour vérifier

resultat

et dans mon code

 

[Dudu2]

Que dire ?
Déjà je n'arrive pas à lire ta vidéo de 12 minutes. Ça n'avance pas et c'est bien trop long.
Et je ne comprends pas ce que tu as modifié dans ton code car le flèche rouge indique une instruction qui est la même qu'avant.

Ensuite, le fichier ci-joint montre que ta correction n'est pas correcte puisque au rajout de la barre de menu après suppression, on N'obtient PAS le même UserForm qu'à l'origine.
Mon fichier du Post #6 restitue exactement le même UserForm.

Alors oui, que dire ?! Moi je ne dis plus rien.

 

[patricktoulon]

re
je n'ai rien modifié
un userform avec barre de titre
si on enlève la caption(la barre de titre)
le userform au final doit fait la dimension de son inside + 1.3 du petit cadre ajouté quand on lui enlève la barre de titre
ET C'EST TOUT
je vient de tester ton dernier exemple
voila ce que tu fait

le inside height n'est pas respecté
les controls sont redimensionnés on se demande pourquoi
on a une erreur en haut on voit bien en comparant avec la capture
et on a une erreur en bas forcement le control rose est redimensionné!!???

Maintenant avec ma méthode avec les deux bouton a droite que j'ai ajouter

on a toujours un petit défaut en haut (un peu moins)
mais j'ai bien mon petit espace après le control rose en bas
et mon control rose n'est pas redimensionné

allez je t'envoie le fichier tel qu 'il est
je te l'ai fait en gif tu pourra pas dire que tu n'a pas vu

 

[Dudu2]

Pas chez moi (après correction de la déclaration API de SetWindowLongA)

Private Declare PtrSafe Function SetWindowLongA Lib "user32" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr

 

[Dudu2]

Et en SetParent sur l'Application c'est encore pire.
Edit: OK, parce que tune trouves pas le Handle? je vais corriger

 

[patricktoulon]

ok mais au moins les controls sont à leur place et gardent leur dimension
mais je pense avoir compris
ton thème windows te met les barres de titre en &h94CF0080
et chez moi le thème windows me met les barres de titre en &H94C80080
je viens de faire l'expérience

 

[patricktoulon]

re
avec le set parent je te l'ai dit le shell redessine le userform tel quel
pour quoi veux tu redimensionner ????????

 

[Dudu2]

vec le set parent je te l'ai dit le shell redessine le userform tel quel
pour quoi veux tu redimensionner ????????

Et pourquoi pas ?

Avec récupération du Handle du UserForm SetParent sur l'Application, c'est pareil que sans le SetParent.