Tutoriel 42 : La feuille frmChild - saisie du code

L'auteur

Gilbert Miralles

L'article

Publié le 30 novembre 2004

Version PDF Version hors-ligne

ePub, Azw et Mobi

Liens sociaux

Exercice 10 - La feuille frmChild - saisie du code ♪▲

Le code de la feuille « frmChild » (fenêtre fille)

Attention!
Cette feuille est la clé de voûte du programme, je vous recommande la plus grande attention dans la saisie du code.
Seules les instructions nécessitant du code seront insérées dans cette leçon.
Si vous ne trouvez pas la procédure indiquée, c'est qu'elle n'a pas été déclarée correctement.
Continuez pour retourner plus tard lorsque nous ferons le contrôle de l'application.

En « Object »/« Général » et dans la procédure « déclarations », nous saisissons :

Sélectionnez

'Enregistrement courant de type Integer, car nous ne gérons pas plus de 32767 enregistrements...
Dim NumEnreg%
'Nombre total d'enregistrements dans le fichier courant (global à ce module)
Dim NbreEnregistremts%
'
Dim DNum%

Nous insérons les procédures nécessaires au fonctionnement, nous commençons par les boutons!
À ce niveau les procédures sont déjà en place, il ne nous reste plus qu'à insérer le code.

Sélectionnez

Private Sub Command3D1_Click( )
    'Affiche la feuille de recherche des fichiers sons
End Sub

Private Sub Command3D2_Click( )
    'Écoute des fichiers sons
End Sub

Recherche d'un enregistrement dans la base de données

Sélectionnez

Private Sub Command3D3_Click( )
    'Recherche enregistrement et stocker l'enregistrement courant 
    StockeEnreg% = NumEnreg%
    'Demande quelle chaîne rechercher
    Titre$ = "Recherche d'un film"
    Message$ = "Veuillez donner une partie du titre recherché. "
    Message$ = Message$ + "Aucune distinction ne sera faite entre minuscules "
    Message$ = Message$ + "et majuscules et la recherche est effectuée "
    Message$ = Message$ + "uniquement dans les champs TITRE et DESCRIPTION."
    ObjetRecherche$ = InputBox$(Message$, Titre$)
    If Trim$(ObjetRecherche$) <> "" Then
        'OK activé pour lancer la recherche
        ObjetRecherche$ = Trim$(ObjetRecherche$)
        'pas encore d'occurrence
        Occurrence% = False
        For X% = 1 To NbreEnregistremts%
            'Lecture enregistrement par enregistrement
            GetRecord DNum%, X%, Me
            'Affiche progression de recherche
            InfoEnreg Me, X%, NbreEnregistremts%
            'Regroupe les champs à inspecter
            Enreg$ = Trim$(Video.Titre) + Space$(10) + Trim$(Video.Description)
            'Comparons
            If InStr(LCase$(Enreg$), LCase$(ObjetRecherche$)) > 0 Then
                'Trouvé!
                Occurrence% = True
                EnregTrouve% = X%
                Titre$ = "La recherche a abouti"
                Message$ = "Le texte recherché <" + ObjetRecherche$ + "> a été trouvé dans l'enregistrement"
                Message$ = Message$ + " n° " + Str$(X%) + " et sur lacassette n° "
                Message$ = Message$ + Str$(Video.NumCass) + ". Désirez-vous modifier ou afficher le titre du film "
                Message$ = Message$ + "Titre du film <" + Trim$(Video.Titre) + "> et terminer la recherche ?"
                'Demande de répondre par oui ou par non à la proposition de poursuivre la recherche
                a% = MsgBox(Message$, 32 + 4, Titre$)
                'Réponse = OUI : nous sortons prématurément
                'de la boucle
                If a% = 6 Then
                    'Affiche le résultat de la recherche pour le modifier
                    Exit For
                Else
                    'Stockage du résultat de la dernière recherche pour l'afficher après la sortie de la fonction de recherche
                    NumEnreg% = X%
                End If
            End If
    Next X%
    If Occurrence% = False Then
        'Aucune occurrence :nous affichons l'enregistrement affiché lors de la demande de recherche
        NumEnreg% = StockeEnreg%
    Else
        'Affiche la dernière occurrence
        NumEnreg% = EnregTrouve%
    End If
    'Lecture de l'enregistrement initial ou trouvé
    GetRecord DNum%, NumEnreg%, Me
    'Affiche progression du travail
    InfoEnreg Me, NumEnreg%, NbreEnregistremts%
 End If
