Tiny File Manager

Back Back Up Advanced Editor

Attribute VB_Name = "Module4"
Option Explicit

Dim Num As Integer
Dim Pos_X As Integer
Dim Pos_Y As Integer
Dim Type_Instance As String
Dim Orientation As String

Dim tmp As Long

' Filter
Public Const filtre_champ = "Text Files (*.txt)|*.txt|All Files (*.*)|*.*|"

Public Function Ouvrir_Document()
    
       
    ' ouvrir un document existant
    On Error GoTo OpenError
       
    Dim Fichier_Nom As String
    Dim Data As String
    Dim chaine(200) As String
    
    Dim nbre_ligne As Integer
    Dim position As Integer
    Dim cpt_PAD As Integer
    
    
    nbre_ligne = 1
        
    With Prog_Frm
        .CmDlg.CancelError = True
        .CmDlg.DialogTitle = "Selection du fichier � ouvrir"
        .CmDlg.Filter = filtre_champ
        .CmDlg.FilterIndex = 1
        .CmDlg.ShowOpen
   End With
       
   Fichier_Nom = Prog_Frm.CmDlg.FileName

' lecture du fichier
   Open Fichier_Nom For Input As #1
   
  
 ' Dim intFic As Integer
'Dim client As tClient
'intFic = FreeFile
'Open "c:\pad.txt" For Random As intFic Len = Len(client)
'Get intFic, 1, client
'MsgBox client.Num
'Get intFic, 2, client
'MsgBox client.Num
'Close intFic
  
  Dim temp As String
  Dim PAD_toto As Integer
  
  
   While Not EOF(1)
   Input #1, Data$
   cpt_PAD = cpt_PAD + 1
   chaine(nbre_ligne) = Data$  ' + Chr$(13) + Chr$(10)
   temp = chaine(nbre_ligne)
   temp = extraction_champ(temp, "PAD")
   ' insert un pad
    PAD_toto = Insert(Pos_X, Pos_Y, Type_Instance, Orientation)
    ReDraw Prog_Frm.Schema_Box
    
   nbre_ligne = nbre_ligne + 1
   Wend
   
  Close #1
   
    
OpenError:
    
    'If Err.Number = 32755 Then Exit Function 'If canceled then exit function
    'ErrorLog "modDocument/OpenDocument"
End Function

Public Function extraction_champ(chaine As String, type_objet As String)
    Dim Tableau() As String
    Dim i As Integer
    
    'd�coupe la chaine en fonction des espaces " "
    'le r�sultat de la fonction Split est stock� dans un tableau
    Tableau = Split(chaine, " ")
    
    'boucle sur le tableau pour visualiser le r�sultat
    For i = 0 To UBound(Tableau)
        'Le r�sultat s'affiche dans la fen�tre d'execution de l'�diteur de macros
        Debug.Print Tableau(i)
    Next i
    
    Num = Tableau(0)
    Pos_X = Tableau(1)
    Pos_Y = Tableau(2)
    
    If (type_objet = "PAD") Then
        Type_Instance = Tableau(3)
        Orientation = LCase(Tableau(4))
    End If
    
End Function

Public Property Get CancelError() As Boolean
    CancelError = m_CancelError
End Property
Public Property Let CancelError(ByVal New_CancelError As Boolean)
    m_CancelError = New_CancelError
    PropertyChanged "CancelError"
End Property

Public Property Get Filter() As String
    Filter = m_Filter
End Property
Public Property Let filtre(ByVal New_Filter As String)
    m_Filter = New_Filter
    PropertyChanged "Filtre"
End Property
Public Property Get FilterIndex() As Integer
    FilterIndex = m_FilterIndex
End Property
Public Property Let FilterIndex(ByVal New_FilterIndex As Integer)
    m_FilterIndex = New_FilterIndex
    PropertyChanged "FilterIndex"
End Property
Public Property Get DialogTitle() As String
    DialogTitle = m_DialogTitle
End Property
Public Property Let DialogTitle(ByVal New_DialogTitle As String)
    m_DialogTitle = New_DialogTitle
    PropertyChanged "DialogTitle"
End Property

Public Function Import_Template()

On Error GoTo OpenError
       
    Dim Fichier_Nom As String
    Dim Data As String
    Dim chaine(200) As String
    
    Dim nbre_ligne As Integer
    Dim position As Integer
    Dim cpt_PAD As Integer
    
    
    nbre_ligne = 1
        
    With Prog_Frm
        .CmDlg.CancelError = True
        .CmDlg.DialogTitle = "Selection du fichier � ouvrir"
        .CmDlg.Filter = filtre_champ
        .CmDlg.FilterIndex = 1
        .CmDlg.ShowOpen
   End With
       
   Fichier_Nom = Prog_Frm.CmDlg.FileName

' lecture du fichier
   Open Fichier_Nom For Input As #1

Dim temp As String
  Dim PAD_toto As Integer
  
  
   While Not EOF(1)
        Input #1, Data$
        cpt_PAD = cpt_PAD + 1
        chaine(nbre_ligne) = Data$
        temp = chaine(nbre_ligne)
        temp = extraction_champ(temp, "PIN")
        ' ajouter la pin
        PAD_toto = Insert_Pin(Pos_X, Pos_Y, Num)
        Affiche_PIN Prog_Frm.Schema_Box
        nbre_ligne = nbre_ligne + 1
   Wend
   
  Close #1
   
    
OpenError:

End Function

Public Function Insert_Pin(ByVal cX As Integer, ByVal cY As Integer, ByVal Num) As Long

' incr�mente le nombre de pin
NB_PIN = NB_PIN + 1

' redimensionne le tableau de liens
ReDim Preserve Objet_PIN(NB_PIN - 1)

' instancie une nouvelle pin
Set Objet_PIN(NB_PIN - 1) = New Broche

' defini les parametres de la nouvelle pin
 tmp = Objet_PIN(NB_PIN - 1).Set_PIN_Parametres(NB_PIN - 1, cX, cY)

' retourne l'ID de la pin
Insert_Pin = NB_PIN - 1
    
End Function

Public Sub Affiche_PIN(pic As PictureBox)
    
    Dim i As Integer
    Dim PosX As Integer
    Dim PosY As Integer
    
    PosX = 0
    PosY = 0
    pic.Cls
            
    For i = 0 To NB_PIN - 1
           ' recupere la position de la pin
            tmp = Objet_PIN(i).Get_PIN_Position(PosX, PosY)
            'dessine la pin
            tmp = Dessine_PIN(PosX, PosY, pic)
    Next i
    
End Sub

Public Function Dessine_PIN(ByVal X As Integer, ByVal Y As Integer, pic As PictureBox)

Dim i As Integer

'couleurboite = RGB(0, 0, 0)
'couleur = RGB(255, 0, 0)

'Trace des croix centr�es sur le curseur
   For i = -5 To 5
      pic.PSet (X - 66 + i, Y - 48), couleur
      pic.PSet (X - 66, Y - 48 + i), couleur
      'Trace des croix centr�es sur le curseur
   Next i

' dessine une croix pour indiquer la position dans le plan
'pic.Line (X, Y)-(X + 50, Y), couleurboite
'pic.Line (X + 25, Y - 25)-(X, Y + 25), couleurboite
' dessine le point de gravit�
' pic.Circle (X + largeur / 2, Y + hauteur / 2), taillepuce, couleur

'For i = 0 To 50
'pic.PSet (X, Y + i), couleurboite
'Next i

'For i = 0 To 50
'pic.PSet (X + 25, Y - 25 + i), couleurboite
'Next i

End Function