Editeur de matrices et de propriétés

Télécharger le projet
Commenter

Description

Si vous avez regardé mes autres programmes en vb, celui-la vous semblera redondant , il utilise des fichiers communs a tout mes anciens programmes en vb (iostream.txt, property.txt).
Vous-êtes vous déja demmandé comment écrire en temps réel dans un fichier-matrice ou un fichier stoquant des propriétés ?
Voila ce que le prog fait. Il exploite ma property.txt. Le programme crée des matfile et datfile (fichier de matrices et respectivement de propriétés).
Mon property.txt a été créé pour un jeu de role que je n'ai même pas commancé, j'ai abandonné le vb avant .
###
comme d'habitude, pour les exe allez a http://magus54.free.fr/prog
###

Source / Exemple :

'Voici le sourcecode de property.txt
'Ce fichier à été créé en un moi de sueurs suite à ma
'découverte de php&mysql
' ... alors RESPECT
'       Read an write variables directely from an BIN file
'
' Mk_Datfile(templatefile$,outfile$ ,2) to create an dat file
'               NEVER FORGET THE ',2'
' Open_DatFile(datfile$) opens a datfile and return its id
' Add_Item(id) Creates an new item in the file and
'   reserve space for its propertys, and return is number
'   NOTA: you can NOT delete items in an datfile

' Chg_Prop_Int(id,no,prop$,newval$)
' Chg_Prop_Str(id,no,prop$,newval$)
' Read_Prop_Int(id,no,prop$) return the number in the prop
' Read_Prop_Str(id,no,prop$) return the str in the prop
' Close_DatFile(id) close the datfile opened before
' Update_Datfile_With_Inifile (id, Filename$) fill a datfile
'   with the contains of the filename$. Easy:
'       [number_of_the_element]
'       property=value    // Achtnung ! For a number, value must
'                         // start with & ("&d255"=255 "&hFF"=255)
'       ...

'
' You must use this basfile with Iostream.bas

'---------------------------------------------------
'MatriX Functions:
'Mk_matfile (X_dim , Y_Dim, L_Dim, OutputFile) create a matfile
' Nota: The matrix will be earsed after its creation.
'        This will take a lot of time events its dims
'        are big
'Open_Matfile(filename) open a matfile and returns its id
'Close_Matfile(id)
'Read_Matrix_int(id,x,y) return a number in the matrix
'Read_Matrix_Str(id,x,y) return a string in the matrix
'Write_Matrix_int(id,x,y,valu)
'Write_Matrix_Str(id,x,y,valu$)

'Declarations for this file:
Const DATFILE_INIT_STRING = "DATZ"  '// the begenning of each datfile
Dim FILE_PROPERTIES_FILEID(-1 To 100) As Integer
Dim FILE_PROPERTIES_MAX(-1 To 100) As Integer
Dim FILE_PROPERTIES_ZERO(-1 To 100) As Integer
Dim FILE_PROPERTIES_Nom(-1 To 100, 255) As String
Dim FILE_PROPERTIES_FileName(-1 To 100) As String
Dim FILE_PROPERTIES_Start(-1 To 100, 255) As Integer
Dim FILE_PROPERTIES_End(-1 To 100, 255) As Integer
Dim BUILDING_Template As String


Const MATFILE_INIT_STRING = "MATZ"  '// the begenning of each matfile
Dim FILE_MATRIX_FILEID(-1 To 255) As Integer
Dim FILE_MATRIX_X(-1 To 255) As Integer
Dim FILE_MATRIX_Y(-1 To 255) As Integer
Dim FILE_MATRIX_ZERO(-1 To 255) As Integer
Dim FILE_MATRIX_FileName(-1 To 255) As String
Dim FILE_MATRIX_DIM(-1 To 255) As Integer




Dim ForEach_i(-1 To 255) As Integer
Dim ForEach_n(-1 To 255) As String

