Canevas (P2)

..suite de Canevas (P1)

Dans cette seconde partie, nous allons offrir à ce code (que nous ne modifierons que très peu) une IHM (interface humain-machine) un peu plus digne d’un programme "professionnel"..

L'IHM en fonctionnement.

Nous allons la construire pas à pas

Commencez par faire une copie du .DOC obtenu dans la première partie. Dans l'éditeur VBA, affichez au besoin l'explorateur de projets et la fenêtre propriétés. Faîtes un clic droit dans l'explorateur de projets, et ajoutez une UserForm. Via la propriété "(name)" appelez-la "UF1". Donnez-lui un titre (Caption) et une couleur de fond (BackColor). Redimensionnez-la via son coin inférieur droit.

Créez un "cadre (frame)" (via la Boîte à Outils), nommez_le "F_1", intitulez-le " Paramètrage ". Dupliquez-le par Copier-Coller pour générer "F_2" intitulé " Créer le Canevas ". Créer (sans les renommer) les 5 "intitulés (labels)", de "Choix du Bitmap Source (24 bits) :" à "Lignes restantes :" (propriétés Caption, Font, et TextAlign).

Face aux trois derniers labels, nous allons en créer trois autres, respectivement nommés "L_X", "L_Y", et "L_R". Ajuster leur SpecialEffect à "Sunken (2)", TextAlign à "Center".

Face à "L_X" ajouter une "barre de défilement". Nommez_la "S_X", fixer Min et Value à 3, Max à 12. Dupliquez-la pour créer "S_Y".

"Comme en X" est le Caption d'une "Case à Cocher (CheckBox)" nommée "C_Y". Vérifiez néanmoins que "TripleState" (3ème état "grisé") soit à False..

La grande zone est une "Zone de Texte (TextBox)" nommée "T_Src", de propriétés "MultiLine" et "Locked" à True.

Reste à ajouter 3 (eh oui) "Boutons de Commande (CommandButtons)". "..." a pour nom "C_Src", "Lancer.." s'appelle "C_GO" (Enabled à False). Le troisième n'est pas visible: par Copier-Coller de "C_Go", recouvrir exactement ce dernier d'un bouton vert intense sans Caption, nommé "C_Prog". Enfin, fixer la propriété "Width" de "C_Prog" à 0 (zéro).

Tout y est, pensez à sauvegarder..

Le Code (à coller dans "UF1")

' -----------------
' Zone Déclarations
' -----------------
Dim FD As FileDialog

' ---------------------------
' EVT: Initialisation Feuille
' ---------------------------
Private Sub UserForm_Initialize()
T_Src.Text = "": L_R.Caption = ""
C_Prog.Width = 0: C_GO.Enabled = False
C_Y.Value = 0: S_X.Value = 5: S_Y.Value = 5
End Sub

' -----------------------------
' Bouton "Sélectionner Fichier"
' -----------------------------
Private Sub C_Src_Click()
Set FD = Application.FileDialog(msoFileDialogFilePicker)
With FD
    .AllowMultiSelect = False: .ButtonName = "Charger"
    .Filters.Clear: .Filters.Add "BMP (24bits)", "*.BMP": .Show
End With
If FD.SelectedItems.Count Then
    C_Prog.Width = 0: Fic$ = FD.SelectedItems(1)
    ' Séparation Chemin-Nom
    T1 = InStr(Fic$, "\"): While T1: T2 = T1: T1 = InStr(T2 + 1, Fic$, "\"): Wend
    If T2 Then D$ = Left$(Fic$, T2): Fic$ = Mid$(Fic$, T2 + 1) Else D$ = ""
    Open D$ + Fic$ For Random As #1 Len = 1
    ' Test
    If HDR(Fic$, 1, 1, TT&, TE&, TP&, TD&, TB&, TI&, TX&, TY&) Then
        T_Src.Text = D$ + Fic$: C_GO.Enabled = True
    Else
        T_Src = "": C_GO.Enabled = False
    End If
    Close #1
End If
End Sub

' -------------------------------
' EVT: Barres de Défilement Zooms
' -------------------------------
Private Sub S_X_Change()
L_X.Caption = CStr(S_X.Value): If C_Y.Value Then S_Y.Value = S_X.Value
End Sub
Private Sub S_X_Scroll()
S_X_Change
End Sub
Private Sub S_Y_Change()
L_Y.Caption = CStr(S_Y.Value)
End Sub
Private Sub S_Y_Scroll()
S_Y_Change
End Sub

' --------------------
' EVT: Coche "Comme Y"
' --------------------
Private Sub C_Y_Click()
S_Y.Enabled = (C_Y.Value = 0): S_X_Change
End Sub

' --------------------------
' Bouton "Lancer le Canevas"
' --------------------------
Private Sub C_GO_Click()
F_1.Enabled = False: F_2.Enabled = False
Canevas T_Src.Text, S_X.Value, S_Y.Value
F_1.Enabled = True: F_2.Enabled = True
End Sub

Explications

Le début du Code n'a rien de transcendant, on y retrouve dans "UserForm_Initialize" les initialisations qui seront exécutées au lancement de UF1. La déclaration du FileDialog "FD" disparaît du Module pour se placer ici. De même la procédure "C_Charge_Click" du Module est supprimée au profit de sa presque jumelle "C_Src_Click". Notez que cette dernière hérite d'une copie des lignes de séparation Chemin-Nom, et d'un appel à HDR..

Barres de Défilement
Deux événements sont à gérer à l'identique: "Change" lorsque l'utilisateur clique dans la barre, ou sur les flèches aux extrémités, et "Scroll" lorsqu'il saisit et déplace le curseur. Donc nous en codons un, et l'autre appelle le premier. Ces événements affichent dans le Label correspondant la valeur de leur Barre.

La Coche "Comme en X"
Cochée, la Barre Y est désactivée (Enabled=False) et suit celle en X. Décochée, la Barre Y redevient autonome.

Bouton "Lancer.."
Après désactivation des deux Cadres (blocage de l'interface), on invoque le Canevas (du module), en lui passant le Nom du Fichier ainsi que les deux Facteurs de Zoom. En sortie, on réactive les deux Cadres..

Ajout dans "ThisDocument"

' ---------------------------------
' EVT: A l'Ouverture de ce Document
' ---------------------------------
Private Sub Document_Open()
UF1.Show
End Sub

A l'ouverture du Document, lancer la Fenêtre UF1..

Modifications dans le Module

La procédure "C_Charge_Click" disparaît, remplacée par "C_Src_Click" dans "UF1".

Dans la procédure "Canevas", l'appel "If HDR(Fic$, 1, 0 [..]" n'affiche plus le résumé, déjà affiché dans l'appel via "C_Src_Click"..

De même, les "Debug.Print" sont supprimés, au profit d'un Sous-Programme supplémentaire, "SSUF1", inséré entre le "Return" de "SSRemp" et le "End Sub":

' SSub: MàJ UF1
SSUF1:
If Not (UF1 Is Nothing) Then
    UF1.C_Prog.Width = UF1.C_GO.Width * (TY& - Y) / TY&: UF1.L_R.Caption = CStr(Y): DoEvents
End If
Return

Ce Sous-Programme est appelé à deux endroits dans "Canevas":

        Next X
        Ecr CL&, 0, 3: GoSub SSRemp: GoSub SSUF1
    Next Y2

et

    Next Y: GoSub SSUF1
    ' Fin

Voilou :P

Pensez à sauvegarder, fermez et rouvrez le document. UF1 devrait démarrer..

Dans une troisième partie nous étofferons notre interface d’un gadget "amusant" de sélection de couleur de grille..

-MyLzz59-