Discussion :

[Tortille]

Bonjour,

Je redimensionne le Form avec le code suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Private Sub Form_Resize()
    If Me.InsideWidth < 9000 Then
        Me.InsideWidth = 9000
    End If
    If Me.InsideHeight < 5000 Then
        Me.InsideHeight = 5000
    End If
End Sub

Peut-on désactiver automatiquement le bouton de la souris dès que la dimension minimum est atteinte pour éviter le scintillement du formulaire à ce moment là ?

Ou bien, quitter l'évènement Form_Resize ?

Merci pour votre aide

[marot_r]

Bonjour.

Essaye :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Form_Resize()
 
    if Me.InsideWidth=9000 and Me.InsideHeight = 5000
        exit sub
    end if
 
    If Me.InsideWidth < 9000 Then
        Me.InsideWidth = 9000
    End If
    If Me.InsideHeight < 5000 Then
        Me.InsideHeight = 5000
    End If
End Sub

A+

[Tortille]

Aucun changement avec mon code
Il faut une fonction qui lâche le bouton gauche de la souris malgré que mon doigt soit encore appuyé.
C'est un peu contre nature ...

Merci pour ton aide.

[marot_r]

OK, as-tu essayé d'appeler du code sur l'événement souris appuyée ?

A+

[Arkham46]

Bonjour,

A tester : releaseCapture, à déclarer ainsi :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Private Declare Sub ReleaseCapture Lib "user32" ()

Je n'ai pas fait le test mais je ne vois pas autre chose.

[Tortille]

OK, as-tu essayé d'appeler du code sur l'événement souris appuyée ?

Bien sûr, mais ça marche pas, je suis sur le cadre redimensionnable du Formulaire, et non dans le Formulaire.

Je sais pas si tu as vu mais le code Form_Resize est joué 2 fois quand le formulaire est dimensionné à 9000.

j'ai essayé un truc en changeant la position du pointeur quand il arrive à la taille mini. Voici le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
'dans un module
'Type Point pour localiser la souris
Public Type POINTAPI
    xPos As Long
    yPos As Long
End Type
 
' Access the GetCursorPos function in user32.dll
Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
' Access the SetCursorPos function in user32.dll
Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
 
'dans le formulaire
Private Sub Form_Resize()
Dim CursorPos As POINTAPI
Static xCursorPosIni As Boolean
Static yCursorPosIni As Boolean
Static xCur As Long, yCur As Long
 
    If Me.InsideWidth < 9000 Then
        If xCursorPosIni = False Then
            Me.InsideWidth = 9000
            GetCursorPos CursorPos
            xCur = CursorPos.xPos
            yCur = CursorPos.yPos
        End If
        xCursorPosIni = True
        SetCursorPos xCur, yCur
        'Debug.Print xCursorPosIni, CursorPos.xPos, CursorPos.yPos, xCur, yCur
        Exit Sub
    Else
        xCursorPosIni = False
        Exit Sub
    End If
 
'    If Me.InsideHeight < 5000 Then
'        If yCursorPosIni = False Then
'            Me.InsideHeight = 5100
'            GetCursorPos CursorPos
'        End If
'        yCursorPosIni = True
'        SetCursorPos CursorPos.xPos, CursorPos.yPos
'        Exit Sub
'    Else
'        yCursorPosIni = False
'        Exit Sub
'    End If
End Sub

Je m'occupe ici que de la largeur, si ça fonctionne, j'étendrais à la hauteur.

il y a des problèmes quand la souris est déplacée trop vite, ça va plus petit que 9000 et puis pour agrandir quand la taille mini est atteinte, il faut bouger rapidement la souris pour "berner" le code qui bloque, en fait la vitesse de la souris dérange dans un sens mais dans l'autre sens, elle vient bien.
En voyant ces problèmes je me demande si c'est réalisable car je n'ai plus de prise quand je suis en largeur mini pour
après agrandir si je n'ai plus la vitesse de la souris pour me sortir là.

Bien cordialement

[marot_r]

Bonjour.

Sugestion de contournement.

Faire un bouton "Reset Size" (en haut à gauche) qui ramène ton formulaire à sa taille idéale.
Si l'utilisateur veux faire plus petit libre à lui mais sinon il appuit sur le bouton et voilà.

A+

[Tortille]

Bonjour Arkham46,