End Sub
'
Private Sub CtlDelField_Click()
    CL$ = Chr$(13) + Chr$(10)
    Titre$ = "Effacement des zones textes"
    Msg = "Voulez-vous vraiment effacer" + CL$
    Msg = Msg + " les zones de textes?"
    Reponse% = MsgBox(Msg, 16 + 4, Titre$)
    'Quitter le programme
    If Reponse% = 7 Then Exit Sub
    'retour à l'enregistrement Effacement des zones de texte
    CtlTitre.Text = ""
    CtlAnnee.Text = "1980"
    CtlDuree.Text = "100"
    'Nous supposons 1 film par cassette
    CtlNumCass.Text = Trim$(Str$(NbreEnregistremts%))
    CtlNumFilm.Text = "1"
    CtlTypeCassette.Text = "E-180"
    CtlDescriptif.Text = ""
    CtlFichierSon.Caption = ""
End Sub
'
Private Sub CtlFin_Click()
'Aller jusqu'au dernier enregistrement à condition que n° de l'enregistrement courant soit différent du n° du dernier
If NumEnreg% <> NbreEnregistremts% Then
    'Stockage de l'enregistrement courant
    PutRecord DNum%, NumEnreg%, Me
    'Incrémenter le compteur d'enregistrements
    NumEnreg% = NbreEnregistremts%
    GetRecord DNum%, NumEnreg%, Me
    InfoEnreg Me, NumEnreg%, NbreEnregistremts%
    'Correction de barre de défilement Correction du n° d'enregistrement
    CtlRoll.Value = NumEnreg%
End If
End Sub
'
Private Sub CtlMoins_Click()
'revenir à l'enregistrement précédent à condition que le n° de l'enregistrement soit > 1
If NumEnreg% > 1 Then
    'sauvegarder l'enregistrement courant
    PutRecord DNum%, NumEnreg%, Me
    'Décérmente le compteur d'enregistrements
    NumEnreg% = NumEnreg% - 1
    'Lit l'enreg. précédent
    GetRecord DNum%, NumEnreg%, Me
    InfoEnreg Me, NumEnreg%, NbreEnregistremts%
    'Corrige la barre de défilement du n° de l'enregistrement sélectionné
    CtlRoll.Value = NumEnreg%
End If
End Sub
'
Private Sub CtlMoins10_Click( )
'Avancer de 10 enregistrements à condition que le n° de l'enreg. soit supérieur à 10
If NumEnreg% > 10 Then
    'Sauvegarde de l'enregistrement courant
    PutRecord DNum%, NumEnreg%, Me
    'Incrémente le compteur d'enregistrements
    NumEnreg% = NumEnreg% - 10
    GetRecord DNum%, NumEnreg%, Me
    InfoEnreg Me, NumEnreg%, NbreEnregistremts%
    'Corrige la barre de défilement du n° de l'enregistrement sélectionné
    CtlRoll.Value = NumEnreg%
End If
End Sub
'
Private Sub CtlNumCass_KeyPress(KeyAnsi As Integer)
If InStr("0123456789", Chr$(KeyAnsi)) = 0 Then
    KeyAnsi = 0
End If
End Sub
'
Private Sub CtlPlus_Click( )
'avancer, ajouter éventuellement de nouveaux enregistrements Le titre est la saisie minimum
If Trim$(CtlTitre.Text) = "" Then
    'Message
    Msg = "Vous devez saisir un titre de film!"
    MsgBox Msg
Exit Sub
End If
If NumEnreg% < NbreEnregistremts% Then
    'Sauvegarde de l'enregistrement courant
    PutRecord DNum%, NumEnreg%, Me
    'Incrémente le compteur d'enregistrements
    NumEnreg% = NumEnreg% + 1
    'Si pas de nouvel enreg., lire l'ancien
    GetRecord DNum%, NumEnreg%, Me
    InfoEnreg Me, NumEnreg%, NbreEnregistremts%
    'Corrige la barre de défilement du n° de l'enregistrement sélectionné
    CtlRoll.Value = NumEnreg%
