Viewdoc veille sur les articles

Télécharger le projet
Commenter

Description

Ca sert toujours à visionner des dossiers qui contiennent un texte et des captures.
Cette nouvelle version de ViewDoc Affiche toutes les images compatibles avec la picture box. (Menu contextuel de réglage très pauvre, mais j'ai d'autres impératifs).
Le sous-programme de capture fonctionne, mais je vois pas comment l'intègrer dans l'interface.

Source / Exemple : 


'..........FICHIER FORM1 .........................

Public Class Form1

    Friend Main As FolderDoc

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Text = "ViewDoc"
        SetBounds(Location.X, Location.Y, 300, 250)
        Main = New FolderDoc
        Main.Skin()
        Controls.Add(Main)
    End Sub

 End Class

'.............FICHIER MODULE...............................
Imports Shell32 'composant COM Microsoft Shell Controls And Automation

Module ViewDoc

#Region "La liste, le texte et l'image. Des Instances adaptées aux éventualités."

    'I. Zone du texte  
    Dim Editeur As New TextOs
    'II. Zone de l'image 
    Dim Dessin As New PictOs
    'III. Liste des fichiers   "
    Dim Liste As New ListOs

#End Region

    ''' <summary> Sous programmes de ViewDoc. </summary>
    Public Class FolderDoc 'ViewDoc 2009
        Inherits UserControl

        'IV. Selection du Dossier   "
        Friend WithEvents Selecteur As New ArbrOs

        'V Section technique

#Region "           'Espace d'affichage."
        Dim Sp1 As New SplitContainer
        Dim Sp2 As New SplitContainer
        Dim Sp3 As New SplitContainer

        ''' <summary>Affichage des éléments principaux</summary>
        Friend Sub SkinHead()
            Selecteur.Tronc.Dock = DockStyle.Fill
            Sp2.Panel2.Controls.Add(Editeur.Livre)
            'Sp2.Panel2.ContextMenuStrip = Livre.ContextMenuStrip
            Dessin.Toile.Dock = DockStyle.Fill
            Dessin.Toile.SizeMode = PictureBoxSizeMode.StretchImage
            Sp1.Panel1.Controls.Add(Selecteur.Tronc)
            Editeur.Livre.Dock = DockStyle.Fill
            Sp1.Panel2.Controls.Add(Dessin.Toile)
            Liste.Suite.Dock = DockStyle.Fill
            Sp3.Panel2.Controls.Add(Liste.Suite)
        End Sub

        ''' <summary>
        ''' On place des double panneaux dans chaque demi-panneau
        ''' pour diviser la fenêtre en Quatre zones d'affichage,
        ''' Il reste Sp1, Sp2 et Sp3.panel2</summary>
        Friend Sub Skin() 'Disposition Générale
            'Le UserControl prend toute la place
            Dock = DockStyle.Fill
            'On divise chacun d'eux comme on préfère
            Sp1.Orientation = Orientation.Vertical
            Sp2.Orientation = Orientation.Horizontal
            Sp3.Orientation = Orientation.Vertical
            'On fixe les Proportions initiales. 
            SetBounds(0, 0, 300, 250)
            Sp3.SetBounds(3, 3, 295, 244)
            Sp1.SplitterDistance = 130
            Sp2.SplitterDistance = 180
            Sp3.SplitterDistance = 220
            'Et les positions relatives.
            Sp1.Dock = DockStyle.Fill
            Sp2.Dock = DockStyle.Fill
            Sp3.Anchor = ToutAnchor
            'Sp3.Dock = DockStyle.Fill
            'On met Sp1 dans Sp2 .
            Sp2.Panel1.Controls.Add(Sp1)
            'et Sp2 dans Sp3
            Sp3.Panel1.Controls.Add(Sp2)
            'On inscrit ces paramètres dans une structure de contrôle 
            Controls.Add(Sp3)
            SkinHead() 'et on range les objets dans les demi-Pannaux qui restent
        End Sub