Sub Mk_Datfile (TemplateFile As String, OutputFile As String, Ini_n As Integer)
On Error GoTo STOP_MKYINGDATFILE
Ini_n = 2
dis$ = DATFILE_INIT_STRING
nul$ = Chr$(0): onee$ = Chr$(1): nlen$ = Chr$(Ini_n)
Dim StartProp As Integer, EndProp As Integer
'Préparation du fichier
Out = Open_DosFile(OutputFile, "output"): Close Out: Kill OutputFile

    Out = Open_DosFile(OutputFile, "binary")
        Put #Out, 1, dis$ '//Verif la validité du fichier
        Put #Out, 1 + Len(dis$), nlen$ '// Nb d'octets à lire pour localiser les prop
        Put #Out, 2 + Len(dis$), nul$  '// Nb occupé par la déclaration des props
        Put #Out, 3 + Len(dis$), nul$  '// Nb occupé par la déclaration des props
        Put #Out, 4 + Len(dis$), nul$  '// Occupé pour le nb d'échantillons
        Put #Out, 5 + Len(dis$), nul$  '// Occupé pour le nb d'échantillons
        Put #Out, 6 + Len(dis$), nul$  '// Occupé pour le nb d'échantillons
        Put #Out, 7 + Len(dis$), nul$  '// ne sers à rien
    Close #Out
EndProp = 0: prop_name_decl = Len(dis$) + 8
        

In = Open_DosFile(TemplateFile, "input")
Out = Open_DosFile(OutputFile, "binary")
    
    Do While Not EOF(In)
        Line Input #In, txt$
            prop_n$ = Get_Word(txt$, 0, " "): Prop_len = Val(Get_Word(txt$, 1, " "))
            StartProp = EndProp + 1: EndProp = StartProp + Prop_len
            Str_p$ = Chr$(0) + Trs_Int(StartProp, Ini_n) + Trs_Int(EndProp, Ini_n) + prop_n$
            
            Put #Out, prop_name_decl, Str_p$
            prop_name_decl = prop_name_decl + Len(Str_p$)
    Loop

        'Valider le nb de props
        StartProp = prop_name_decl
        Str_p$ = Trs_Int(StartProp, 2): Put #Out, 2 + Len(dis$), Str_p$
        
STOP_MKYINGDATFILE: If Err <> 0 Then Resume STOP_MKYINGDATFILE
Close #In: Close #Out

End Sub



Function Open_Datfile (fichier As String) As Integer
'Debug.Print "OPEN_DATFILE:" + fichier
'Déclarations
    Dim C As String * 1: dis$ = DATFILE_INIT_STRING

'Obtenir un id de DATFILE =>id
    For i = 0 To 16: If FILE_PROPERTIES_FILEID(i) = 0 Then Exit For
    Next: If FILE_PROPERTIES_FILEID(i) <> 0 Then Open_Datfile = -1: Exit Function
    id = i: FILE_PROPERTIES_FileName(id) = fichier
    Open_Datfile = id

'Ouvrir le fichier =>FileID
    FileID = Open_DosFile(fichier, "binary"): If FileID = -1 Then Open_Datfile = -1: Exit Function
    FILE_PROPERTIES_FILEID(i) = FileID

'Verifier qu'il sagit bien d'un fichier DATZ
    d$ = Read_From_File(FileID, 1, Len(dis$))
    If d$ <> dis$ Then Open_Datfile = -1: Exit Function


'Obtenir la déclaration des propriétés
    prop_name_decl = Val("&h" + From_Bin_To_Hex(Read_From_File(FileID, 2 + Len(dis$), 2)))
    Start_p = Len(dis$) + 8
    Property_String$ = Read_From_File(FileID, Start_p, prop_name_decl)
    FILE_PROPERTIES_ZERO(id) = Start_p + prop_name_decl