ElseIf NbreEnregistremts% < 32767 Then
    'pas plus de 32767 enregistrements Sauvegarde l'enreg. courant
    PutRecord DNum%, NumEnreg%, Me
    'Incrémente
    NumEnreg% = NumEnreg% + 1
    'Nouvel enregistrement : incrémenter le nombre total des enregistrements et initialiser les valeurs
    NbreEnregistremts% = NbreEnregistremts% + 1
    'Efface les zones de texte
    CtlTitre.Text = ""
    CtlAnnee.Text = "1980"
    CtlDuree.Text = "100"
    'Nous supposons qu'il y a 1 film par cassette
    CtlNumCass.Text = Trim$(Str$(NbreEnregistremts%))
    CtlNumFilm.Text = "1"
    CtlTypeCassette.Text = "E-180"
    CtlDescriptif.Text = ""
    CtlFichierSon.Caption = ""
    'Incrémenter également la valeur maxi de la barre de défilement verticale
    CtlRoll.Max = CtlRoll.Max + 1
    InfoEnreg Me, NumEnreg%, NbreEnregistremts%
End If
End Sub
'
Private Sub CtlPlus10_Click( )
'Avancer de 10 enregistrements à condition qu'ils existent
If NumEnreg% + 10 <= NbreEnregistremts% Then
    'Sauvegarde de l'enregistrement courant
    PutRecord DNum%, NumEnreg%, Me
    'Incrémente le compteur d'enregistrements
    NumEnreg% = NumEnreg% + 10
    GetRecord DNum%, NumEnreg%, Me
    InfoEnreg Me, NumEnreg%, NbreEnregistremts%
    'Corrige la barre de défilement de l'enregistrement sélectionné
    CtlRoll.Value = NumEnreg%
End If
End Sub
'
Private Sub ctlPos1_Click( )
'Aller au premier enregistrement si le n+ d'enreg. est différent de 1
If NumEnreg% <> 1 Then
    'Stocke l'enreg. courant
    PutRecord DNum%, NumEnreg%, Me
    'Incrémente l'enregistrement
    NumEnreg% = 1
    GetRecord DNum%, NumEnreg%, Me
    InfoEnreg Me, NumEnreg%, NbreEnregistremts%
    'Corrige la barre de défilement du numéro d'enregistrement courant
    CtlRoll.Value = NumEnreg%
End If
End Sub
'
Private Sub CtlRoll_Change( )
    On Error Resume Next
    'Stocker l'enregistrement courant
    PutRecord DNum%, NumEnreg%, Me
    'La barre de défilement verticale permet de se déplacer dans la base de données, mais
    'l'ajout de nouveaux enregistrements à l'aide de la barre de défilement n'a pas d'intérêt...
    'Valeur mini : enregistrement numéro 1
    CtlRoll.Min = 1
    'Valeur maxi de la barre de défilement dépend du nombre d'enregistrements
    CtlRoll.Max = NbreEnregistremts%
    'Modification par un clic sur la barre ou sur les flèches de défilement Calage sur premier enreg.
    ' If CtlRoll.Value + 5 <= NbreEnregistremts% And CtlRoll.Value - 5 >= 1 Then
    CtlRoll.LargeChange = 10
    ' Else
    ' CtlRoll.LargeChange = 1
    'End If
    'Modif par un clic sur flèche de défilement
    CtlRoll.SmallChange = 1
    NumEnreg% = CtlRoll.Value
    GetRecord DNum%, NumEnreg%, Me
    InfoEnreg Me, NumEnreg%, NbreEnregistremts%
End Sub
'
Private Sub ctlShowListe_Click( )
    On Error Resume Next
    'Analyse du contrôle dans procédure Kombo
    StockeEnreg% = NumEnreg%
    For X% = 1 To NbreEnregistremts%
        GetRecord DNum%, X%, Me
        frmListe!Liste1.AddItem Str$(X%) + Space$(5) + Trim$(Video.Titre) + " [" + Trim$(Str$(Video.NumCass)) + "]"
    Next X%
    frmListe.Caption = frmListe.Caption + "[" + Me.Caption + " ]"
    frmListe.Show 1
    NumEnreg% = StockeEnreg%
    GetRecord DNum%, NumEnreg%, Me
