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 A, R, G, B As Byte
A = Reader.ReadByte
R = Reader.ReadByte
G = Reader.ReadByte
B = Reader.ReadByte
C.Color = Color.FromArgb(A, R, G, B)
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