'Traiter cette déclaration
    x = 1: maxp = 0
    Do: x = x + 1
        np$ = ""
        Start_Str$ = Mid$(Property_String$, x, 2): x = x + 2
        If Val("&h" + From_Bin_To_Hex(Start_Str$)) = 0 Then Exit Do
        FILE_PROPERTIES_Start(id, maxp) = Val("&h" + From_Bin_To_Hex(Start_Str$))
        End_Str$ = Mid$(Property_String$, x, 2): x = x + 2
        FILE_PROPERTIES_End(id, maxp) = Val("&h" + From_Bin_To_Hex(End_Str$))
    
        Do While Mid$(Property_String$, x, 1) <> Chr$(0)
            np$ = np$ + Mid$(Property_String$, x, 1): x = x + 1
        Loop
        FILE_PROPERTIES_Nom(id, maxp) = np$
        'Debug.Print "OPEN_DATFILE: "; np$ + "=>[" + Str$(FILE_PROPERTIES_Start(id, maxp)) + ";" + Str$(FILE_PROPERTIES_End(id, maxp)) + "]:" + Str$(FILE_PROPERTIES_End(id, maxp) - FILE_PROPERTIES_Start(id, maxp))
        maxp = maxp + 1
    Loop While x < Len(Property_String$)
    
    FILE_PROPERTIES_MAX(id) = maxp

'Terminé !! Renvoyer l'id du fichier DAT
    Open_Datfile = id
End Function


Sub Close_Datfile (id_datfile)
Close FILE_PROPERTIES_FILEID(id_datfile): FILE_PROPERTIES_FILEID(id_datfile) = 0
End Sub

Function Get_Number_Of_Items (nb)
    dis$ = DATFILE_INIT_STRING
    FileID = FILE_PROPERTIES_FILEID(nb)
    t$ = From_Bin_To_Hex(Read_From_File(FileID, 4 + Len(dis$), 3))
    Get_Number_Of_Items = Val("&h" + t$)

End Function


Sub Change_number_of_Items (id, nb)
    dis$ = DATFILE_INIT_STRING
    FileID = FILE_PROPERTIES_FILEID(id)
    hexx$ = Hex$(nb)
    binn$ = Expand_Bin(From_Hex_To_Bin(hexx$), 3)

    Put #FileID, 4 + Len(dis$), binn$

End Sub

Function Add_Item (id)
FileID = FILE_PROPERTIES_FILEID(id)

n = Get_Number_Of_Items(id) + 1

Change_number_of_Items id, n

Add_Item = n

maxp = FILE_PROPERTIES_MAX(id)
Start_Item = FILE_PROPERTIES_ZERO(id) + (FILE_PROPERTIES_End(id, maxp - 1) + 1) * n
End_Item = FILE_PROPERTIES_ZERO(id) + (FILE_PROPERTIES_End(id, maxp - 1) + 1) * (n + 1)
Len_Item = End_Item - Start_Item

    t$ = String$(Len_Item, Chr$(0))
    Put #FileID, Start_Item + 1, t$

End Function

Sub Chg_Prop_Str (ByVal id, ByVal no_item, prop_n$, ByVal NewVal$)
Dim LenI As Integer
Dim C As String * 1

maxp = FILE_PROPERTIES_MAX(id)
FileID = FILE_PROPERTIES_FILEID(id)
For i = 0 To maxp - 1
    If LCase$(FILE_PROPERTIES_Nom(id, i)) = LCase$(prop_n$) Then Exit For
Next
If LCase$(FILE_PROPERTIES_Nom(id, i)) <> LCase$(prop_n$) Then Exit Sub
no_prop = i

Start_Item = FILE_PROPERTIES_ZERO(id) + (FILE_PROPERTIES_End(id, maxp - 1) + 1) * no_item
StartI = FILE_PROPERTIES_Start(id, i)
EndI = FILE_PROPERTIES_End(id, i)
LenI = EndI - StartI
NV$ = Expand_Bin(NewVal$, LenI)

For x = 0 To LenI - 1
    C = Mid$(NV$, x + 1, 1)
    Put #FileID, Start_Item + StartI + x, C
Next

End Sub



Function Read_Prop_Str (ByVal id, ByVal no_item, prop_n$) As String
Dim C As String * 1

maxp = FILE_PROPERTIES_MAX(id)
FileID = FILE_PROPERTIES_FILEID(id)
For i = 0 To maxp - 1
    If LCase$(FILE_PROPERTIES_Nom(id, i)) = LCase$(prop_n$) Then Exit For
Next
If LCase$(FILE_PROPERTIES_Nom(id, i)) <> LCase$(prop_n$) Then Exit Function
no_prop = i

