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 !

 

[ChTi160]

Re
Mon test du Fichier du #44
Jean marie

 

[patricktoulon]

re
@Dudu2
ben on a découvert quelque chose tout les deux alors
autant le -1 je le savais mais autant je ne savais que que remettre le titre simplement remettais le userform avec sa barre de titre là ça me sidère
quoi que je suppose que ça doit déclencher un new load tout simplement étant donné que tu fait appel à une properties("caption") qui n'est pas une fonction

 

[patricktoulon]

Re
Mon test du Fichier du #44
Jean marie

re
et oui jean-marie avec la méthode1 il faut enlever le diamètre des arrondi(dans les coins)
va savoir pour quoi???? je le sais j'ai testé hier sur un W11 365
essaie plutôt la methode rectangle

 

[Dudu2]

@ChTi160,
Chez toi la Height du UserForm a été diminuée de 0.75 point ! Étrange !
T'es en 64 bits de quelle version ?
Et les bords de ton UserForm sont arrondis !

 

[Dudu2]

Comment tu fais pour arrondir les coins ?
Quelle option ?

 

[Dudu2]

quoi que je suppose que ça doit déclencher un new load tout simplement étant donné que tu fait appel à une properties("caption") qui n'est pas une fonction

Oui, j'ai pensé à remettre le Caption avec un SetWindowLong mais comme ça fonctionnait avec le Caption je n'ai pas cherché plus loin.
Je vais essayer.

 

[Dudu2]

Résultat du test de remise du Caption avec un SetWindowLong (Style Or WS_CAPTION).

Ça marche très bien et donne le même résultat qu'avec la valorisation de Caption.
Mais c'est exactement le même problème qu'au retrait !

Il faut:
1 - Provoquer l'update des Inside après le SetWindowLong (je le fais avec un DrawMenuBar)
2 - Redéfinir les UserForm Width et Height par différence des Inside

 

[patricktoulon]

au final même si c'est pas parfait parfait
on reduit le tout à ceci
ps: punaise je vais la garder celle là d'astuce (.caption=.caption)

'Enlever la barre de titre d'un userform et retrouver la taille initial dans le inside du userform
'created by patricktoulon et  @Dudu2
'Discussion:https://excel-downloads.com/threads/vba-redimensionner-un-userform-apres-le-retrait-de-la-barre-du-menu-systeme-caption.20085127/page-4#post-20667195
#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 PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #End If
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
    Private Declare Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If


Sub NoTitleBar(form)
    Dim OldInW, OldInH
    With form
        'memo des dimensions interieures original (Affichage)
        OldInW = .InsideWidth
        OldInH = .InsideHeight

        'on enlève la caption
        hWnd = FindWindow(vbNullString, form.Caption)
        SetWindowLongPtr hWnd, -16, &H94080080 'on retire la barre de titre

        'Pour provoquer l'update des Inside après le SetWindowLongPtr()
        .Width = .Width + 1
        .Width = .Width - 1

        'Correction des dimensions interieuresen enelebant la différence du inside actuel a celui de lancien
        .Width = .Width - (.InsideWidth - OldInW)
        .Height = .Height - (.InsideHeight - OldInH)

    End With
End Sub

Sub showpat()
    Unload UserForm1
    UserForm1.Show 0
End Sub

Sub showpat2()
    NoTitleBar UserForm1
End Sub

Sub showpat3()
    Dim OldL, OldT
    'memo des position left et top
    'on reload le userform en exitant son initialise en faisant appel a sa propriété caption
    'ce qui a pour consequance de reloader le userform avec la barre de titre caption
    'remise en position left et top avec les positions memorisées
    With UserForm1
        OldL = .Left
        OldT = .Top
        .Caption = .Caption
        .Left = OldL
        .Top = OldT
    End With
End Sub

 

[Dudu2]

au final même si c'est pas parfait parfait
on reduit le tout à ceci

YES !

 

[Dudu2]

Reste que je ne comprends pas la différence de Height du UserForm avant et après chez @ChTi160 de 0.75 point avec les coins arrondis (à supposer que s'en soit la cause).
Sans compter les Inside qui changent de 0.30 et -0.15 point.

 

[patricktoulon]

re
l'ombre invisible que l'on doit compter même si elle est invisible sur les thèmes avec coins arrondi tu a oublié?
ça fait partie des chose qui sont ingérables avec ces thème on a vu ça déjà
même problème qu'avec pointstoScreenpixel

 

[patricktoulon]

c'est pour ça que j'ai proposé avec les rectangles

car on s occupe que de l'intérieur comme référence avec une frame
dont on peut chopper le handle et donc créer un rectangle avec getwindowrect
voila pour quoi j'ai mis cette version sur le tapis

 

[Dudu2]

Ok, je vais investiger avec les RECT.
Ceci dit je ne comprends pas comment @ChTi160 a pu arrondir ses angles sans utiliser l'API CreateRoundRectRgn().
Hélas il n'y a pas d'API pour retrouver les paramètres d'arrondis pour les défaire avant et les remettre après les manips.

 

[ChTi160]

Re
@Dudu2
Moi non plus ! lol
Jean marie

 

[patricktoulon]

re

Hélas il n'y a pas d'API pour retrouver les paramètres d'arrondis pour les défaire avant et les remettre après les manips.

D.W.M.A.P.I.DLL

dans la feuille 2 tu a la version avec rect