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!
A 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( )
	'Ecoute 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$ + "  " + Str$(X%) + " et sur lacassette  "
				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  de l'enregistrement courant soit différent du  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  d'enregistrement
	CtlRoll.Value = NumEnreg%
End If
End Sub
'
Private Sub CtlMoins_Click()
'revenir à l'enregistrement précédent à condition que le  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  de l'enregistrement sélectionné
	CtlRoll.Value = NumEnreg%
End If
End Sub
'
Private Sub CtlMoins10_Click( )
'Avancer de 10 enregistrements à condition que le  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  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  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'enrgistrement 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éfiflement verticale permet de se déplacer dans la base de données mais
	'l'ajout de nouveaux enregistrments à 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'autre 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êter 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)