Public Class Form1
Private Function GetTextFont() As Font
Dim Result As Font = rtbText.SelectionFont
If Result Is Nothing Then
Dim Style As FontStyle = 0
If strBold.Checked Then
Style = Style Or FontStyle.Bold
End If
If strItalic.Checked Then
Style = Style Or FontStyle.Italic
End If
If strUnderlined.Checked Then
Style = Style Or FontStyle.Underline
End If
Result = New Font(cmbFonts.SelectedItem.ToString, CInt(cmbSize.SelectedItem), Style, GraphicsUnit.Point)
'IIf(strBold.Checked, FontStyle.Bold, 0) Or _
'IIf(strItalic.Checked, FontStyle.Italic, 0) Or _
'IIf(strUnderlined.Checked, FontStyle.Underline, 0), GraphicsUnit.Point)
End If
Return Result
End Function
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
For Each Font As FontFamily In (New Drawing.Text.InstalledFontCollection().Families())
cmbFonts.Items.Add(Font.Name)
Next
cmbFonts.SelectedItem = "Times New Roman"
For I As Int16 = 7 To 72
cmbSize.Items.Add(I)
Next
cmbSize.SelectedIndex = 5
Me.WindowState = FormWindowState.Maximized
End Sub
Private Sub cmbFonts_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmbFonts.SelectedIndexChanged
Dim Actual As Font = GetTextFont()
rtbText.SelectionFont = New Font(CStr(cmbFonts.SelectedItem), Actual.Size, Actual.Style, GraphicsUnit.Point)
End Sub
Private Sub cmbSize_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmbSize.SelectedIndexChanged
Dim Actual As Font = GetTextFont()
rtbText.SelectionFont = New Font(Actual.Name, CInt(cmbSize.SelectedItem), Actual.Style)
End Sub
Private Sub strBold_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strBold.CheckedChanged
Dim Actual As Font = GetTextFont()
Dim l As Int32 = rtbText.SelectionLength
If strBold.Checked Then
If (Not Actual.Bold) Then rtbText.SelectionFont = New Font(Actual, Actual.Style + FontStyle.Bold)
Else
If (Actual.Bold) Then rtbText.SelectionFont = New Font(Actual, Actual.Style - FontStyle.Bold)
End If
End Sub
Private Sub strItalic_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strItalic.CheckedChanged
Dim Actual As Font = GetTextFont()
If strItalic.Checked Then
If (Not Actual.Italic) Then rtbText.SelectionFont = New Font(Actual, Actual.Style + FontStyle.Italic)
Else
If (Actual.Italic) Then rtbText.SelectionFont = New Font(Actual, Actual.Style - FontStyle.Italic)
End If
End Sub
Private Sub strUnderlined_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strUnderlined.CheckedChanged
Dim Actual As Font = GetTextFont()
If strUnderlined.Checked Then
If (Not Actual.Underline) Then rtbText.SelectionFont = New Font(Actual, Actual.Style + FontStyle.Underline)
Else
If (Actual.Underline) Then rtbText.SelectionFont = New Font(Actual, Actual.Style - FontStyle.Underline)
End If
End Sub
Private Sub rtbText_SelectionChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rtbText.SelectionChanged
Dim Actual As Font = rtbText.SelectionFont
If Actual IsNot Nothing Then
cmbFonts.SelectedItem = Actual.FontFamily.Name
cmbSize.SelectedItem = CInt(Actual.Size)
strBold.Checked = Actual.Bold
strItalic.Checked = Actual.Italic
strUnderlined.Checked = Actual.Underline
strColor.BackColor = rtbText.SelectionColor
End If
End Sub
Private Sub strColor_BackColorChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strColor.BackColorChanged
rtbText.SelectionColor = strColor.BackColor
End Sub
Private Sub strSave_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strSave.Click
Dim Save As New SaveFileDialog
Save.Filter = "Totem's Lair Format|*.tlt"
If Save.ShowDialog = Windows.Forms.DialogResult.OK Then
Dim W As New TLTFormat.Writer
rtbText.SelectionStart = 0
Dim F As Font = rtbText.SelectionFont
Dim C As Color = rtbText.SelectionColor
Dim Temp As New System.Text.StringBuilder
Dim Chunk As New TLTFormat.TextChunk
For I As Int32 = 0 To rtbText.TextLength - 1
rtbText.SelectionStart = I
If Not rtbText.SelectionFont.Equals(F) Or rtbText.SelectionColor <> C Then
Chunk = New TLTFormat.TextChunk
With Chunk
.Color = C
.FontName = F.Name
.IsBold = F.Bold
.IsItalic = F.Italic
.IsUnderlined = F.Underline
.Size = F.Size
.Text = Temp.ToString
W.Chunks.Add(Chunk)
End With
Temp.Remove(0, Temp.Length)
Temp.Append(rtbText.Text(I))
F = rtbText.SelectionFont
C = rtbText.SelectionColor
Else
Temp.Append(rtbText.Text(I))
End If
Next
Chunk = New TLTFormat.TextChunk
With Chunk
.Color = C
.FontName = F.Name
.IsBold = F.Bold
.IsItalic = F.Italic
.IsUnderlined = F.Underline
.Size = F.Size
.Text = Temp.ToString
W.Chunks.Add(Chunk)
End With
W.Write(Save.FileName)
End If
End Sub
Private Sub strOpen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strOpen.Click
Dim Open As New OpenFileDialog
Open.Filter = "Totem's Lair Format|*.tlt"
If Open.ShowDialog = Windows.Forms.DialogResult.OK Then
Dim R As New TLTFormat.Reader
R.Read(Open.FileName)
rtbText.Text = ""
For Each C As TLTFormat.TextChunk In R.Chunks
rtbText.AppendText(C.Text)
rtbText.Select(rtbText.TextLength - C.Text.Length, C.Text.Length)
rtbText.SelectionFont = C.Font
rtbText.SelectionColor = C.Color
rtbText.DeselectAll()
Next
End If
End Sub
Private Sub strColor_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strColor.Click
Dim C As New ColorDialog
If C.ShowDialog = Windows.Forms.DialogResult.OK Then
rtbText.SelectionColor = C.Color
End If
End Sub
End Class
