Resize une form sans clignotement moche

Soyez le premier à donner votre avis sur cette source.

Vue 8 212 fois - Téléchargée 651 fois

Télécharger le projet
Commenter

Description

Quand je veus limiter la taille minumum d'une form, j'utilise l'evenement Form_Resize et je change la taille de la form a ce moment-la. OK, mais ca fait super moche quand l'utilisateur deplace la sourie au-dessus de la form pendant qu'il la resize.
Cette pitite source propose une solution simple pour eviter ca en simulant le relachement du bouton gauche de la sourie et en deplacant le pointeur au niveau de la bordure.
C plus facile a comprendre avec le zip.

Source / Exemple : 


'##########################################################
' par LuTo
' mail: ltousch@yahoo.com
' site: http://ltousch.freeservers.com ' rien a voir avec la prog, mais bon
' merci a Jeromax et Fabiin pour leurs codes sur les manipulations de sourie
'##########################################################

'Declare les API
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Function SetCursorPos& Lib "user32" (ByVal x As Long, ByVal y As Long)
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'Declare le type utilise pour GetCursorPos
Private Type POINTAPI
        x As Long
        y As Long
End Type
'Declare les constantes a utiliser avec mouse_event. ici, on s'en sert que de 2 mais bon
Const MOUSEEVENTF_ABSOLUTE = &H8000
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const MOUSEEVENTF_MIDDLEDOWN = &H20
Const MOUSEEVENTF_MIDDLEUP = &H40
Const MOUSEEVENTF_MOVE = &H1
Const MOUSEEVENTF_RIGHTDOWN = &H8
Const MOUSEEVENTF_RIGHTUP = &H10
Const MOUSEEVENTF_WHEEL = &H80
Const MOUSEEVENTF_XDOWN = &H100
Const MOUSEEVENTF_XUP = &H200
Const WHEEL_DELTA = 120
Const XBUTTON1 = &H1
Const XBUTTON2 = &H2

'variables et constantes utilisateur
Private Pos As POINTAPI
Const LargeurMin = 3255
Const HauteurMin = 2880

Private Sub Form_Resize()
  Dim Diff As Integer
  
  With Me
    ' si la form est minimisee, pas d'operation
    If .WindowState = vbMinimized Then Exit Sub
    
    ' si la largeur et la hauteur minimums sont
    ' atteintes, termine le resize en simulant
    ' le relachement du bouton gauche (c plus joli)
    If .Width < LargeurMin And .Height < HauteurMin Then
      Call mouse_event(MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
    End If
    
    'obtient la position absolue de la sourie
    GetCursorPos Pos
    
    ' si la largeur minimum est atteinte, on
    ' repositionement la sourie au niveau de la
    ' bourdure de la form grace a l'API
    If .Width < LargeurMin Then
      SetCursorPos Pos.x + (LargeurMin - .Width) / 15, Pos.y
      .Width = LargeurMin
    End If
    
    ' de meme pour la hauteur de la form
    If .Height < HauteurMin Then
      SetCursorPos Pos.x, Pos.y + (HauteurMin - .Height) / 15
      .Height = HauteurMin
    End If
  End With
End Sub

Conclusion :


Bien sur, ce code n'a d'interet que si l'option "afficher le contenu de la fenetre pendant qu'on la deplace" est activee dans Windoz.
Merci a Jeromix et Fabiin pour leurs codes sur les manipulations de sourie
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
rebixav Messages postés 130 Date d'inscription dimanche 16 décembre 2007 Statut Membre Dernière intervention 28 janvier 2013
4 déc. 2012 à 13:57
Bon ben moi c'est 100% = ok avec une seul astuce, (la tienne LuTo)
"Cette pitite source propose une solution simple pour eviter ca en simulant le relachement du bouton gauche de la sourie"
et rien d'autre !
soit :

Public Declare Sub mouse_event Lib "user32" (ByVal dwflags As Long, _
ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, _
ByVal dwExtraInfo As Long)
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Type POINTAPI
X As Long
Y As Long
End Type

Dim position_souris As POINTAPI
GetCursorPos position_sourisX% position_souris.X: Y% position_souris.Y
Call mouse_event(MOUSEEVENTF_LEFTUP, X%, Y%, 0, 0) 'on relache le bouton

en faite dés le relâchement du clic gauche de la souris le redimensionnement s'arrete !
et cela marche aussi bien au haut que en bas, à gauche et à droite !!!

en faite moi j'ai même utilisé qu'une seul ligne, puisque j'ai déjà une procédure qui s'occupe de la gestion de la souris !

...

Private Sub Form_Resize()
ecran.Top Client_poste.Top + Client_poste.Height + 5: ecran.Left 5
If zz_CD.Width \ Screen.TwipsPerPixelY < ecran.Left + 200 Then zz_CD.Width = (ecran.Left + 200) * Screen.TwipsPerPixelY: choix% = 1
If zz_CD.Height \ Screen.TwipsPerPixelY < ecran.Top + 150 + Stop_clavier_souris.Height Then zz_CD.Height = (ecran.Top + 150 + Stop_clavier_souris.Height) * Screen.TwipsPerPixelY: choix% = 1
If choix% = 1 Then Sendmouse , , Relache_gauche_: Exit Sub '<<<<<<<<<<<<<<<<<<<<< elle est là !!!!
...
...
...
etc.

a plus les petites souris :)
cs_BadNews Messages postés 98 Date d'inscription samedi 30 novembre 2002 Statut Membre Dernière intervention 10 septembre 2007 1
6 juin 2004 à 09:17
Cool, merci!

Pour enlever complètement les clignotements, remplacez:


If .Width < LargeurMin And .Height < HauteurMin Then
Call mouse_event(MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
End If


par:

If .Width < LargeurMin Or .Height < HauteurMin Then
Call mouse_event(MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
End If


Bref, remplacez le "And" par "Or"

Ça éviteras les clignotements. Cepandant, si la largeur arrive à sa limit et que l'hauteur (ou vise verça) n'y est pas, l'évènement MOUSSEEVENTF_ABSOLUTE auras lieu donc le bouton de la sourie seras relâché.

Je trouve ça toujours mieux que le clignotement.

Merci encore.
cs_ramg Messages postés 14 Date d'inscription vendredi 6 juin 2003 Statut Membre Dernière intervention 6 février 2006
16 avril 2004 à 17:29
Excellent pile poil ce qu'il me fallait

Chez moi ça 'clignote' encore quand je resize sur la largeur ou la hauteur. Cependant quand je resize à partir du coin bas à droite pas de prob.
jockos Messages postés 321 Date d'inscription dimanche 22 octobre 2000 Statut Membre Dernière intervention 14 mai 2005 2
9 avril 2003 à 03:06
ouais, j'ai proposé une nouvelle source, qui améliore grandement cela...
C'est du vrai Resizing... il ne faut pas utiliser la méthode de l"évenement Resize d'une forme, mais utiliser la technique de sous-classement, c'est à dire intercepter directempent le message qui arrive à Windows comme quoi la fenetre est redimensionné...
cs_Jack Messages postés 14006 Date d'inscription samedi 29 décembre 2001 Statut Modérateur Dernière intervention 28 août 2015 78
8 avril 2003 à 19:47
Nota :
Cette méthode ne fonctionne que si vous redimensionnez vos feuilles en les tirant par les bords droit (pour la largeur) et bas (pour la hauteur).
Si vous utilisez les bords gauche ou du haut, votre forme fait un bond !

vala
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_LuTo)