Méthode zoom sur une form (et ses contrôles)

Soyez le premier à donner votre avis sur cette source.

Vue 8 220 fois - Téléchargée 926 fois

Description

Bah je savais pas quoi faire au boulot aujourd'hui, donc j'ai fait une class pour faire
un zoom sur une Form (et ses contrôles). (Un peu comme en VBA, un UserForm possède la méthode Zoom)

En fait je ne gère que le placement et la taille des contrôles, le texte, lui, n'évolue pas.
[Je regarde pour ça ce que je peux faire]

Source / Exemple :


Code de la Form "exemple" :

Option Explicit

Private Sub Form_Load()
' On instancie les coordonnées de la Form et de ses contrôles en vue du Zoom
    With sbMain
        Call .MyControls.AddAll(Me)  ' ajoute tout un tas de controls situé sur la Form
        Call .MyControls.Delete("VScroll1")
        'Call .MyControls.Delete("Text1") ' pour tester
        ' ici on ne prend pas en compte le VScroll1, il ne sera donc pas redimensionné
    End With
    
    Call PropertyZoom.Ini_Classe(Me)
End Sub

Code de la Classe :

Option Explicit

Private AfSize          As New AfCls_StringSize

Private lFormHeight     As Long
Private lFormWidth      As Long

Private lCtlTop()       As Long
Private lCtlLeft()      As Long
Private lCtlHeight()    As Long
Private lCtlWidth()     As Long

Private lHeight         As Long
Private lWidth          As Long

Public Sub Zoomed(ByVal oForm As Object, ByVal ValZoom As Integer)
' *** Pas très compliqué, ce ne sont que des "maths"  ;)

        Dim ctl As Control, oObj As Object
        Dim emp As MyControl
        Dim iRet As Integer, iIndex As Integer

    iIndex = 0
    
    With oForm
        lHeight = .Height: .Height = lFormHeight / 100 * ValZoom
        lWidth = .Width: .Width = lFormWidth / 100 * ValZoom
    End With

On Local Error Resume Next

    For Each ctl In oForm.Controls
        With ctl
            For Each emp In sbMain.MyControls
                If .Name = emp.ID Then
                    
                    If TypeOf ctl Is Line Then
    '                   gestion des Lines
                        .Y1 = lCtlTop(iIndex) / 100 * ValZoom
                        .X1 = lCtlLeft(iIndex) / 100 * ValZoom
                        .Y2 = lCtlHeight(iIndex) / 100 * ValZoom
                        .X2 = lCtlWidth(iIndex) / 100 * ValZoom
                    ElseIf TypeOf ctl Is StatusBar Then
                        .Top = lCtlTop(iIndex) / 100 * ValZoom
                        '.Left = lCtlLeft(iIndex) / 100 * ValZoom      ** lecture seule
                        .Height = lCtlHeight(iIndex) / 100 * ValZoom
                        '.Width = lCtlWidth(iIndex) / 100 * ValZoom    ** lecture seule
                    Else
                        .Top = lCtlTop(iIndex) / 100 * ValZoom
                        .Left = lCtlLeft(iIndex) / 100 * ValZoom
                        .Height = lCtlHeight(iIndex) / 100 * ValZoom
                        .Width = lCtlWidth(iIndex) / 100 * ValZoom
                    End If
                    Err.Clear
                    
                    If TypeOf ctl Is CommandButton Or TypeOf ctl Is CheckBox Or TypeOf ctl Is Frame Or TypeOf ctl Is ListBox Or TypeOf ctl Is OptionButton Or TypeOf ctl Is RichTextBox Or TypeOf ctl Is TextBox Then
'               limitation de la refonte de la taille du texte QUE pour certains
'               controls, car le rendu n'est bien que pour les controles de bases
                    
                        With AfSize
                            .Text = ctl.Text
                            If Err.Number = 438 Then .Text = ctl.Caption: Err.Clear
                            .Font = ctl.Font
                            iRet = .GetFontSize(ctl.Width - 120, ctl.Height - 120)
                            ctl.FontSize = iRet
                            ctl.Text = .Text
                            If Err.Number = 438 Then ctl.Caption = .Text: Err.Clear
                        End With
                    End If
                        
                    iIndex = iIndex + 1
                End If
            Next emp
        End With
    Next ctl
End Sub

Public Sub Ini_Classe(oForm As Form)
' *** Pour récupérer les valeurs Initiales de chaques controles, pour servir de
'     base dans la procédure Zoomed
        Dim ctl As Control, iIndex As Integer, oObj As Object
        Dim emp As MyControl
        
    iIndex = 0
        
    lFormHeight = oForm.Height
    lFormWidth = oForm.Width
    
'On Error Resume Next
    
    For Each ctl In oForm.Controls
        With ctl
            For Each emp In sbMain.MyControls
                If .Name = emp.ID Then
            
                    ReDim Preserve lCtlTop(iIndex): ReDim Preserve lCtlLeft(iIndex)
                    ReDim Preserve lCtlHeight(iIndex): ReDim Preserve lCtlWidth(iIndex)
            
            
                    If TypeOf ctl Is Line Then
    '                   gestion des Lines
                        lCtlTop(iIndex) = .Y1
                        lCtlLeft(iIndex) = .X1
                        lCtlHeight(iIndex) = .Y2
                        lCtlWidth(iIndex) = .X2
                        Err.Clear
                    Else
                        lCtlTop(iIndex) = .Top
                        lCtlLeft(iIndex) = .Left
                        lCtlHeight(iIndex) = .Height
                        lCtlWidth(iIndex) = .Width
                    End If
            
                    iIndex = iIndex + 1: Exit For
                End If
            Next emp
        End With
    Next ctl
On Error GoTo 0
End Sub

Conclusion :


Si ça peut profiter à quelqu'un, ça me fera plaisir. ;)
(perso, j'en ai pas l'utilité)

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
16
Salut StephVBF,

pas besoin en VBA, les UserForm sont dotés de la méthode Zoom.
(Me.Zoom = 120) par exemple, t'augmente la taille de 20 %

Si tu veux un exemple (mais le mieux c'est d'essayer) télécharge mon annuaire Excel :
http://www.vbfrance.com/codes/ANNUAIRE-AVEC-OPTIONS_36986.aspx

@++
Messages postés
21
Date d'inscription
jeudi 4 avril 2002
Statut
Membre
Dernière intervention
3 juin 2008

bonjour Mortalino,

si je comprends bien, tu avais fait ça sous VBA avant ! Tu aurais le code, svp ?
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
16
Thanks ! ;)
Messages postés
1
Date d'inscription
mardi 15 mai 2007
Statut
Membre
Dernière intervention
15 mai 2007

well
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
16
Merci pour le tableau typé ;)

Sinon, pour les coordonées, je suis (je pense) obligé de travailler avec les coordonnées d'origines, cela n'aurait pas été génant en cas "d'un seul" Zoom pendant que l'appli tourne, mais au delà, ça devient désatreux.

Je change les tableaux ^^
@++ ;)
Afficher les 18 commentaires

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.