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

Dudu2 · Dimanche à 21:56

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 · Lundi à 13:34

Re
bonjour le Fil
effectivement
Entre les deux versions , la hauteur du Label1 est dans la procédure 1 augmentée de 3 et passe de 12 à 15
Jean marie

Dudu2 · Lundi à 13:41

Chez moi que ce soit avec:
Private Const WS_CAPTION = &HC00000
ou
Private Const WS_DLGFRAME = &H400000
ou
Private Const WS_BORDER = &H800000

Le SetWindowLong donne le même résultat.

Dudu2 · Lundi à 13:55

D'ailleurs ton code avec ce Tag Window Style alambiqué &H94080080 dont on ne peut définir la composition donne aussi le même résultat.

Window Styles (Winuser.h) - Win32 apps

This topic provides a list of the various styles that can be applied to a window.

learn.microsoft.com

' Window Styles
Const WS_OVERLAPPED = &H0&
Const WS_POPUP = &H80000000
Const WS_CHILD = &H40000000
Const WS_MINIMIZE = &H20000000
Const WS_VISIBLE = &H10000000
Const WS_DISABLED = &H8000000
Const WS_CLIPSIBLINGS = &H4000000
Const WS_CLIPCHILDREN = &H2000000
Const WS_MAXIMIZE = &H1000000
Const WS_CAPTION = &HC00000 ' WS_BORDER Or WS_DLGFRAME
Const WS_BORDER = &H800000
Const WS_DLGFRAME = &H400000
Const WS_VSCROLL = &H200000
Const WS_HSCROLL = &H100000
Const WS_SYSMENU = &H80000
Const WS_THICKFRAME = &H40000
Const WS_GROUP = &H20000
Const WS_TABSTOP = &H10000

patricktoulon · Lundi à 13:57

TIENS @Dudu2 j'ai fait l'expérience pour toi
voilà ou est notre différence

et c'est pas tout a fait &H94CF0080 mais je vais trouver
car le "F" c'est pour les boutons en plus
le "C" c'est pour la caption
mais dans tout les cas on vois bien que la caption est plus épaisse

patricktoulon · Lundi à 14:06

j'ai trouvé ton windows affiche tes fenêtres avec ce long &H94CC0080

autrement dit :
avant suppression de la barre de titre il faudrait la restructurer faire le calcul et supprimer pour que ca fonctionne chez tout le monde pareil

Dudu2 · Lundi à 14:08

Ce n'est donc pas le SetWindowLong qui chez toi donne un mauvais résultat chez moi.
Car jusque là on obtient le même résultat.

C'est le calcul qui suit le retrait du Caption par le SetWindowLong qui diffère dans nos versions.

Chez toi:

Code:

    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 + Round(EcX)
    End With

Chez moi:

VB:

    With UserForm1     
        'Récupération des Inside du UserForm complet
        InitialInsideWidth = .InsideWidth
        InitialInsideHeight = .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 - InitialInsideWidth)
        .Height = .Height - (.InsideHeight - InitialInsideHeight)
    End With

Dudu2 · Lundi à 14:46

Suite à la remarque de @ChTi160, j'ai voulu vérifier le comportement de la barre rose qui marque la fin du UserForm.

La barre rose ne bouge pas en Top ni en Height et il y a toujours correspondance entre la fin du UserForm et la fin de la barre rose sauf juste après la suppression du Caption et avant la correction.
Après le SetwindowLong pour retirer le Caption, il faut impérativement modifier arbitrairement une des dimensions du UserForm (le Width par exemple +1 puis -1) pour actualiser ses valeurs de InsideWidth et InsideHeight. C'est ce qui m'a fait perdre des heures de recherche et de tests !
Le fait de modifier arbitrairement une des dimensions du UserForm agit comme un DrawMenuBar en grisant les parties du UserForm gagnées par la suppression du Caption.

Dudu2 · Lundi à 14:56

Désolé, encore un update mais c'est le tribut à payer pour des investigations en domaine sensible !

Partant du constat que la modification arbitraire d'une des dimensions du UserForm agit comme un DrawMenuBar j'ai ajouté un DrawMenuBar après le SetWindowLong qui a un effet équivalent permettant d'actualiser les valeurs de InsideWidth et InsideHeight.
Donc exit la modification arbitraire d'une des dimensions du UserForm !

Edit: Là je crois que j'en ai fini avec ce truc qui m'a bien occupé.

patricktoulon · Lundi à 15:00

re tien je l'ai mis à jour cette satanée liste de New Long

VB:

&H94C80080  --> Normal Caption

&H94CC0080  --> weightCaption(enlarge caption) (thème chez Dudu2)

&H94CD0080  --> weightCaption(enlarge caption)+bouton size(agrandir)