Start_Item = FILE_PROPERTIES_ZERO(id) + (FILE_PROPERTIES_End(id, maxp - 1) + 1) * no_item
StartI = FILE_PROPERTIES_Start(id, no_prop)
EndI = FILE_PROPERTIES_End(id, no_prop)
LenI = EndI - StartI
Read_Prop_Str = Read_From_File(FileID, Start_Item + StartI, LenI)
End Function

Sub Chg_Prop_Int (id, no_item, prop_n$, NewVal)
hexx$ = Hex$(NewVal)
NewVall$ = From_Hex_To_Bin(hexx$)
Chg_Prop_Str id, no_item, prop_n$, NewVall$
End Sub


Function Read_Prop_Int (ByVal id, ByVal no_item, ByVal prop_n$) As Integer

    stred$ = Read_Prop_Str(id, no_item, prop_n$)
    hexx$ = From_Bin_To_Hex(stred$)
    Read_Prop_Int = Val("&h" + hexx$)

End Function

Sub Close_MatFile (id_matfile)
Close FILE_MATRIX_FILEID(id_matfile): FILE_MATRIX_FILEID(id_matfile) = 0
End Sub

Sub Mk_MatFile (X_dim As Integer, Y_Dim As Integer, L_Dim As Integer, OutputFile As String)
Dim e As Long, i    As Long
'On Error GoTo STOP_MKYINGMATFILE
mis$ = MATFILE_INIT_STRING
nul$ = Chr$(0): nlen$ = Chr$(L_Dim)
X_d$ = Trs_Int(X_dim, 2): Y_D$ = Trs_Int(Y_Dim, 2)

Out = Open_DosFile(OutputFile, "output"): Close Out: Kill OutputFile

    Out = Open_DosFile(OutputFile, "binary")
        Put #Out, 1, mis$ '//Verif la validité du fichier
        Put #Out, 1 + Len(mis$), nlen$ '// Nb d'octets à lire pour chaque elem de la mat
        Put #Out, 2 + Len(mis$), X_d$  '// X_Dimenstion (2 chars)
        Put #Out, 4 + Len(mis$), Y_D$  '// Y_Dim
        Rem Put #Out, 5 + Len(mis$), nul$  '// ne sers à rien
        
        ' Faire un fichier VIDE
        s = 6 + Len(mis$): e = X_dim * L_Dim: e = e * Y_Dim: e = e + s
        
        For i = s To e: Put #Out, i, nul$: Next
        
         

     

STOP_MKYINGMATFILE: If Err <> 0 Then Resume STOP_MKYINGMATFILE
    Close #Out
End Sub

Function Open_MatFile (ByVal fichier As String) As Integer
'Déclarations
    Dim C As String * 1: mis$ = MATFILE_INIT_STRING

'Obtenir un id de DATFILE =>id
    For i = 0 To 16: If FILE_MATRIX_FILEID(i) = 0 Then Exit For
    Next: If FILE_MATRIX_FILEID(i) <> 0 Then Open_MatFile = -1: Exit Function
    id = i: FILE_MATRIX_FileName(id) = fichier
    Open_MatFile = id

'Ouvrir le fichier =>FileID
    FileID = Open_DosFile(fichier, "binary"): If FileID = -1 Then Open_MatFile = -1: Exit Function
    FILE_MATRIX_FILEID(i) = FileID

'Verifier qu'il sagit bien d'un fichier MATZ
    d$ = Read_From_File(FileID, 1, Len(mis$))
    If d$ <> mis$ Then Open_MatFile = -1: Exit Function


'Obtenir les dimensions de la matrice
        nlen$ = Read_From_File(FileID, 1 + Len(mis$), 1)
        X_d$ = Read_From_File(FileID, 2 + Len(mis$), 2)
        Y_D$ = Read_From_File(FileID, 4 + Len(mis$), 2)
        FILE_MATRIX_ZERO(id) = 6 + Len(mis$)
        FILE_MATRIX_ZERO(id) = 6 + Len(mis$)
        FILE_MATRIX_X(id) = Val("&h" + From_Bin_To_Hex(X_d$))
        FILE_MATRIX_Y(id) = Val("&h" + From_Bin_To_Hex(Y_D$))
        FILE_MATRIX_DIM(id) = Val("&h" + From_Bin_To_Hex(nlen$))