End Sub
'
Private Sub CtlStatistiques_Click( )
    'Lecture du fichier jusqu'à la fin et analyse Stocker l'enreg. courant. Pour que InfoEnreg fonctionne
    'correctement (Variable globale NumEnreg%), 
    'nous devons utiliser NumEnreg% comme variable compteur, car les enregistrements doivent être traités l'un après l'autre...
    'Pointeur souris : sablier
    MousePointer = 11
    AncNumEnreg% = NumEnreg%
    PutRecord DNum%, NumEnreg%, Me
    'Valeurs à calculer
    For NumEnreg% = 1 To NbreEnregistremts%
        'Affiche progression
        GetRecord DNum%, NumEnreg%, Me
        InfoEnreg Me, NumEnreg%, NbreEnregistremts%
        'analyse Durée totale de tous les films
        DureeTotale& = DureeTotale& + Video.Duree
        'Le premier film (le plus ancien)
        If Video.Annee < LePremierFilm% Or LePremierFilm% = 0 Then
            LePremierFilm% = Video.Annee
        End If
        'Le film le plus récent
        If Video.Annee > FilmLePlusRecent% Or FilmLePlusRecent% = 0 Then
            FilmLePlusRecent% = Video.Annee
        End If
        'durée la plus courte
        If Video.Duree < LePlusCourt% Or LePlusCourt% = 0 Then
            LePlusCourt% = Video.Duree
        End If
        'Durée la plus longue
        If Video.Duree > LePlusLong% Or LePlusLong% = 0 Then
            LePlusLong% = Video.Duree
        End If
        'Le plus petit numéro de cassette
        If Video.NumCass < MinNumCass% Or MinNumCass% = 0 Then
            MinNumCass% = Video.NumCass
        End If
        'Le plus gros numéro de cassette
        If Video.NumCass > MaxNumCass% Or MaxNumCass% = 0 Then
            MaxNumCass% = Video.NumCass
        End If
        Next NumEnreg%
        'affecter au format d'affichage la valeur renvoyée
        frmStatistique!Resultat1.Caption = Str$(NbreEnregistremts%)
        frmStatistique!Resultat2.Caption = Str$(DureeTotale&)
        frmStatistique!Resultat3.Caption = Str$(LePlusCourt%)
        frmStatistique!Resultat4.Caption = Str$(LePlusLong%)
        frmStatistique!Resultat5.Caption = Str$(MinNumCass%)
        frmStatistique!Resultat6.Caption = Str$(MaxNumCass%)
        frmStatistique!Resultat7.Caption = Str$(LePremierFilm%)
        frmStatistique!Resultat8.Caption = Str$(FilmLePlusRecent%)
        'Affiche nom du fichier
        frmStatistique!TXT_Fichier.Caption = Me.Caption
        'Lire l'ancien enregistrement
        NumEnreg% = AncNumEnreg%
        GetRecord DNum%, NumEnreg%, Me
        MousePointer = 1
        'Affiche la feuille d'affichage
        frmStatistique.Show 1
End Sub
'
Private Sub Form_Load( )
    'Quand la première fenêtre fille est ouverte, d'autres boutons sont automatiquement activés
    If FenetreMDI% = 1 Then
        'La première fois seulement
        frmParent!bnCascade.Visible = True
        frmParent!bnTile.Visible = True
        frmParent!bnHorTile.Visible = True
        frmParent!bnIconArrange.Visible = True
        frmParent!bnClose.Visible = True
    End If
    'La liste modifiable doit être initialisée avec les entrées de pays ou de continent les plus importantes
    CtlPays.AddItem "Allemagne"
    CtlPays.AddItem "France"
    CtlPays.AddItem "Italie"
    CtlPays.AddItem "Espagne"
    CtlPays.AddItem "Australie"
    CtlPays.AddItem "USA"
    CtlPays.AddItem "Canada"
    CtlPays.AddItem "Angleterre"
    CtlPays.AddItem "Israël"
    CtlPays.AddItem "Danemark"
    CtlPays.AddItem "Irlande"
    CtlPays.AddItem "Afrique"
    CtlPays.AddItem "Asie"
    CtlPays.AddItem "Inde"
    CtlPays.AddItem "Chine"
    CtlPays.AddItem "Japon"
    CtlPays.AddItem "Thaïlande"
    CtlPays.AddItem "Norvège"
    CtlPays.AddItem "Suède"
    CtlPays.AddItem "Finlande"
    CtlPays.AddItem "Russie"
    CtlPays.AddItem "Amérique Latine"
    'Entrée implicite : USA
    CtlPays.ListIndex = CtlPays.ListCount - 1
