Tutoriel 42 : La feuille frmChild - saisie du code

Gilbert Miralles

- Titre : Tutoriel 42 : La feuille frmChild - saisie du code

- Auteur : Gilbert Miralles

- Parution : 30 novembre 2004

- Licence : Copyright ® 2000 Gilmir. Aucune reproduction, même partielle, ne peut être faite de ce site et 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.

Sommaire

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

- Prochain tutoriel

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 :

'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.

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

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

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 »

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 »

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)