Tutoriel 42 : La feuille frmChild - saisie du codeDate de publication : Mardi 30 novembre 2004 , Date de mise à jour : Lundi 11 février 2008
Par
Gilbert Miralles (gilmir.developpez.com)
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 :
Dim NumEnreg%
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.
Private Sub Command3D1_Click( )
End Sub
Private Sub Command3D2_Click( )
End Sub
|
Recherche d'un enregistrement dans la base de données
Private Sub Command3D3_Click( )
StockeEnreg% = NumEnreg%
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
ObjetRecherche$ = Trim$(ObjetRecherche$)
Occurrence% = False
For X% = 1 To NbreEnregistremts%
GetRecord DNum%, X%, Me
InfoEnreg Me, X%, NbreEnregistremts%
Enreg$ = Trim$(Video.Titre) + Space$(10) + Trim$(Video.Description)
If InStr(LCase$(Enreg$), LCase$(ObjetRecherche$)) > 0 Then
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 ?"
a% = MsgBox(Message$, 32 + 4, Titre$)
If a% = 6 Then
Exit For
Else
NumEnreg% = X%
End If
End If
Next X%
If Occurrence% = False Then
NumEnreg% = StockeEnreg%
Else
NumEnreg% = EnregTrouve%
End If
GetRecord DNum%, NumEnreg%, Me
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$)
If Reponse% = 7 Then Exit Sub
CtlTitre.Text = ""
CtlAnnee.Text = "1980"
CtlDuree.Text = "100"
CtlNumCass.Text = Trim$(Str$(NbreEnregistremts%))
CtlNumFilm.Text = "1"
CtlTypeCassette.Text = "E-180"
CtlDescriptif.Text = ""
CtlFichierSon.Caption = ""
End Sub
Private Sub CtlFin_Click()
If NumEnreg% <> NbreEnregistremts% Then
PutRecord DNum%, NumEnreg%, Me
NumEnreg% = NbreEnregistremts%
GetRecord DNum%, NumEnreg%, Me
InfoEnreg Me, NumEnreg%, NbreEnregistremts%
CtlRoll.Value = NumEnreg%
End If
End Sub
Private Sub CtlMoins_Click()
If NumEnreg% > 1 Then
PutRecord DNum%, NumEnreg%, Me
NumEnreg% = NumEnreg% - 1
GetRecord DNum%, NumEnreg%, Me
InfoEnreg Me, NumEnreg%, NbreEnregistremts%
CtlRoll.Value = NumEnreg%
End If
End Sub
Private Sub CtlMoins10_Click( )
If NumEnreg% > 10 Then
PutRecord DNum%, NumEnreg%, Me
NumEnreg% = NumEnreg% - 10
GetRecord DNum%, NumEnreg%, Me
InfoEnreg Me, NumEnreg%, NbreEnregistremts%
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( )
If Trim$(CtlTitre.Text) = "" Then
Msg = "Vous devez saisir un titre de film!"
MsgBox Msg
Exit Sub
End If
If NumEnreg% < NbreEnregistremts% Then
PutRecord DNum%, NumEnreg%, Me
NumEnreg% = NumEnreg% + 1
GetRecord DNum%, NumEnreg%, Me
InfoEnreg Me, NumEnreg%, NbreEnregistremts%
CtlRoll.Value = NumEnreg%
ElseIf NbreEnregistremts% < 32767 Then
PutRecord DNum%, NumEnreg%, Me
NumEnreg% = NumEnreg% + 1
NbreEnregistremts% = NbreEnregistremts% + 1
CtlTitre.Text = ""
CtlAnnee.Text = "1980"
CtlDuree.Text = "100"
CtlNumCass.Text = Trim$(Str$(NbreEnregistremts%))
CtlNumFilm.Text = "1"
CtlTypeCassette.Text = "E-180"
CtlDescriptif.Text = ""
CtlFichierSon.Caption = ""
CtlRoll.Max = CtlRoll.Max + 1
InfoEnreg Me, NumEnreg%, NbreEnregistremts%
End If
End Sub
Private Sub CtlPlus10_Click( )
If NumEnreg% + 10 <= NbreEnregistremts% Then
PutRecord DNum%, NumEnreg%, Me
NumEnreg% = NumEnreg% + 10
GetRecord DNum%, NumEnreg%, Me
InfoEnreg Me, NumEnreg%, NbreEnregistremts%
CtlRoll.Value = NumEnreg%
End If
End Sub
Private Sub ctlPos1_Click( )
If NumEnreg% <> 1 Then
PutRecord DNum%, NumEnreg%, Me
NumEnreg% = 1
GetRecord DNum%, NumEnreg%, Me
InfoEnreg Me, NumEnreg%, NbreEnregistremts%
CtlRoll.Value = NumEnreg%
End If
End Sub
Private Sub CtlRoll_Change( )
On Error Resume Next
PutRecord DNum%, NumEnreg%, Me
CtlRoll.Min = 1
CtlRoll.Max = NbreEnregistremts%
CtlRoll.LargeChange = 10
CtlRoll.SmallChange = 1
NumEnreg% = CtlRoll.Value
GetRecord DNum%, NumEnreg%, Me
InfoEnreg Me, NumEnreg%, NbreEnregistremts%
End Sub
Private Sub ctlShowListe_Click( )
On Error Resume Next
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( )
MousePointer = 11
AncNumEnreg% = NumEnreg%
PutRecord DNum%, NumEnreg%, Me
For NumEnreg% = 1 To NbreEnregistremts%
GetRecord DNum%, NumEnreg%, Me
InfoEnreg Me, NumEnreg%, NbreEnregistremts%
DureeTotale& = DureeTotale& + Video.Duree
If Video.Annee < LePremierFilm% Or LePremierFilm% = 0 Then
LePremierFilm% = Video.Annee
End If
If Video.Annee > FilmLePlusRecent% Or FilmLePlusRecent% = 0 Then
FilmLePlusRecent% = Video.Annee
End If
If Video.Duree < LePlusCourt% Or LePlusCourt% = 0 Then
LePlusCourt% = Video.Duree
End If
If Video.Duree > LePlusLong% Or LePlusLong% = 0 Then
LePlusLong% = Video.Duree
End If
If Video.NumCass < MinNumCass% Or MinNumCass% = 0 Then
MinNumCass% = Video.NumCass
End If
If Video.NumCass > MaxNumCass% Or MaxNumCass% = 0 Then
MaxNumCass% = Video.NumCass
End If
Next NumEnreg%
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%)
frmStatistique!TXT_Fichier.Caption = Me.Caption
NumEnreg% = AncNumEnreg%
GetRecord DNum%, NumEnreg%, Me
MousePointer = 1
frmStatistique.Show 1
End Sub
Private Sub Form_Load( )
If FenetreMDI% = 1 Then
frmParent!bnCascade.Visible = True
frmParent!bnTile.Visible = True
frmParent!bnHorTile.Visible = True
frmParent!bnIconArrange.Visible = True
frmParent!bnClose.Visible = True
End If
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"
CtlPays.ListIndex = CtlPays.ListCount - 1
End Sub
Private Sub mnu_About_Click( )
frmShow.About 1
End Sub
Private Sub MNU_ArrangeIcons_Click( )
frmParent.Arrange 3
End Sub
Private Sub MNU_Cascade_Click( )
frmParent.Arrange 0
End Sub
|
Saisie du code des commandes de menu dans la barre de menus
Private Sub mnu_Close_Click( )
Close #DNum%
Unload Me
End Sub
Private Sub MNU_CloseAll_Click( )
CloseAll
End Sub
Private Sub MNU_DelDatabase_Click( )
frmDelFile.Show 1
End Sub
Private Sub MNU_DelFields_Click( )
CtlDelField_Click
End Sub
Private Sub mnu_Exit_Click( )
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( )
Command3D3_Click
End Sub
Private Sub MNU_hArrange_Click( )
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( )
ctlShowListe_Click
End Sub
Private Sub mnu_MakeFile_Click( )
frmMakeFile.Show 1
End Sub
Private Sub MNU_Moins_Click( )
CtlMoins_Click
End Sub
Private Sub MNU_Moins10_Click( )
CtlMoins10_Click
End Sub
Private Sub MNU_Open_Click( )
frmFileOpen.Show 1
End Sub
Private Sub MNU_Plus_Click( )
CtlPlus_Click
End Sub
Private Sub MNU_Plus10_Click( )
CtlPlus10_Click
End Sub
Private Sub mnu_Pos1_Click( )
ctlPos1_Click
End Sub
Private Sub MNU_Sound_Click( )
End Sub
Private Sub MNU_Statistiques_Click( )
CtlStatistiques_Click
End Sub
Private Sub MNU_vArrange_Click( )
frmParent.Arrange 2
End Sub
|
Codage des contrôles "SPIN" Procédure "SpinDown"
Private Sub Spin1_SpinDown( )
Annee% = Val(CtlAnnee.Text)
If Annee% > 1920 Then
CtlAnnee.Text = Trim$(Str$(Annee% - 1))
End If
End Sub
Private Sub Spin2_SpinDown( )
Duree% = Val(CtlDuree.Text)
If Duree% > 60 Then
CtlDuree.Text = Trim$(Str$(Duree% - 5))
End If
End Sub
Private Sub Spin3_SpinDown( )
NumCass% = Val(CtlNumCass.Text)
If NumCass% > 1 Then
CtlNumCass.Text = Trim$(Str$(NumCass% - 1))
End If
End Sub
Private Sub Spin4_SpinDown( )
NumFilm% = Val(CtlNumFilm.Text)
If NumFilm% > 1 Then
CtlNumFilm.Text = Trim$(Str$(NumFilm% - 1))
End If
End
|
| |