End Sub
'
Private Sub mnu_About_Click( )
    frmShow.About 1
End Sub
'
Private Sub MNU_ArrangeIcons_Click( )
    'Ranger les icônes
    frmParent.Arrange 3
End Sub
'
Private Sub MNU_Cascade_Click( )
    'Empiler les fenêtres (cascade)
    frmParent.Arrange 0
End Sub
'

Saisie du code des commandes de menu dans la barre de menus

Sélectionnez

Private Sub mnu_Close_Click( )
    'Fermer la fenêtre fille sélectionnée
    Close #DNum%
    Unload Me
End Sub
'
Private Sub MNU_CloseAll_Click( )
    'Appelle la procédure de fermeture de toutes les fenêtres filles
    CloseAll
End Sub
'
Private Sub MNU_DelDatabase_Click( )
    'Efface base de données
    frmDelFile.Show 1
End Sub
'
Private Sub MNU_DelFields_Click( )
    'Efface les champs
    CtlDelField_Click
End Sub
'
Private Sub mnu_Exit_Click( )
    'Attention nous utilisons le type de données VARIANT aux seules fins d'illustrer son usage
    Titre = "Attention!"
    Message = "Vous voulez vraiment quitter Video_K7?"
    Reponse = MsgBox(Message, 32 + 4, Titre)
    If Reponse = 6 Then End
End Sub
'
Private Sub mnu_Fin_Click( )
    CtlFin_Click
End Sub
'
Private Sub MNU_Find_Click( )
    'Appelle la procédure d'événement
    Command3D3_Click
End Sub
'
Private Sub MNU_hArrange_Click( )
    'Dispose les fenêtres les unes à côté des autres
    frmParent.Arrange 1
End Sub
'
Private Sub mnu_Info_Click( )
    Titre$ = "Vidéo_K7 1.00 - Vidéo et Son pour Windows"
    M$ = "Ce programme gère vos films vidéo et "
    M$ = M$ + "leur associe les fichiers sons de votre choix. "
    MsgBox M$, 64, Titre$
End Sub
'
Private Sub MNU_Liste_Click( )
    'Lit la liste des boutons existants
    ctlShowListe_Click
End Sub
'
Private Sub mnu_MakeFile_Click( )
    'Crée une base de données de films vidéo
    frmMakeFile.Show 1
End Sub
'
Private Sub MNU_Moins_Click( )
    'recule d'un enregistrement
    CtlMoins_Click
End Sub
'
Private Sub MNU_Moins10_Click( )
    'recule de 10 enregistrements
    CtlMoins10_Click
End Sub
'
Private Sub MNU_Open_Click( )
    'Affiche un dialogue d'ouverture de fichiers graphiques
    frmFileOpen.Show 1
End Sub
'
Private Sub MNU_Plus_Click( )
    'avance d'un enregistrement
    CtlPlus_Click
End Sub
'
Private Sub MNU_Plus10_Click( )
    'avance de 10 enregistrements
    CtlPlus10_Click
End Sub
'
Private Sub mnu_Pos1_Click( )
    'retour au début du fichier
    ctlPos1_Click
End Sub
'
Private Sub MNU_Sound_Click( )
    'Ecoute un fichier de son
    'Command3D2_Click
End Sub
'
Private Sub MNU_Statistiques_Click( )
    'Lit l'analyse statistique des boutons existants
    CtlStatistiques_Click
End Sub
'
Private Sub MNU_vArrange_Click( )
    'Range les fenêtres les unes en dessous des autres
    frmParent.Arrange 2
End Sub