&H94C90080  --> NO weightCaption(NO enlarge caption)+bouton size(agrandir)

&H94CE0080  --> weightCaption(enlarge caption)+bouton reduire

&H94CA0080  --> NO weightCaption(NO enlarge caption)+bouton reduire

&H94CF0080  --> weightCaption(enlarge caption)+bouton size(agrandir)+bouton reduire+resize manuel(déformation)

&H94CB0080  --> NO weightCaption(NO enlarge caption)+bouton size(agrandir)+bouton reduire+resize PAS DE RESIZE MANUEL


&H94C80080  --> Normal Caption

&H94CC0080  --> weightCaption(enlarge caption)

&H94CD0080  --> weightCaption(enlarge caption)+bouton size(agrandir)

&H94C90080  --> NO weightCaption(NO enlarge caption)+bouton size(agrandir)

&H94CE0080  --> weightCaption(enlarge caption)+bouton reduire

&H94CA0080  --> NO weightCaption(NO enlarge caption)+bouton reduire

&H94CF0080  --> weightCaption(enlarge caption)+bouton size(agrandir)+bouton reduire+resize manuel(déformation)

&H94CB0080  --> NO weightCaption(NO enlarge caption)+bouton size(agrandir)+bouton reduire+resize PAS DE RESIZE MANUEL

&H94C00080  --> NO weightCaption(NO enlarge caption)pas de bouton dans la barre de titre

&H9408008066--> NO CAPTION (SUPPRIME LA BARRE DE TITRE)pas de cadre pas de barre de titre