#End Region 'Si j'imbrique trois doubles panneaux il en reste 2 (4 Moitiés)

        Function Chemin() As String
            Return Selecteur.Dos_Path(Selecteur.Noeud)
        End Function

        ''' <summary>Rafraîchissement de l'affichage </summary>
        Private Sub Rafraichit(ByVal T As TreeNode) Handles Selecteur.Rafraichit
            Dim N = Selecteur.Noeud.Text
            Try
                'Editeur.Livre.Text = ""
                Editeur.Livre.LoadFile(Chemin() & N & ".txt", RichTextBoxStreamType.PlainText)
            Catch ex As Exception
                Editeur.Livre.Text = "Pas de " & N & ".txt. Désolé!"
            End Try
            Dessin.Reset(Chemin)
            Liste.Reset(Selecteur.Dos_Path(Selecteur.Noeud))
        End Sub

        'Compresser un Dossier 
        Dim WithEvents Compresse As ToolStripItem
        Friend Sub New()
            Selecteur.Tronc.ContextMenuStrip = New ContextMenuStrip
            Compresse = Selecteur.Tronc.ContextMenuStrip.Items.Add("Compresser")
            Skin()
        End Sub

        Private Sub Compresse_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Compresse.Click
            Dim DossierAcompresser As String = Form1.Main.Chemin()
            Dim ZipName As String = DossierAcompresser.Substring(0, DossierAcompresser.Length - 1) & ".zip"
            Dim ZipDialog As New FileDialog(ZipName)
            ZipDialog.AddFiltre(".Zip", "Fichier compressé")
            If ZipDialog.Sauve = DialogResult.OK Then
                ZipName = ZipDialog.Name
                Dim B(21) As Byte
                B(0) = 80 : B(1) = 75 : B(2) = 5 : B(3) = 6
                IO.File.WriteAllBytes(ZipName, B)
                Dim SH As New Shell
                Dim SF As Folder = SH.NameSpace(ZipName)
                Dim DF As Folder = SH.NameSpace(DossierAcompresser)
                SF.CopyHere(DF)
            End If
        End Sub

    End Class

#Region "Classes d'usage général"

    Public Class ListOs
        Friend WithEvents Suite As New ListBox
        Private Sub Suite_SelectedValueChanged(ByVal sender As System.Object, _
            ByVal e As System.EventArgs) Handles Suite.SelectedValueChanged
            Dim Dir As New IO.DirectoryInfo(Form1.Main.Chemin() & "\")
            Dim S As String = ""
            Dim Ok As Boolean = False
            Try
                For Each Rep As IO.FileInfo In Dir.GetFiles()
                    If Rep.Name = Suite.SelectedItem Then
                        Ok = True : S = Rep.FullName
                        MessageBox.Show("Le programme pour ouvrir le fichier " & vbLf _
                        & S & " est : " & ProgAssocie(S))
                        Exit For
                    End If
                Next
            Catch ex As Exception
            End Try
        End Sub

        Friend Sub Reset(Optional ByVal Chemin As String = Nothing)
            Suite.Items.Clear()
            If Chemin = Nothing Then : Else
                Dim Dir As New IO.DirectoryInfo(Chemin & "\")
                Try
                    For Each file As IO.FileInfo In Dir.GetFiles()
                        Suite.Items.Add(file.Name) : Next
                Catch ex As Exception
                End Try
            End If
        End Sub

    End Class

    Friend Class ArbrOs

        Friend WithEvents Tronc As New TreeView
        Friend Noeud As TreeNode 'Variable courante
        Friend Sub New()
            Noeud = New TreeNode
            Tronc.ShowNodeToolTips = True
            Tronc.Nodes.Add(Noeud)
            Tronc.Anchor = ToutAnchor
            'Tronc.Dock = DockStyle.Fill
            Noeud.Text = "Bureau"
            Noeud.ToolTipText = My.Computer.FileSystem.SpecialDirectories.Desktop
            Tronc.ShowNodeToolTips = False
            Dos_Addrive()
            Noeud = Tronc.Nodes.Item(0)
            For Each N As TreeNode In Tronc.Nodes
                If N.Nodes.Count = 0 Then
                    Dos_Add(N)
                End If
            Next
        End Sub
        Friend Event Rafraichit(ByVal N As TreeNode)

        ''' <summary>Ajoute le dos dans la racine</summary>
        Friend Sub Dos_Addrive()
            For Each drive As IO.DriveInfo In My.Computer.FileSystem.Drives
                If drive.IsReady Then
                    Dim Volume As New TreeNode()
                    Dim N As New TreeNode(drive.Name) '.Name.Substring(0, 2))
                    N.ToolTipText = drive.Name.Substring(0, 2)
                    Tronc.Nodes.Add(N) '(drive.Name.Substring(0, 2))
                End If
            Next
        End Sub

        ''' <summary>Ajoute les Dossiers du répertoire</summary>
        ''' <remarks>Les collections TreeNode.Nodes 
        ''' répertorient les répertoires.</remarks>
        Friend Sub Dos_Add(ByVal V As TreeNode)
            Dim S As String = Dos_Path(V) & "\"
            Dim Dir As New IO.DirectoryInfo(S)
            Dim Rep As IO.DirectoryInfo
            Try
                For Each Rep In Dir.GetDirectories()
                    V.Nodes.Add(Rep.Name) : Next
            Catch ex As Exception
            End Try
        End Sub

        ''' <summary>Le FullPath Dos</summary>
        ''' <remarks>Dos est géré comme un arbre
        ''' Dont les racines sont définies par programme</remarks>
        Friend Function Dos_Path(ByVal V As TreeNode) As String
            Dim S As String = ""
            Dim P As TreeNode = V
            Do While Not Tronc.Nodes.Contains(P)
                S = P.Text & "\" & S
                P = P.Parent
            Loop
            Return P.ToolTipText & "\" & S
        End Function

        Private Sub Tronc_BeforeExpand(ByVal sender As Object, ByVal e As TreeViewCancelEventArgs) Handles Tronc.BeforeExpand
            For Each N As TreeNode In e.Node.Nodes : If N.Nodes.Count = 0 Then : Dos_Add(N) : End If : Next
        End Sub

        Private Sub Tronc_AfterSelect(ByVal sender As Object, ByVal e As TreeViewEventArgs) Handles Tronc.AfterSelect
            Noeud = e.Node
            RaiseEvent Rafraichit(e.Node)
        End Sub

    End Class

    ''' <summary> Dialogue de sauvegarde </summary>
    Public Class FileDialog 'Ouvrir ou fermer un fichier
        Dim Lecture As Boolean = True
        Public Directory As String
        Public racine As String = "essai"
        Public Extension As String = ".txt"
        Public Filtre As String = "Tous les fichiers|*.*"

        Public Sub New(Optional ByVal Default_File_Name As String = "")
            If Default_File_Name = "" Then
                Directory = My.Computer.FileSystem.SpecialDirectories.Desktop
            Else : Name = Default_File_Name : End If
        End Sub
        'Ajouter une extension et un commentaire éventuel dans le filtre de selection des fichiers
        Public Sub AddFiltre _
        (ByRef Extension As String, Optional ByRef Description As String = "*")
            If Description = "*" Then Description = "*" & Extension
            Filtre = Description & "|*" & Extension & "|" & Filtre
        End Sub
        'Nom complet (Chemin\nom de fichier.extension)
        Public Property Name() As String
            Get
                Return Directory + "\" + racine + Extension
            End Get
            Set(ByVal File_Name As String)
                Directory = System.IO.Path.GetDirectoryName(File_Name)
                racine = System.IO.Path.GetFileNameWithoutExtension(File_Name)
                Extension = System.IO.Path.GetExtension(File_Name)
            End Set
        End Property

        ''' <summary> Selection du fichier dans l'explorateur </summary>
        ''' <remarks> Using D As New Dialog: D.Charge: Dim Fichier As String = D.Name : End Using </remarks>
        Public Function Charge() As DialogResult
            Dim Ok As DialogResult
            Using Ofd As New OpenFileDialog
                Ofd.Filter = Filtre
                Ofd.InitialDirectory = Directory
                Ok = Ofd.ShowDialog()
                If Ok = DialogResult.OK Then
                    Name = Ofd.FileName : End If
            End Using
            Return Ok
        End Function
        Public Function Sauve() As DialogResult
            Dim Ok As DialogResult
            Using Sfd As New SaveFileDialog
                Sfd.Filter = Filtre
                Sfd.FileName = racine
                Sfd.InitialDirectory = Directory
                Ok = Sfd.ShowDialog()
                If Ok = DialogResult.OK Then
                    Name = Sfd.FileName : End If
            End Using
            Return Ok
        End Function 'Using D As New Dialog: D.Sauve: Dim Fichier As String = D.Name : End Using 

    End Class

    Public Class PictOs
        'La classe Pictos gère les modalités de rafraîchissement automatique du système graphique de paint-brush.

        'Friend Pasdimage As Boolean = False
        Friend WithEvents Toile As PictureBox
        Friend WithEvents Diaporama As New Pictos_Diaporama

        Friend Sub New()
            Toile = New PictureBox
            Toile.ContextMenuStrip = New ContextMenuStrip
            Diaporama.Parametres = Toile.ContextMenuStrip.Items.Add("Diaporama")
        End Sub

        Private Sub Repeint(ByVal g As Graphics)
            g.Clear(Color.Aqua)
            Dim S As String = Form1.Main.Selecteur.Noeud.Text
            If S = "" Then S = "Fichier"
            Dim L As Integer = Toile.Size.Width / (S.Length)
            Dim u As Integer = 0
            Dim H As Integer = Toile.Size.Height / 4
            If Toile.Size.Height > L * 4 Then H = L : u = 1
            Dim f As New Font("tahoma", H, FontStyle.Bold)
            g.DrawString("Pas de", f, Brushes.YellowGreen, 0, H * u)
            g.DrawString(S, f, Brushes.YellowGreen, 0, H * (u + 1))
        End Sub

        'Peindre le graphics.
        Friend Sub Toile_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Toile.Paint
            If Diaporama.Liste.Count < 1 Then Repeint(e.Graphics)
        End Sub

        Friend Sub Image_Suivante() Handles Diaporama.ImageSuivante
            If Diaporama.Image.Equals(Nothing) Then  Else Toile.Image = Diaporama.Image
        End Sub

        Friend Sub Reset(ByVal Chemin As String)
            Diaporama.Url_Images = Chemin
            Diaporama.Liste = Diaporama.Directory_Images(Chemin)
            Diaporama.Indice_Diapo = 0
            Toile.Refresh()
        End Sub

    End Class

    Friend Class Pictos_Diaporama 'Diaporama des images d'un répertoire
        'La classe Pictos gère l'affichage des fichiers d'images sur le disque. 

        Friend WithEvents Diaporama As New Timer
        Friend WithEvents Parametres As ToolStripItem
        Friend Url_Images As String = Nothing
        Friend Indice_Diapo As Integer = 0
        Friend Tempo As Integer = 500
        Friend DiaporamaSelected As Boolean = True
        Friend Image As System.Drawing.Image
        Friend Event ImageSuivante()
        Dim WithEvents Fiche As Fiche_Diaporama
        Friend Pasdimage As Boolean = True
        Friend Liste As List(Of System.Drawing.Image)

        Private Class Fiche_Diaporama
            Dim WithEvents Pupitre As New Form
            Friend Diaporun As New CheckBox
            Dim Textinterval As New Label
            Friend DiapoIntervalle As New NumericUpDown
            Event Closing()
            Private Sub Skin()
                Diaporun.Text = "Diaporama" : Diaporun.CheckAlign = ContentAlignment.MiddleRight
                Pupitre.SetBounds(Form1.Location.X + 100, Form1.Location.Y + 100, 200, 200)
                Textinterval.SetBounds(0, 25, 300, 20)
                DiapoIntervalle.SetBounds(0, 50, 100, 20)
                Pupitre.Controls.Add(Diaporun)
                Pupitre.Controls.Add(Textinterval)
                Pupitre.Controls.Add(DiapoIntervalle)
            End Sub
            Friend Sub New()
                Textinterval.Text = "Vitesse en 1/10èmes de Seconde"
                Skin()
                Pupitre.Show()
            End Sub
            Friend Sub Form_Closing() Handles Pupitre.FormClosing
                RaiseEvent Closing()
            End Sub
        End Class

        Private Sub Parametres_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Parametres.Click
            Fiche = New Fiche_Diaporama
            Fiche.DiapoIntervalle.Value = Tempo / 100  ' 10eme de seconde = 100 millisecondes
            Fiche.Diaporun.Checked = DiaporamaSelected
        End Sub
        Friend Sub Fiche_Closing() Handles Fiche.Closing
            DiaporamaSelected = Fiche.Diaporun.Checked
            Tempo = Fiche.DiapoIntervalle.Value * 100
            Diaporama.Interval = Tempo
            If DiaporamaSelected Then Diaporama.Start() Else Diaporama.Stop()
        End Sub

        ''' <summary> Liste des fichiers d'image du répertoire </summary> <param name="Path_Dossier"></param>
        Friend Function Directory_Images(ByVal Path_Dossier As String) As List(Of System.Drawing.Image)
            Dim Liste As New List(Of System.Drawing.Image)
            'Dim ImageTest As System.Drawing.Image
            For Each Fichier As String In My.Computer.FileSystem.GetFiles(Path_Dossier)
                Try
                    'ImageTest = System.Drawing.Image.FromFile(Fichier)
                    Liste.Add(System.Drawing.Image.FromFile(Fichier))
                Catch ex As Exception
                End Try
            Next
            Return Liste
        End Function

        Friend Sub Tempo_Tick() Handles Diaporama.Tick
            If Liste.Count > 0 Then
                Image = Liste.Item(Indice_Diapo)
                RaiseEvent ImageSuivante()
                Indice_Diapo = Indice_Diapo + 1
                If Indice_Diapo >= Liste.Count Then Indice_Diapo = 0
            Else : Image = Nothing
            End If
        End Sub

        Friend Sub New()
            Diaporama.Interval = Tempo
            Diaporama.Start()
        End Sub
    End Class

    Friend Class TextOs
        Friend Livre As New RichTextBox

        Dim TextOs_Menu As ContextMenuStrip
        'Dim F As New FileDialog

        Dim WithEvents Copie As ToolStripItem
        Dim WithEvents Colle As ToolStripItem
        Dim WithEvents Sauve As ToolStripItem
        Dim WithEvents Charge As ToolStripItem

        Friend Sub New()
            'Copie = New ToolStripItem
            'Livre.ContextMenuStrip = New ContextMenuStrip
            TextOs_Menu = New ContextMenuStrip
            Copie = TextOs_Menu.Items.Add("Copie")
            Colle = TextOs_Menu.Items.Add("Coller")
            Sauve = TextOs_Menu.Items.Add("Sauver")
            Charge = TextOs_Menu.Items.Add("Charger.rtf")
            Livre.ContextMenuStrip = TextOs_Menu
        End Sub

        Private Sub Copie_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Copie.Click
            Livre.Copy()
        End Sub
        Private Sub Colle_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Colle.Click
            Livre.Paste()
        End Sub
        Private Sub Sauve_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Sauve.Click
            Dim F As New FileDialog(Form1.Main.Chemin & Form1.Main.Selecteur.Noeud.Text)
            F.AddFiltre(".rtf", "Texte amélioré")
            F.AddFiltre(".txt", "Texte à skis")
            If F.Sauve = DialogResult.OK Then Livre.SaveFile(F.Name)
        End Sub
        Private Sub Charge_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Charge.Click
            Dim F As New FileDialog(Form1.Main.Chemin)
            If F.Charge = DialogResult.OK Then
                If F.Extension = "rtf" Then Livre.LoadFile(F.Name) Else Livre.Text = LoadFile(F.Name)
            End If
        End Sub

    End Class