End Function


Function Read_MatriX_Str (id_matfile, x, Y) As String

    pos = Pos_Matrix(id_matfile, x, Y)
    FileID = FILE_MATRIX_FILEID(id_matfile)
    l = FILE_MATRIX_DIM(id_matfile)

Read_MatriX_Str = Read_From_File(FileID, pos, l)

End Function




Sub Write_Matrix_Str (id_matfile, x, Y, valu As String)
Dim l As Integer
pos = Pos_Matrix(id_matfile, x, Y)
FileID = FILE_MATRIX_FILEID(id_matfile)
l = FILE_MATRIX_DIM(id_matfile)

valu2$ = Expand_Bin(valu, l)
Put #FileID, pos, valu2$
End Sub

Function Read_Matrix_Int (id_matfile, x, Y) As Integer

    stred$ = Read_MatriX_Str(id_matfile, x, Y)
    hexx$ = From_Bin_To_Hex(stred$)
    Read_Matrix_Int = Val("&h" + hexx$)

End Function

Sub Write_Matrix_Int (id_matfile, x, Y, NewVal As Integer)
    hexx$ = Hex$(NewVal)
    NewVall$ = From_Hex_To_Bin(hexx$)
Write_Matrix_Str id_matfile, x, Y, NewVall$

End Sub

Sub Update_Datfile_With_Inifile (id_datfile, Filename As String)
On Error GoTo ERROR_UPDATING_DATFILE

'Récupérer le nom du fichier DAT et ouvrir le template
    DatNam$ = FILE_PROPERTIES_FileName(id_datfile)
    FileID = FILE_PROPERTIES_FILEID(id_datfile)
    template = Open_DosFile(Filename, "input")
        
'Traiter le template
    Do While Not EOF(template)
        Line Input #template, txt$
        'Traiter txt$
            If text$ <> "" And Left$(txt$, 1) <> ";" Then
                If Left$(txt$, 1) = "[" And Right$(txt$, 1) = "]" Then
                    np = Val(Mid$(txt$, 2, Len(txt$) - 2))
                    Change_number_of_Items id_datfile, np
                ElseIf InStr(txt$, "=") Then
                       PropNam$ = Get_Word2(txt$, 0, "=")
                       valu$ = Get_Word2(txt$, 1, "=")
                        Select Case UCase$(Left$(valu$, 2))
                            Case "&D"
                                vval$ = Hex$(Val(Mid$(valu$, 3)))
                                Resu$ = From_Hex_To_Bin(vval$)
                            Case "&H"
                                vval$ = Hex$(Val(valu$))
                                Resu$ = From_Hex_To_Bin(vval$)
                            Case Else
                                Resu$ = valu$
                        End Select
                        Chg_Prop_Str id_datfile, np, PropNam$, Resu$
                End If
            End If
    Loop




'Terminer la Sub
ERROR_UPDATING_DATFILE: If Err <> 0 Then Resume ERROR_UPDATING_DATFILE
    Close #template
End Sub

Function Pos_Matrix (id_matfile, x, Y) As Double
    zero = FILE_MATRIX_ZERO(id_matfile)
    l = FILE_MATRIX_DIM(id_matfile)
    Xmax = FILE_MATRIX_X(id_matfile)

Dim one As Double
    one = (Xmax + 1) * Y
    one = one + x
    one = one * l
    one = one + zero
Pos_Matrix = one
End Function

Sub Create_Template ()
BUILDING_Template = ""
End Sub

Sub Add_Prop_toTemplate (nomprop$, lenght)
template$ = BUILDING_Template
If template$ <> "" Then
  template$ = template$ + Chr$(13) + Chr$(10) + nomprop$ + Str$(lenght)
Else
  template$ = nomprop$ + Str$(lenght)
End If
BUILDING_Template = template$
End Sub


Sub Write_templateFile (file$)
fileref = Open_DosFile(file$, "output")
Print #fileref, BUILDING_Template
Close fileref
End Sub