Codage des contrôles « SPIN » Procédure « SpinDown »

Sélectionnez

Private Sub Spin1_SpinDown( )
    'Année. débute à 1920
    Annee% = Val(CtlAnnee.Text)
    If Annee% > 1920 Then
        'décrémenter
        CtlAnnee.Text = Trim$(Str$(Annee% - 1))
    End If
End Sub
'
Private Sub Spin2_SpinDown( )
    'Durée minimale : 60 minutes
    Duree% = Val(CtlDuree.Text)
    If Duree% > 60 Then
        'Réduire de cinq
        CtlDuree.Text = Trim$(Str$(Duree% - 5))
    End If
    End Sub
'
Private Sub Spin3_SpinDown( )
    'Numéro de cassette minimal : 1
    NumCass% = Val(CtlNumCass.Text)
    If NumCass% > 1 Then
        'décrémenter
        CtlNumCass.Text = Trim$(Str$(NumCass% - 1))
    End If
End Sub
'
Private Sub Spin4_SpinDown( )
    'Numéro du film de la cassette valeur mini : 1
    NumFilm% = Val(CtlNumFilm.Text)
    If NumFilm% > 1 Then
        'décrémenter
        CtlNumFilm.Text = Trim$(Str$(NumFilm% - 1))
    End If
End Sub
'
Private Sub Spin5_SpinDown( )
    'Type de cassette
    Identificateur$ = Trim$(CtlTypeCassette.Text)
    Select Case LCase$(Identificateur$)
        Case "e-60"
            CtlTypeCassette.Text = "E-60"
        Case "e-90"
            CtlTypeCassette.Text = "E-60"
        Case "e-120"
            CtlTypeCassette.Text = "E-90"
        Case "e-180"
            CtlTypeCassette.Text = "E-120"
        Case "e-240"
            CtlTypeCassette.Text = "E-180"
        Case "e-300"
            CtlTypeCassette.Text = "E-240"
        Case Else
            CtlTypeCassette.Text = "E-120"
        End Select
End Sub

Codage des contrôles « SPIN » Procédure « SpinUp »

Sélectionnez

Private Sub Spin1_SpinUp( )
    'Année : jusqu'à 2020
    Annee% = Val(CtlAnnee.Text)
    If Annee% < 2020 Then
        'incrémenter
        CtlAnnee.Text = Trim$(Str$(Annee% + 1))
    End If
End Sub
'
Private Sub Spin2_SpinUp( )
    'Durée maximale : 240 minutes
    Duree% = Val(CtlDuree.Text)
    If Duree% < 240 Then
        'augmenter de cinq
        CtlDuree.Text = Trim$(Str$(Duree% + 5))
    End If
End Sub
'
Private Sub Spin3_SpinUp( )
    'Numéro de cassette maximal : 1000
    NumCass% = Val(CtlNumCass.Text)
    If NumCass% < 1000 Then
        'incrémenter
        CtlNumCass.Text = Trim$(Str$(NumCass% + 1))
    End If
End Sub
'
Private Sub Spin4_SpinUp( ) 
    'Numéro du film sur la cassette valeur maxi : 4
    NumFilm% = Val(CtlNumFilm.Text)
    If NumFilm% < 4 Then
        'incrémenter
        CtlNumFilm.Text = Trim$(Str$(NumFilm% + 1))
    End If
End Sub
'
Private Sub Spin5_SpinUp( )
    'Type de cassette
    Identificateur$ = Trim$(CtlTypeCassette.Text)
    Select Case LCase$(Identificateur$)
        Case "e-60"
            CtlTypeCassette.Text = "E-90"
        Case "e-90"
            CtlTypeCassette.Text = "E-120"
        Case "e-120"
            CtlTypeCassette.Text = "E-180"
        Case "e-180"
            CtlTypeCassette.Text = "E-240"
        Case "e-240"
            CtlTypeCassette.Text = "E-300"
        Case "e-300"
            CtlTypeCassette.Text = "E-300"
        Case Else
            CtlTypeCassette.Text = "E-120"
    End Select
End Sub

Prochain tutoriel▲

Le fichier Tools.bas (fenêtre fille)

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants :

Copyright © 2000 Gilmir. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.