#Region "Module Util"

    Friend ToutAnchor As AnchorStyles = AnchorStyles.Bottom Or AnchorStyles.Left Or AnchorStyles.Right Or AnchorStyles.Top

    Friend Function LoadFile(ByVal FileName As String) As String
        Dim Flux As New IO.StreamReader(FileName)
        Return Flux.ReadToEnd
    End Function

    Friend Declare Function FindExecutable Lib "Shell32.Dll" _
    Alias "FindExecutableA" (ByVal lpFile As String, _
                             ByVal lpDirectory As String, _
                             ByVal lpResult As String) As Long

    Friend Function ProgAssocie(ByVal File_Name As String) As String
        Dim stFichier As String = System.IO.Path.GetFileName(File_Name)
        Dim stChemin As String = System.IO.Path.GetDirectoryName(File_Name)
        Dim stDossier As String = Space$(250)
        Dim lgDossier As Long = FindExecutable(stFichier, stChemin, stDossier)
        Return stDossier.Substring(0, InStr(1, stDossier, vbNullChar) - 1)
    End Function

#End Region 'End Module

#End Region

End Module

Conclusion :


La prochaine version devrait gérer l'actualisation de l'arbre des dossiers quand on modifie l'arborescence dans une autre tâche. (avec Windows explorer par exemple.), mais pas avant longtemps.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (Londonic)