Function Read_Matrix_Double (id_matfile, x, Y) As Double
    stred$ = Read_MatriX_Str(id_matfile, x, Y)
    hexx$ = From_Bin_To_Hex(stred$)
    Read_Matrix_Double = Val("&h" + hexx$)

End Function

Function Read_Matrix_Long (id_matfile, x, Y) As Long
    stred$ = Read_MatriX_Str(id_matfile, x, Y)
    hexx$ = From_Bin_To_Hex(stred$)
    Read_Matrix_Long = From_Hex_To_Int(hexx$)

End Function

Function Read_Prop_Double (id, no_item, prop_n$) As Double
    stred$ = Read_Prop_Str(id, no_item, prop_n$)
    hexx$ = From_Bin_To_Hex(stred$)
    Read_Prop_Double = Val("&h" + hexx$)

End Function

Function Read_Prop_Long (id, no_item, prop_n$) As Long
    stred$ = Read_Prop_Str(id, no_item, prop_n$)
    hexx$ = From_Bin_To_Hex(stred$)
    Read_Prop_Long = From_Hex_To_Int(hexx$)'Val("&h" + hexx$)

End Function

Function Get_PropName (id, no) As String
Get_PropName = FILE_PROPERTIES_Nom(id, no)

End Function

Function Whatis_This_Propfile (fichier As String)

fich = Open_DosFile(fichier, "binary")
    id$ = Read_From_File(fich, 1, 4)
Close fich
    Select Case id$
    Case "DATZ": Whatis_This_Propfile = 1
    Case "MATZ": Whatis_This_Propfile = 2
    Case Else: Whatis_This_Propfile = -1
    End Select
End Function

Function Matrix_Get_XDIM (id) As Integer
Matrix_Get_XDIM = FILE_MATRIX_X(id)

End Function

Function Matrix_Get_YDIM (id) As Integer
Matrix_Get_YDIM = FILE_MATRIX_Y(id)

End Function

Function Matrix_Get_LDIM (id) As Integer
Matrix_Get_LDIM = FILE_MATRIX_DIM(id)

End Function

Function Get_Prop_Dim (id, prop_n$)
maxp = FILE_PROPERTIES_MAX(id)
FileID = FILE_PROPERTIES_FILEID(id)
For i = 0 To maxp - 1
    If LCase$(FILE_PROPERTIES_Nom(id, i)) = LCase$(prop_n$) Then Exit For
Next
If LCase$(FILE_PROPERTIES_Nom(id, i)) <> LCase$(prop_n$) Then Exit Function

StartI = FILE_PROPERTIES_Start(id, i)
EndI = FILE_PROPERTIES_End(id, i)
Get_Prop_Dim = EndI - StartI

End Function

Function ForEach_str (id, prop_n$) As String
If prop_n$ <> ForEach_n(id) Then ForEach_i(id) = 0: ForEach_n(id) = prop_n$
If prop_n$ = "" Or ForEach_i(id) + 1 > Get_Number_Of_Items(id) Then Exit Function
x = ForEach_i(id) + 1: ForEach_i(id) = x
    ForEach_str = Read_Prop_Str(id, x, prop_n$)
End Function

Function Where (ByVal id, ByVal prop$, ByVal valu$)

     max = Get_Number_Of_Items(id): Where = -1
     For i = 1 To max
        If Short_String(Read_Prop_Str(ByVal id, ByVal i, prop$)) = valu$ Then Where = i: Exit Function
     Next

End Function

Conclusion :

Par exemple, pour créér une matrice 8x8 (pour une de mes anciennes passions, les échecs), il suffit de faire
Mk_matfile (8 , 8, 1, "sauvegarde.mat")
Attention ! la matrice part de zéro , pas de 1 !!
on ouvre la matrice:
echequier=Open_Matfile("sauvegarde.mat")
on place un pion sur l'échiquier:
Write_Matrix_int(echequier,3,2,PION)
(on définira PION avant)
on ferme et on enregistre:
Close_Matfile(echequier)
et voilaaa !! Comment faire plus simple ?
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 (magus54)