&H140F0101  --> NO CAPTION 5pas de barre de titre mais le cadre et elasticié) (uniquement sur 2007 (sur W10 c'est mal redessinné))

&H1010080   --> NO weightCaption(NO enlarge caption)barre de titre et cadre facon  Old Windows(uniquement sur W7 et inférieur)

&H400100    --> NO weightCaption(NO enlarge caption) bouton et titre inversé avec le gwstyle(-20) demande u redrawmenur bar et la reduction (weight de la caption)

  --> NO weightCaption(NO enlarge caption)pas de bouton dans la barre de titre

&H9408008066--> NO CAPTION (SUPPRIME LA BARRE DE TITRE)pas de cadre pas de barre de titre

&H140F0101  --> NO CAPTION 5pas de barre de titre mais le cadre et elasticié) (uniquement sur 2007 (sur W10 c'est mal redessinné))

&H1010080   --> NO weightCaption(NO enlarge caption)barre de titre et cadre facon  Old Windows(uniquement sur W7 et inférieur)

&H400100    --> NO weightCaption(NO enlarge caption) bouton et titre inversé avec le gwstyle(-20) demande u redrawmenur bar et la reduction (weight de la caption)

donc ma vision des choses
1°appliquer le &H94C00080 qui normalise le weight de la barre de titre
setWindowLong hwnd,-16,&H94C00080

2°faire le calcul du inside (méthode que vous voulez(dwmapi.dll ou pas))

3°appliquer la suppression de la barre de titre avec le &H94C00080
setWindowLong hwnd,-16,&H94C00080

5°reporter le calcul pour le resize
oubliez drawmenubar elle ne fonctionne plus correctement depuis W7

voila là on sera tous a la même enseigne

ça m'a pris un peu de temps pour les re contrôler mais c'est bien pour tout le monde

ps:et pour info jean-marie a raison ton label rose est redimensionné
me semble t il te l'avoir déjà dit

alors @Dudu2 on le refait au propre ou pas ?

Dudu2 · Lundi à 15:22

ps:et pour info jean-marie a raison ton label rose est redimensionné
me semble t il te l'avoir déjà dit

On ne peut pas affirmer des choses sans les vérifier.
Exécute mon fichier du Post #23.

alors @Dudu2 on le refait au propre ou pas ?

Pour moi la question est réglée et parfaitement propre.
Exécute mon fichier du Post #23.

patricktoulon · Lundi à 16:25

re
@Dudu2
tu delire ou quoi?
serieux tu le vois pas que ton raisonnement n'est pas bon
pour commencer je vais augmenter la taille du userform dans VBE de 3fois rien juste pour la demo

allez maintenant j'essaie

1° des le depart à l'affichage normal on est pas bon et
ton control rose est toujours redimensionné
c'est pas grave on continu
on se retrouve à la fin avec la légère erreur de hauteur de userform (pas tellement grave en soit )
mais le controls non seulement est redimensionné mais il est déplacer d'un point ou 2 a vue humaine

maintenant je te fait une demo et tu va comprendre
je vais prendre un userform je vais l'afficher avec la barre de titre façon W11 (plus haute ) et je vais la ramener a un thème W10 et avant et apres on prend les dimension d'accords

est ce que tu comprends mieux le soucis là
les données sont les mêmes avant et après alors que l'on voit bien que le userform n'apas les même dimensions et pas la même caption

après tu fait comme tu veux je ne sait plus quoi te dire ou te montrer
bref ca marche presque on va pas chipoter mais je fais la même chose avec 3 fois rien
tiens je te laisse le classeur de test

Dudu2 · Lundi à 16:38

1° des le depart à l'affichage normal on est pas bon et
ton control rose est toujours redimensionné

Tu n'as pas vu qu'il est redimensionné intentionnellement avant le 1er affichage du UserForm ?
Pourquoi ? Tout simplement pour être sûr que sa base soit visuellement la base du UserForm (du .InsideHeight).

Ça n'a strictement rien à voir avec les manips ultérieures de suppression / rajout du Caption.
Par la suite, les chiffres démontrent qu'il ne bouge ni en Top ni en Height. C'est ça l'important.

VB:

    Unload UserForm1
  
    With UserForm1
        'Label1 occupe toute la largeur et la hauteur finale pour vérification visuelle
        .Label1.Left = 0
        .Label1.Width = .InsideWidth
        .Label1.Height = .InsideHeight - .Label1.Top
        .Label1.Caption = .Label1.Width
      
        'Affichage UserForm
        .Show vbModeless
        Do While GetActiveWindow = Application.hwnd
            DoEvents
        Loop

patricktoulon · Lundi à 17:16

re

Par la suite, les chiffres démontrent qu'il ne bouge ni en Top ni en Height. C'est ça l'important.

d'accords c'est donc mes y eux qui me joue des tours alors

non non il n'est pas redimensionner c'est un effet d'optique
oui oui le inside est bon c'est un effet d'optique
non non le control n'est pas déplacé là aussi c'est un effet d'optique

j'ai très bien compris que ce control était un point de repère ;je pense que tout le monde l'a compris
mais on voit bien que on voit plus sa bordure bottom donc déjà on est pas bon mais il est déplacé de pas grand chose certes mais tout de même déplacé et en tout ca redimensionné ça c'est sur alors oui comme tu met le userform en limite de fin juste en dessous ce control tu ne le vois pas mais quand on agrandit le userform on voit bien que l'on a un soucis
rassure moi tu vois bien ce que je vois
j'aurais plus confiance en toi si tu me sortais tes tartines habituelles avec les getwindowrect qu'avec cette méthode
je t'avoue je ne regarde pas le code je pense pas que ce soit nécessaire pour savoir que ce n'est pas une methode universelle
a tu seulement essayé(et je dis ça comme ça moi je ne l'ai pas fait) un setwindowpos avec le inside en pixel
juste en passant peutre un control avec un getwindowrect screen ou pas screen
ou carrément comme je le fait en macro4 mais avec les api déclarées en utilisant setwindowRgn
bref des solution il y en a il faut les testé
démonstration avec setwindowRgn mais en macro4(j'ai trop la flemme

t'en a pas mal encore a explorer crois moi
en tout cas certaines sont mieux que d'autres ça c'est sur

Dudu2 · Lundi à 18:05

Ce redimensionnement initial est comme tu dis un point de repère visuel et est d'autant plus utile que:
- chez toi il passe de 12 (définis dans le UserForm) à 15,75
- chez moi il passe de 12 (définis dans le UserForm) à 11,40
en fonction de je ne sais quel paramètre de contexte spécifique de l'environnement Windows / Office ou de taille initiale du UserForm.

Ça n'a pas d'importance, c'est juste un point repère. Ensuite ce qui compte c'est ce qu'il advient de ce point de repère lors des différentes étapes de suppression / rajout du Caption et la vérification par les chiffres que sa base .Top + .Height est toujours égale au .InsideHeight du UserForm dans ses différents états, ce qui est le cas, sauf évidemment avant la correction.

Bon, je ne sais pas pour toi, mais pour moi le problème est réglé dans mon fichier du Post #23.
Si tu as un autre fichier à proposer, je suis prêt à l'essayer.

Certes, tu peux utiliser des RECT de Window en API certainement, mais ça va compliquer les choses et encore pas sûr que ça marche car après le retrait du Caption, la fenêtre garde la même taille !
La correction ne peut utiliser que les différences des Inside avant et après, à condition qu'ils soient corrects, c.a.d après un DrawMenuBar ou une modification arbitraire d'une des dimensions du UserForm (ex. Width +1 puis Width -1) faite après le SetWinfowLong.

Edit: je vais d'ailleurs en faire une petite ressource pour garder le résultat de ces cogitations.

patricktoulon · Lundi à 19:10

allez je vais faire un effort
je vais travailler à la @Dudu2

les api tout bien comme il faut declarée et tout et tout
je vais traduire ma fonction macro4 ci dessous

VB:

'exemple la même (l'original)en macro4
' Sub NocaptionMacro4(usf)

'patricktoulon extrait du tutoriel patricktoulon  sur les api en macro4

'Dim insideRect As Long, ptopx#, InsideTop#, InsideLeft#, InsidWidth#, InsidHeight#, insideMarge#

'With ActiveWindow.ActivePane: ptopx = (.PointsToScreenPixelsX(72 / (.Parent.Zoom / 100)) - .PointsToScreenPixelsX(0)) / 72: End With

'insideMarge = Round((usf.Width - usf.InsideWidth) * ptopx) - 1

'InsideLeft = Round(((usf.Width - usf.InsideWidth) / 2) * ptopx)

'InsideTop = Round((usf.Height - usf.InsideHeight) * ptopx) - insideMarge

'InsidWidth = Round(usf.InsideWidth * ptopx) + InsideLeft

'InsidHeight = Round(usf.InsideHeight * ptopx) + InsideTop + insideMarge

'hWnd = ExecuteExcel4Macro("CALL(""user32"",""GetActiveWindow"",""JCC"")") 'api GetActiveWindow

'insideRect = ExecuteExcel4Macro("CALL(""gdi32"",""CreateRoundRectRgn"",""JJJJJJJ""," & InsideLeft & ", " & InsideTop & ", " & InsidWidth & ", " & InsidHeight & ", " & 0 & ", " & 0 & ")")

'ExecuteExcel4Macro ("CALL(""user32"",""SetWindowRgn"",""JJJJ""," & hWnd & ", " & insideRect & ", " & 1 & ")")

'ExecuteExcel4Macro ("CALL(""gdi32"",""DeleteObject"",""JJ""," & insideRect & ")")

'End Sub

voyons ce que ça donne avec les api tout bien à la @dudu2

punaise c'est un effort surhumain pour moi

VB:

Declare PtrSafe Function SetWindowRgn Lib "user32" (ByVal hWnd As LongPtr, ByVal hRgn As LongPtr, ByVal bRedraw As Long) As Long
Declare PtrSafe Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As LongPtr
Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Const SM_CXBORDER = 5
Const SM_CYBORDER = 6
Const SM_CYCAPTION = 4
Const SM_CXDLGFRAME = 7

Sub NocaptionApi(usf)
   'exemple edited by patricktoulon 2024 for exceldownloads
    Dim insideRect As Long, ptopx#, InsideTop#, InsideLeft#, InsidWidth#, InsidHeight#, insideMarge#, CX_Border&
    Dim CaptionBar&, CXDLG_FRAME&
   
    ptopx = 0.75 ' prend la méthode que tu veux  pour le coeff pixel ici

    CX_Border = GetSystemMetrics(SM_CXBORDER) 'dimension fine bordure

    CaptionBar = GetSystemMetrics(SM_CYCAPTION) 'dimension caption

    CXDLG_FRAME = GetSystemMetrics(SM_CXDLGFRAME) * 2 'dimension thickframe (grosse bordure)

    insideMarge = Round((usf.Width - usf.InsideWidth) / ptopx) - CX_Border '.zero a partir du quel on commence la region
   
    InsideLeft = CXDLG_FRAME 'left de la region(point zero left du inside)

    InsideTop = Round((CaptionBar + CXDLG_FRAME + CX_Border)) - insideMarge 'top de la region(=.zero top  du inside)

    InsidWidth = Round(usf.InsideWidth / ptopx) + InsideLeft 'largeur de la region

    InsidHeight = Round(usf.InsideHeight / ptopx) + InsideTop + insideMarge - CX_Border * 2 'hauteur de la region

    hWnd = FindWindow(vbNullString, usf.Caption) 'handle de la fenêtre

    insideRect = CreateRoundRectRgn(InsideLeft, InsideTop, InsidWidth, InsidHeight, 0, 0) 'creation du rectangle

    SetWindowRgn hWnd, insideRect, 1 'application de la region rectangle sur l'userform

    DeleteObject insideRect ' libère l'object rect de gdi
End Sub

hoh que c'é bo!
allez on teste

ho punaise j'en ai le vertige tellement j'ai trop fait propre

je vais vite oublier sinon je vais rester traumatisé

faut bien que l'on se marre un peu non

allez @Dudu2 c'est kado
et si je me suis trompé dans le choix des constante ben .....tu a la même bible que moi me semble t il

punaise je vais mettre un moment a m'en remettre de faire aussi propre

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

Dudu2

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Window Styles (Winuser.h) - Win32 apps

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Pièces jointes

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Pièces jointes

Discussions similaires