Option Explicit
Dim fso As FileSystemObject
Dim fic As TextStream
Private Sub cmdchar_Click()
' gestion de l'erreur
On Error Resume Next
' si l'utilisateur clik sur annuler on gere l'erreur
cd1.CancelError = True
' definit les fonction de la boite de dialogue police
cd1.Flags = cdlCFBoth Or cdlCFForceFontExist
'on initialise le command dialogue
cd1.FontBold = txt.FontBold
cd1.FontItalic = txt.FontItalic
cd1.FontName = txt.FontName
cd1.FontSize = txt.FontSize
' affichage du command dialogue
cd1.ShowFont
'si pas d'erreur
If Err.Number = 0 Then
'le texte prend les valeurs que l'utilisateur a définit ds le command dialogue
txt.FontBold = cd1.FontBold
txt.FontItalic = cd1.FontItalic
txt.FontName = cd1.FontName
txt.FontSize = cd1.FontSize
Else
'si erreur on affiche l'erreur
MsgBox Err.Description
End If
End Sub
Private Sub cmdcolor_Click()
' gestion erreur
On Error Resume Next
' on gere l'erreur si l'utilisateur clik sur annuler
cd1.CancelError = True
'definit les fonctions de la boite de dialogue couleur
cd1.Flags = cdlCCFullOpen Or cdlCCRGBInit
'initialise la couleur du texte avant de la modifier
cd1.Color = txt.ForeColor
'affichage de la boite de dialogue couleur
cd1.ShowColor
'si il n'y a pas d'erreur alors
If Err.Number = 0 Then
'le texte prend la couleur selectionné ds la boite de dialogue
txt.ForeColor = cd1.Color
Else
' sinon on affiche l'erreur
MsgBox Err.Description
End If
End Sub
Private Sub cmdouvrir_Click()
Set fso = Nothing
Set fic = Nothing
'evite l'apparition d'erreur si l'utilisateur clique sur annuler
cd1.CancelError = False
'gere les erreurs tel que chemin ou dossier introuvable
cd1.Flags = cdlOFNFileMustExist Or cdlOFNPathMustExist
'fait apparaitre seulement les fichier tmp et tous
cd1.Filter = "Fichiers (*.tmp)|*.tmp|Tous (*.*)|*.*"
'ouvre la fenetre de recherche
cd1.ShowOpen
'si le nom du fichier a ouvrir est sup a 0
If Len(cd1.FileName) > 0 Then
' creation de l'objet
Set fso = New FileSystemObject
'ouverture pour lecture du fichier
Set fic = fso.OpenTextFile(cd1.FileName, ForReading)
'lecture du fichier jusqu'a la derniere ligne
Do While fic.AtEndOfStream = False
' renvoit sur l'ihm ce k'il y a ds le fichier
txt.Text = txt.Text & fic.ReadLine & vbNewLine
Loop
End If
End Sub
Private Sub cmdwrite_Click()
Set fso = Nothing
Set fic = Nothing
cd1.CancelError = False
cd1.Flags = cdlOFNPathMustExist Or cdlOFNOverwritePrompt
cd1.Filter = "Fichiers (*.temp)|*.tmp|Tous (*.*)|*.*"
cd1.ShowSave
If Len(cd1.FileName) > 0 Then
Set fso = New FileSystemObject
'ouverture pour ecriture sur le fichier
Set fic = fso.OpenTextFile(cd1.FileName, ForAppending, True)
'ecriture de ce kil y a ds la text box dans le fichier
fic.WriteLine (txt.Text)
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
'destruction de l'objet
Set fso = Nothing
'destruction du fichier
Set fic = Nothing
End Sub