Public Class Form1
Dim Formdentro As New Form
Dim TextInput As New TextBox
Dim Inserisci As New Button
Dim Annulla As New Button
Dim Scelta(1) As RadioButton
Dim Correggi As Boolean = False
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
' *************************************************************************************
' * *
' * Colorazione parti di testo in RichTextBox in campi definiti *
' * *
' * Il carattere "<" attiva l'inserimento *
' * dopo l'inserimento si crea un campo delimitato <NOME> oppure <COGNOME| *
' * *
' * la routine ColoraRTB() colora i campi con i colori scelti *
' * *
' * il doppio click in un campo attiva la routine di correzione *
' * *
' * se nel campo ci sono spazi il doppio click deve essere fatto sulla prima parola *
' * il campo non deve iniziare con uno spazio *
' * *
' * il form deve contenere una RichTextBox1 *
' * *
' *************************************************************************************
' preparazione form di input
Formdentro.Text = "Inserisci"
Formdentro.Size = New Size(200, 180)
Formdentro.ControlBox = False
Formdentro.Location = New Point(20000, 15000)
' preparazione text su form di input
TextInput.Location = New Point(10, 10)
TextInput.Size = New Point(150, 20)
TextInput.CharacterCasing = CharacterCasing.Upper
Formdentro.Controls.Add(TextInput)
' preparazione button su form di input
Inserisci.Text = "Inserisci"
Inserisci.Location = New Point(100, 80)
Inserisci.TabIndex = 3
Formdentro.Controls.Add(Inserisci)
AddHandler Inserisci.Click, AddressOf Inserisci_OnClick ' permette di avere l'evento click
' preparazione button su form di input
Annulla.Text = "Annulla"
Annulla.Location = New Point(100, 110)
Annulla.TabIndex = 4
Formdentro.Controls.Add(Annulla)
AddHandler Annulla.Click, AddressOf Annulla_OnClick ' permette di annullare
' preparazione radiobutton su form di input
For i = 0 To 1
Scelta(i) = New RadioButton
Scelta(i).Location = New Point(10, 24 * i + 40)
Formdentro.Controls.Add(Scelta(i))
Next
Scelta(0).Checked = True
Scelta(0).Text = "Nome "
Scelta(0).TabIndex = 1
Scelta(1).Text = "Cognome "
Scelta(1).TabIndex = 2
End Sub
Private Sub RichTextBox1_KeyDown(sender As Object, e As KeyEventArgs) Handles RichTextBox1.KeyDown
' il tasto "<" attiva l'inserimento
If e.KeyCode = Keys.Oem102 And e.Shift = False Then
Formdentro.Show() : Correggi = False
End If
' il tasto Alt forza la colorazione dei campi
If e.Alt Then ColoraRTB() : RichTextBox1.Select(TextInput.TextLength, 0)
End Sub
Private Sub Inserisci_OnClick(sender As Object, e As EventArgs)
Dim NuovoCampo As String = Trim(TextInput.Text)
Dim FineSel As Integer = RichTextBox1.SelectionStart + NuovoCampo.Length
If Correggi Then ' corregge il campo nella RichTextBox
If Scelta(0).Checked Then
RichTextBox1.SelectedText = NuovoCampo
RichTextBox1.Select(FineSel, 1)
RichTextBox1.SelectedText = ">"
Else
RichTextBox1.SelectedText = NuovoCampo
RichTextBox1.Select(FineSel, 1)
RichTextBox1.SelectedText = "|"
End If
Inserisci.Text = "Inserisci"
Else ' inserisce un nuovo campo nella RichTextBox
If Scelta(0).Checked Then
RichTextBox1.Text = RichTextBox1.Text.Insert(RichTextBox1.SelectionStart, NuovoCampo & "> ")
Else
RichTextBox1.Text = RichTextBox1.Text.Insert(RichTextBox1.SelectionStart, NuovoCampo & "| ")
End If
End If
ColoraRTB()
RichTextBox1.Select(FineSel + 2, 0)
TextInput.Text = ""
TextInput.Focus()
Formdentro.Hide()
' aggiungere routine per eventuale inserimento testo in database
End Sub
Private Sub RichTextBox1_DoubleClick(sender As Object, e As EventArgs) Handles RichTextBox1.DoubleClick
Dim InizioSel As Integer = RichTextBox1.SelectionStart - 1
If InizioSel < 0 Then Exit Sub
If RichTextBox1.Text.Substring(InizioSel, 1) = "<" Then
' trovo la fine del campo
Dim FineSelNome = RichTextBox1.Text.IndexOf(">", InizioSel)
Dim FineSelCognome = RichTextBox1.Text.IndexOf("|", InizioSel)
Dim FineSel As Integer = 0
If FineSelCognome < FineSelNome Then
FineSel = FineSelCognome
Scelta(1).Checked = True
Else
Scelta(0).Checked = True
FineSel = FineSelNome
End If
' se uno dei caratteri ">" "|" non è stato trovato
If FineSelNome = -1 Then
FineSel = FineSelCognome
Scelta(1).Checked = True
ElseIf FineSelCognome = -1 Then
Scelta(0).Checked = True
FineSel = FineSelNome
End If
RichTextBox1.Select(InizioSel + 1, FineSel - InizioSel - 1)
TextInput.Text = RichTextBox1.SelectedText
TextInput.Select(TextInput.TextLength, 0)
Inserisci.Text = "Correggi"
Correggi = True
Formdentro.Show()
End If
End Sub
Private Sub Annulla_OnClick(sender As Object, e As EventArgs)
Formdentro.Hide()
Inserisci.Text = "Inserisci"
TextInput.Text = ""
RichTextBox1.Select(RichTextBox1.TextLength, 0)
End Sub
Private Sub ColoraRTB()
Dim PosSegnaposti As New List(Of Tuple(Of Integer, Color))
Dim Colore As Color
Dim pos1 As Integer
Dim pos As Integer
Dim simb() As Char = {"<"c, ">"c, "|"c}
' ricerca di tutti i segnaposto e memorizzazione delle posizioni
Do
pos = RichTextBox1.Find(simb, pos1)
If pos > -1 Then
pos1 = pos + 1
' associazione segnaposto, colore
If RichTextBox1.Text.Substring(pos, 1) = "<" Then Colore = Color.Black
If RichTextBox1.Text.Substring(pos, 1) = ">" Then Colore = Color.Turquoise
If RichTextBox1.Text.Substring(pos, 1) = "|" Then Colore = Color.OrangeRed
PosSegnaposti.Add(tuple.Create(pos, Colore))
End If
Loop Until pos = -1
' segnaposto insufficienti o dispari
If PosSegnaposti.Count < 2 Or PosSegnaposti.Count Mod 2 <> 0 Then Exit Sub
' ordinamento crescente delle posizioni trovate
PosSegnaposti = PosSegnaposti.OrderBy(Function(i) i.Item1).ToList
' colorazione tra due segnaposto <MARCO ANTONIO> oppure <DE LUCA|
For i = 0 To PosSegnaposti.Count - 1 Step 2
RichTextBox1.Select(PosSegnaposti(i).Item1 + 1, PosSegnaposti(i + 1).Item1 - 1)
RichTextBox1.SelectionColor = PosSegnaposti(i + 1).Item2
RichTextBox1.Select(PosSegnaposti(i + 1).Item1, RichTextBox1.TextLength)
RichTextBox1.SelectionColor = Color.Black
Next
End Sub
End Class