j'ai mis ton code comme ça dans le formulaire, mais je ne sais pas si c'est comme il faut :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Option Compare Database
Option Explicit
Private Declare Sub ReleaseCapture Lib "user32" ()
 
Private Sub Form_Resize()
    If Me.InsideWidth < 9000 Then
        Me.InsideWidth = 9000
        Call ReleaseCapture
    End If
End Sub

parce que ça lâche bien la souris, mais ça n'enregistre pas la largeur à 9000 dommage, le formulaire retrouve sa taille initiale alors que la souris l'avait amené à 9000.

Merci encore

[marot_r]

Bonjour.

Par curiosité j'ai essayé aussi et en effet le formulaire revient à sa taille initiale même si le code s'éxécute bien.

On dirait que le code qui se produit dans le OnResize est excuté puis écrasé.
Les valeurs sont bien assignées au formulaire dans le code.

Si on fait un move à l'extérieur (dans la fenêtre d'exécution immédiate), le move est appliqué et le code de redimensionnement est là aussi inéficasse.

Très étrange.

A+

[Arkham46]

Bonjour,

Oui ça revient à taille d'origine.
J'image qu'il y a un redimensionnement sur MouseMove, puis un redimensionnement final sur MouseUp.
Il faut de toute façon forcer un redimensionnement à la taille mini demandée.
En effet le redimensionnement n'est pas continu et on peut lâcher la souris sur une taille très inférieure au mini.

Eviter les InsideWidth et InsideHeight, ils ne sont pas fiables (les barres de défilement réduisent la taille intérieure; quand on agrandit puis rétrécit le formulaire, la taille intérieure peut ne plus pouvoir être modifiée car les éléments contenus ont été agrandits...).
Il est préférable de travailler avec WindowWidth et WindowHeight pour lire la taille de la fenêtre complète, et effectuer les redimensionnements avec la méthode Move.
Il faut également faire attention aux conversions twips/pixels :
si par exemple je défini une taille mini à 5000, lorsque je redimensionne à 5000 alors je me retrouve avec une taille de 4995 (parce que j'ai un rapport de 15 entre twips et pixels sur mon PC et que 5000 n'est pas un multiple de 15)
ensuite je me retrouve donc avec une taille inférieure à la taille mini et le test d'infériorité est vrai alors que j'attends une égalité
du coup on doit après redimensionnement par le code à la taille mini, relire la taille réelle obtenue et utiliser cette nouvelle taille mini pour la comparaison avec la taille courante

L'exemple ci-dessous fonctionne sur 2007.
Mettre 0 dans cMinWidth ou cMinHeight si on ne souhaite pas de taille mini sur un des axes.

J'ai mis également un forçage à la dimension mini à l'ouverture du formulaire (au cas où ça s'ouvre plus petit et qu'ensuite on ne puisse plus agrandir).
Sans ça il faudrait vérifier à chaque redimensionnement si on réduit on si on agrandit pour ne pas être bloqué avec un formulaire trop petit qu'on ne peut plus agrandir.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function ReleaseCapture Lib "user32" Alias "ReleaseCapture" () As Long
#Else
Private Declare Function ReleaseCapture Lib "user32" () As Long
#End If
 
' Sur redimensionnement du formulaire
Private Sub Form_Resize()
Const cMinWidth = 9000 ' Largeur mini en twips
Const cMinHeight = 5000 ' Hauteur mini en twips
Static sNotFirstResize As Boolean ' Flag pour premier resize à l'ouverture
Static sbFlagWidth As Boolean ' Flag = La largeur mini a été "dépassée"
Static sbFlagHeight As Boolean ' Flag = La hauteur mini a été "dépassée"
Static sMinWidth As Integer ' Largeur mini recalculée en twips
Static sMinHeight As Integer ' Hauteur mini recalculée en twips
' Initialise les largeurs et hauteurs mini à partir des constantes
If sMinWidth = 0 Then sMinWidth = cMinWidth
If sMinHeight = 0 Then sMinHeight = cMinHeight
' Si on avait détecté une taille trop petite lors du dernier resize
If sbFlagWidth Or sbFlagHeight Then
    ' Trop petit en largeur
    If sbFlagWidth Then
        ' On retire le flag
        sbFlagWidth = False
        ' On redimensionne le formulaire à la taille mini
        Me.Move Me.WindowLeft, , sMinWidth
        ' On met à jour avec la taille mini réelle
        sMinWidth = Me.WindowWidth
    End If
    ' Trop petit en hauteur
    If sbFlagHeight Then
        ' Même chose que la largeur
        sbFlagHeight = False
        Me.Move Me.WindowLeft, , , sMinHeight
        sMinHeight = Me.WindowHeight
    End If
    ' Et on sort de ce resize
    Exit Sub
