Cerca Totem's Lair su Facebook



Le libreria TLTFormat


Dopo aver pensato al concetto, è ora di venire alle mani, per modo di dire, e scrivere il codice. Questo namespace espone tre classi principali:
Imports System.IO
Imports System.IO.Compression
Imports System.Text.UTF8Encoding
Namespace TLTFormat
    'Questa classe rappresenta un chunk di testo e tutte le
    'informazioni di formattazione ad esso connesse
    Public Class TextChunk
        'Enumeratore per l'allineamento. Ne esiste già uno,
        'ma non ha il campo Giustificato
        Public Enum Alignment
            Left
            Right
            Center
            Justify
        End Enum

        'Grassetto
        Private _IsBold As Boolean = False
        'Corsivo
        Private _IsItalic As Boolean = False
        'Sottolineato
        Private _IsUnderlined As Boolean = False
        'Colore
        Private _Color As Color = Drawing.Color.Black
        'Nome del font
        Private _FontName As String = "Times New Roman"
        'Dimensione
        Private _Size As Byte = 12
        'Testo del chunk
        Private _Text As String
        'Allineamento
        Private _Align As Alignment = Alignment.Left

        Public Property IsBold() As Boolean
            Get
                Return _IsBold
            End Get
            Set(ByVal Value As Boolean)
                _IsBold = Value
            End Set
        End Property

        Public Property IsItalic() As Boolean
            Get
                Return _IsItalic
            End Get
            Set(ByVal Value As Boolean)
                _IsItalic = Value
            End Set
        End Property

        Public Property IsUnderlined() As Boolean
            Get
                Return _IsUnderlined
            End Get
            Set(ByVal Value As Boolean)
                _IsUnderlined = Value
            End Set
        End Property

        Public Property Color() As Color
            Get
                Return _Color
            End Get
            Set(ByVal Value As Color)
                _Color = Value
            End Set
        End Property

        Public Property FontName() As String
            Get
                Return _FontName
            End Get
            Set(ByVal Value As String)
                _FontName = Value
            End Set
        End Property

        Public Property Size() As Byte
            Get
                Return _Size
            End Get
            Set(ByVal Value As Byte)
                _Size = Value
            End Set
        End Property

        Public Property Text() As String
            Get
                Return _Text
            End Get
            Set(ByVal Value As String)
                _Text = Value
            End Set
        End Property

        Public Property Align() As Alignment
            Get
                Return _Align
            End Get
            Set(ByVal value As Alignment)
                _Align = value
            End Set
        End Property

        'Questa proprietà è speciale.
        'Permette di ottenere in un solo colpo tutte le
        'caratteristiche di formattazione del chunk
        'restituendo una classe font completa
        Public ReadOnly Property Font() As Font
            Get
                Dim Style As FontStyle

                'Costruiamo lo stile del font a poco a poco,
                'poiché questo è un enumeratore su bit
                If Me.IsBold Then
                    Style = Style Or FontStyle.Bold
                End If
                If Me.IsItalic Then
                    Style = Style Or FontStyle.Italic
                End If
                If Me.IsUnderlined Then
                    Style = Style Or FontStyle.Underline
                End If

                Return New Font(Me.FontName, Me.Size, Style)
            End Get
        End Property
    End Class

    'Questa classe ha il compito di scrivere su un file
    'il testo formattato secondo le specifiche TLT
    Public Class Writer
        'Questa collezione conterrà una lista di
        'tutti i piccoli pezzettini di testo che si devono
        'scrivere
        Private _Chunks As New List(Of TextChunk)

        Public ReadOnly Property Chunks() As List(Of TextChunk)
            Get
                Return _Chunks
            End Get
        End Property

        'Questa funzione serve a comprimere il testo
        Private Function Compress(ByVal Str As String) As Byte()
            'Usiamo dei MemoryStream per due motivi:
            '- Il testo proviene dall'applicazione, non da un file, ed è
            '  sottoforma di stringa.
            '- Non possiamo non usare uno stream, perchè la classe
            '  di compressione lo richiede espressamente
            'Lo stream che legge i dati dalla stringa
            Dim Input As MemoryStream
            'Lo stream di scrittura associato al file compresso
            Dim Output As MemoryStream
            'Lo stream compresso che scrive i dati codificati per mezzo
            'dell'output stream
            Dim Zipped As DeflateStream
            'Risultato della compressione
            Dim Result(), Buffer() As Byte

            'Inizializza lo stream di input
            Input = New MemoryStream(UTF8.GetBytes(Str))
            'Inizializza lo stream di output
            Output = New MemoryStream()
            'Inizializza lo zipper
            Zipped = New DeflateStream(Output, CompressionMode.Compress)

            ReDim Buffer(Input.Length - 1)
            Input.Read(Buffer, 0, Input.Length)
            Zipped.Write(Buffer, 0, Buffer.Length)

            'Trasferisce  dati compressi sullo stream
            Zipped.Flush()
            ReDim Result(Output.Length - 1)
            Output.Seek(0, SeekOrigin.Begin)
            Output.Read(Result, 0, Output.Length)

            'Quindi chiude tutti gli stream
            Zipped.Close()
            Output.Close()
            Input.Close()

            Return Result
        End Function

        Public Sub Write(ByVal File As String)
            'Il writer principale
            Dim Writer As New BinaryWriter(New FileStream(File, FileMode.Create))

            'Scrive TLT
            Dim b() As Byte = UTF8.GetBytes("TLT")
            Writer.Write(UTF8.GetBytes("TLT"))

            'Scrive ogni chunk
            For Each C As TextChunk In Me.Chunks
                'Questo byte contiene tutte le informazione, come
                'descritto dalle specificazioni che ho inventato
                Dim Flags As Byte = 0

                'Aggiungere 128 significa impostare a 1 il primo bit
                'Infatti 128 in binario è 10000000
                If C.IsBold Then
                    Flags += 128
                End If
                If C.IsItalic Then
                    Flags += 64
                End If
                If C.IsUnderlined Then
                    Flags += 32
                End If

                'Se il colore non è quello predefinito,
                'imposta il bit su 1
                If C.Color <> Color.Black Then
                    Flags += 16
                End If

                'Lo stesso per la grandezza
                If C.Size <> 12 Then
                    Flags += 8
                End If

                'E per il font
                If C.FontName <> "Times New Roman" Then
                    Flags += 4
                End If

                'Poi controlla l'allineamento
                Select Case C.Align
                    Case TextChunk.Alignment.Left
                        Flags += 0 'Non sono matto, eh!
                    Case TextChunk.Alignment.Right
                        Flags += 1
                    Case TextChunk.Alignment.Center
                        Flags += 2
                    Case TextChunk.Alignment.Justify
                        Flags += 3
                End Select

                'Scrive i flags
                Writer.Write(CByte(Flags))

                'Ora, se il colore non è quello predefinito,
                'lo scrive
                If C.Color <> Color.Black Then
                    'In ordine, A, R, G, B
                    Writer.Write(C.Color.A)
                    Writer.Write(C.Color.R)
                    Writer.Write(C.Color.G)
                    Writer.Write(C.Color.B)
                End If

                'Poi scrive la grandezza
                If C.Size <> 12 Then
                    Writer.Write(C.Size)
                End If

                'E infine il nome del font
                If C.FontName <> "Times New Roman" Then
                    Writer.Write(UTF8.GetBytes(C.FontName))
                    Writer.Write(CByte(0)) 'Byte nullo
                End If

                'Poi la dimensione e il testo
                Dim Bytes() As Byte = UTF8.GetBytes(C.Text)
                Writer.Write(CInt(Bytes.Length))
                Writer.Write(Bytes)
            Next
            Writer.Close()
        End Sub
    End Class

    Public Class Reader
        Private _Chunks As New List(Of TextChunk)

        Public ReadOnly Property Chunks() As List(Of TextChunk)
            Get
                Return _Chunks
            End Get
        End Property

        Public Sub Read(ByVal File As String)
            'Lo stream di lettura
            Dim Reader As New BinaryReader(New FileStream(File, FileMode.Open))

            'Legge i primi 3 bytes
            Dim Buffer(2) As Byte
            Buffer = Reader.ReadBytes(3)

            'Se non sono "TLT", allora esce
            If UTF8.GetString(Buffer) <> "TLT" Then
                Reader.Close()
                Exit Sub
            End If

            Do
                'Legge il byte dei flags
                Dim Flags As Byte = Reader.ReadByte
                Dim C As New TextChunk

                'Estrapola i dati
                C.IsBold = ((Flags And 128) = 128)
                C.IsItalic = ((Flags And 64) = 64)
                C.IsUnderlined = ((Flags And 32) = 32)

                If (Flags And 16) = 16 Then
                    'In ordine, A, R, G, B
                    'Dopo tutto, essendo 3 bytes, li si
                    'può trattare come un Int32
                    Dim Argb As Int32
                    Argb = Reader.ReadInt32
                    C.Color = Color.FromArgb(Argb)
                Else
                    C.Color = Color.Black
                End If

                'Poi scrive la grandezza
                If (Flags And 8) = 8 Then
                    C.Size = Reader.ReadByte
                Else
                    C.Size = 12
                End If

                'E infine il nome del font
                If (Flags And 4) = 4 Then
                    Dim Temp As New List(Of Byte)
                    Dim B As Byte = Reader.ReadByte
                    'Legge i bytes fino ad incontrare il
                    'byte nullo di fine stringa
                    Do While B <> 0
                        Temp.Add(B)
                        B = Reader.ReadByte
                    Loop
                    C.FontName = UTF8.GetString(Temp.ToArray)
                End If

                If (Flags And 2) = 2 Then
                    If (Flags And 1) = 1 Then
                        '11 - giustificato
                        C.Align = TextChunk.Alignment.Justify
                    Else
                        '10 - centrato
                        C.Align = TextChunk.Alignment.Center
                    End If
                Else
                    If (Flags And 1) = 1 Then
                        '01 - destra
                        C.Align = TextChunk.Alignment.Right
                    Else
                        '00 - sinistra
                        C.Align = TextChunk.Alignment.Left
                    End If
                End If

                'Poi la dimensione e il testo
                Dim Size As Int32
                Size = Reader.ReadInt32
                Buffer = Reader.ReadBytes(Size)
                C.Text = UTF8.GetString(Buffer)
                Me.Chunks.Add(C)
            Loop While Reader.BaseStream.Position < Reader.BaseStream.Length

            Reader.Close()
        End Sub
    End Class
End Namespace