PETIT LOG CONCERNANT LE COMMONDIALOG

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

Télécharger le zip

13 septembre 2005 09:41:21 :

Le code n'as pas était modifié, mais juste le niveau.

13 septembre 2005 11:22:40 :

Ajout de la boite de dialogue couleur.

13 septembre 2005 14:45:02 :

ajout du command dialogue police