End If
' Flags si on a une taille trop petite
sbFlagWidth = sMinWidth > 0 And Me.WindowWidth < sMinWidth
sbFlagHeight = sMinHeight > 0 And Me.WindowHeight < sMinHeight
If sbFlagWidth Or sbFlagHeight Then
    ' Trop petit => on "libère" la souris
    ReleaseCapture
    ' Si on redimensionne à la souris, Resize va se redéclencher et fera la redimensionnement final
    ' Sinon c'est le premier resize appelé à l'ouverture
    If Not sNotFirstResize Then
        ' On demande un redimensionnement pour s'assurer que le formulaire à la taille mini à l'ouverture
        Form_Resize
        ' Et on flag pour ne le faire qu'une fois
        sNotFirstResize = True
    End If
End If
End Sub

[Tortille]

Bonjour,
j'ai trouvé à partir de la piste du ReleaseCapture une idée :

comme le ReleaseCapture restitue les coordonnées du pointeur au click de Form_Resize
il doit être possible de le berner en capturant les coordonnée au moment du "Me.InsideWidth = 9000"
puis d'affecter ces coordonnées au pointeur
et finalement de ReleaseCapture

Il y a deux autres fonctions qui pourraient convenir :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetCapture Lib "user32" () As Long

J'ai donc essayé ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Option Compare Database
Option Explicit
 
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function GetCapture Lib "user32" () As Long
 
 Private FrameHwnd As Long
 
 Private Function GetFrameHwnd() As Long
 Dim CursorPos As POINTAPI
 GetCursorPos CursorPos
 GetFrameHwnd = WindowFromPoint(CursorPos.xPos, CursorPos.yPos)
 End Function
 
Private Sub Form_Resize()
 
    If Me.InsideWidth = 9000 Then
        Call ReleaseCapture
    End If
 
    If Me.InsideWidth < 9000 Then
        GetCapture
        SetCapture (GetFrameHwnd)
        Me.InsideWidth = 9000
    End If
End Sub

mais c'est inefficace.

Merci d'avance pour vos idées.

[Tortille]

Bonjour,

Arkham46 nos messages se sont croisés , je mets trop longtemps pour répondre !

Parfait ton code, je vais l'adapter car je redimensionne à l'ouverture du formulaire donc aucun risque qu'il soit plus petit que les tailles mini.

J'avais changé les dimensions en 6000 et 9000 pour être raccord avec les twips.
C'est vrai que les ascenseurs posaient problème, mais tant que je bloquais, je ne m'en occupais pas, l'ascenseur fait autour des 75 twips.

Je vais t'écouter pour les InsideWidth et WindowWidth parce que c'est souvent galère.

Je te remercie infiniment, mais il faut que je comprenne comment tu as fais pour que les dimensions mini soient prisent en compte avant que le ReleaseCapture les annule.

Et dés que j'ai tout pigé je marque Résolu.

Grand merci.

[Tortille]

Bonjour,
Encore merci à Arkham46 et marot_r pour votre temps, vos idées, et vos solutions.
Pour les lecteurs suivants, j'ai noté un Not en trop à la ligne 46

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
46 If Not sNotFirstResize Then
' enlever le Not
46 If sNotFirstResize Then

Bien cordialement

Résolu

[Arkham46]

Pour les lecteurs suivants, j'ai noté un Not en trop à la ligne 46

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
46 If Not sNotFirstResize Then
' enlever le Not
46 If sNotFirstResize Then

Il n'est pas en trop.
Double négation pour détecter le premier appel.
Sinon autant enlever tout le bloc if..endif, il ne sert plus à rien.

[Tortille]

Bonjour,

Arkham46, j'ai levé le Not car au premier redimensionnement qui atteint le minimum, et donc passe par le ReleaseCapture, le formulaire revient à la taille avant ce redimensionnement. Aux redimensionnements suivants sans quitter le formulaire ça marche au Top.

Et donc comme tu le dis, le bloc ne sert plus a rien, alors je vient de le passer en remarque et ça marche très bien.

Bien Cordialement