Redimension de controles en fonction de la taille de la feuille

Soyez le premier à donner votre avis sur cette source.

Vue 4 788 fois - Téléchargée 456 fois


Description

ce module permet de redimmensionner CERTAINS controles (car je ne voulais lme faire pour tous...) lorsque l'on modifie la taille d'une fenetre. Il a l'avantage de focntionner aussi pour les MDI.

Source / Exemple :


'appelle des fonctions:
'--------------------------------------------------------------------------------------------
'fonction Charge_Size
'
'placer le code suivant dans l'évenement Load de la feuille:
'Charge_Size Me, 0
'Me.Height = 'hauteur de la feuille désirée au chargement
'Me.Width = 'largeur de la feuille désirée au chargement
'Charge_Size Me, 0
'
'placer le code suivant dans l'évenement Activate de la feuille:
'Charge_Size Me, 1
'
'placer le code suivant dans l'évenement QueryUnload de la feuille:
'Charge_Size Me, 2
'--------------------------------------------------------------------------------------------
'fonction F_Resize
'placer le code suivant dans l'évenement QueryUnload de la feuille:
'F_Resize Me
'--------------------------------------------------------------------------------------------
'attention pour les ListBox il faut forcer le paramètre IntegralHeight à False

Global F_Size(20) As F_Dimension
Global Flag_Size As Integer
Global Event_Info As EventInfo
Global Flag_Load As Boolean

Public Type F_Dimension
    Name As String
    Hauteur As Integer
    Largeur As Integer
    H_Default As Integer
    L_Default As Integer
    H_Last As Integer
    L_Last As Integer
End Type

Public Function Charge_Size(Controle As Form, Event_Info As Integer)

    Dim i As Integer
    
    i = 0
    On Error GoTo Erreur
    
    If Event_Info = 0 Then
            If Flag_Size <> 0 Then
                Flag_Size = 0
            Else
                Flag_Load = True
            End If
    ElseIf Event_Info = 1 Then
        If Flag_Load = True Then
            Flag_Load = False
            F_Size(0).Name = Controle.Name
            F_Size(0).H_Default = Controle.Height
            F_Size(0).L_Default = Controle.Width
            Do Until F_Size(i).Name = ""
                i = i + 1
            Loop
            F_Size(i).Name = F_Size(0).Name
            F_Size(i).H_Default = F_Size(0).H_Default
            F_Size(i).L_Default = F_Size(0).L_Default
            Flag_Size = Flag_Size + 1
        Else
            F_Size(0).Name = Controle.Name
            i = 1
            Do Until F_Size(i).Name = F_Size(0).Name
                i = i + 1
            Loop
            F_Size(0).H_Default = F_Size(i).H_Default
            F_Size(0).L_Default = F_Size(i).L_Default
            Flag_Size = Flag_Size + 1
        End If
    ElseIf Event_Info = 2 Then
        i = 1
        Do Until F_Size(i).Name = Controle.Name
            i = i + 1
        Loop
        F_Size(i).Name = ""
        F_Size(i).H_Default = 0
        F_Size(i).L_Default = 0
        Controle.Height = F_Size(0).H_Default
        Controle.Width = F_Size(0).L_Default
        F_Resize Controle
    End If
    
    F_Size(0).H_Last = Controle.Height
    F_Size(0).L_Last = Controle.Width
    F_Size(0).Hauteur = Controle.Height
    F_Size(0).Largeur = Controle.Width

    Exit Function

Erreur:
    Controle.Hide
    Controle.WindowState = 0
    Resume
    
End Function

Public Function F_Resize(Controle As Form)
    
    If Flag_Size <> 0 Then
    
        If Controle.Height <= 360 Then
            F_Size(0).Hauteur = F_Size(0).H_Last
            F_Size(0).Largeur = F_Size(0).L_Last
            Exit Function
        End If
        
        If Controle.Height < F_Size(0).H_Default Then
           Controle.Height = F_Size(0).H_Default
        End If
        If Controle.Width < F_Size(0).L_Default Then
            Controle.Width = F_Size(0).L_Default
        End If
        
        On Error Resume Next
        
        Dim Resiz As Double
        
        For Each Control In Controle
            If TypeOf Control Is CommandButton Or TypeOf Control Is TextBox Or TypeOf Control Is Frame Or TypeOf Control Is ListBox Or TypeOf Control Is OptionButton Or TypeOf Control Is CheckBox Then
                Resiz = Controle.Height / F_Size(0).Hauteur
                Control.Top = Control.Top * Resiz
                Control.Height = Control.Height * Resiz
                Resiz = Controle.Width / F_Size(0).Largeur
                Control.Left = Control.Left * Resiz
                Control.Width = Control.Width * Resiz
                'If (TypeOf control Is CommandButton Or TypeOf control Is Frame Or TypeOf control Is OptionButton) And (Controle.Width <> F_Size.Largeur) And (Controle.Height <> F_Size.Hauteur) Then
                '    control.Font.Size = control.Font.Size * Resiz
                'End If
                'MsgBox control
            Else
                'Resiz = Controle.Height / F_Size.Hauteur
                'control.Height = control.Height * Resiz
                'Resiz = Controle.Width / F_Size.Largeur
                'control.Width = control.Width * Resiz
            End If
        Next
        F_Size(0).H_Last = Controle.Height
        F_Size(0).L_Last = Controle.Width
        F_Size(0).Hauteur = Controle.Height
        F_Size(0).Largeur = Controle.Width
    End If
    
End Function

Conclusion :


si besoin envoyez moi un message : yomm
le module peut également etre télécharger en zip

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
1
Date d'inscription
mardi 20 janvier 2009
Statut
Membre
Dernière intervention
20 janvier 2009

bonjour !

J'ai essayé votre code mais je rencontre un pb pour ajouter les lignes dans queryunload. Je ne trouve pas cet emplacement...

Pourriez vous m'aider ? Avez vous une base Access avec votre code opérationnel sur un petit formulaire avec qq controles ?

Merci Beaucoup
Fredddo038
Messages postés
466
Date d'inscription
samedi 16 février 2002
Statut
Membre
Dernière intervention
20 avril 2007

Ya ça aussi, pour redimensionner les contrôles, ça marche avec tout sauf avec les "tabbed dialog" (pis c'est de moi aussi ;p !!!) :

http://www.vbfrance.com/article.aspx?Val=3436

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.