Imports System.Text.RegularExpressions
Public Class Form1
Private Tags As New List(Of String)
Private Attributes
As New Dictionary(Of
String, List
(Of
String))
Private TextModified As Boolean = False
'Ultimo path di salvataggio del file
Private LastSavingPath As String
'Parola da cercare per la funzione Trova
Private WordToSeek As String
'Ultimo indice verificato per tale parola
Private LastValidIndex As Int32
Private Sub AddItemsToList(ByVal List As List(Of String), ByVal StartString As String)
lstSuggest.Items.Clear()
For Each ATag As String In List
If ATag.ToLower.StartsWith(StartString.ToLower) Then
lstSuggest.Items.Add(ATag)
End If
Next
lstSuggest.Tag = StartString
End Sub
Private Sub ShowListAtCursor()
Dim P As Point = rtbCode.GetPositionFromCharIndex(rtbCode.SelectionStart)
lstSuggest.Location = New Point(P.X + 8, P.Y + 48)
lstSuggest.Visible = True
End Sub
Private Sub AppendTextAtCursor(ByVal Str As String)
Dim Sel As Int32 = rtbCode.SelectionStart
rtbCode.Text = rtbCode.Text.Insert(rtbCode.SelectionStart, Str)
rtbCode.SelectionStart = Sel + Str.Length
lstSuggest.Tag = Str
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
My.Application.SaveMySettingsOnExit = True
AddHandler My.Application.UnhandledException, AddressOf ExceptionHandler
If Not IO.
File.
Exists(Application.
StartupPath & "\Tags.dat") Then MessageBox.Show("Il file contente i dati sui tag html non è presente nella directory del programma. Contattare lo sviluppatore per ottenerne uno nuovo!", Me.Text)
Else
Dim Reader As New IO.StreamReader(Application.StartupPath & "\Tags.dat")
Dim Line, Data() As String
While Not Reader.EndOfStream
Line = Reader.ReadLine
If String.IsNullOrEmpty(Line) Then
Continue While
End If
Data = Line.Split("|")
Tags.Add(Data(0))
If Data.Length > 1 Then
Dim Temp As New List(Of String)
For I As Int16 = 1 To Data.Length - 1
Temp.Add(Data(I))
Next
Attributes.Add(Data(0), Temp)
End If
End While
Reader.Close()
End If
End Sub
Private Sub rtbCode_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rtbCode.TextChanged
TextModified = True
If rtbCode.SelectionStart > 0 And My.Settings.ISEnabled Then
Dim Start As Int32 = rtbCode.SelectionStart
'Trova il < d'inizio.
Dim OpeningTag As Int32 = rtbCode.Text.LastIndexOf("<", Start - 1, Start)
'Se c'è, controlla che sia di questo tag
If OpeningTag = -1 Then
Exit Sub
End If
'Trova il primo > prima del cursore
Dim PrevEndingTag As Int32 = rtbCode.Text.LastIndexOf(">", Start - 1, Start)
'Se esiste, controlla che sia precedente al <
If (PrevEndingTag >= 0) AndAlso (PrevEndingTag > OpeningTag) Then
'Il < trovato in realtà era di un altro tag già chiuso
Exit Sub
End If
'Controlla se il tag è chiuso
Dim EndingTag As Int32 = rtbCode.Text.IndexOf(">", Start)
Dim SuccOpeningTag As Int32 = rtbCode.Text.IndexOf("<", Start)
Dim IsClosed As Boolean = (EndingTag >= 0) And (EndingTag < SuccOpeningTag)
'Localizza il tag
Dim Tag As String
If Not IsClosed Then
If SuccOpeningTag >= 0 Then
'Situazione:
'<a href="ciao" <div> ...
Tag = rtbCode.Text.Substring(OpeningTag, SuccOpeningTag - OpeningTag + 1)
Else
'Situazione:
'<a href="ciao" [Fine file]
Tag = rtbCode.Text.Substring(OpeningTag)
End If
Else
'Situazione
'<a href="ciao"> ...
Tag = rtbCode.Text.Substring(OpeningTag, EndingTag - OpeningTag + 1)
End If
lblStatus.Text = Tag
If Tag.Length < 2 Then
'E' presente solo <: mostra tutti i tag disponibili
Me.AddItemsToList(Tags, "")
Me.ShowListAtCursor()
Exit Sub
End If
'La porzione di stringa compresa tra l'inizio del tag e la posizione corrente
Dim Str As String = rtbCode.Text.Substring(OpeningTag, Start - OpeningTag)
If Not Str.Contains(" ") Then
'Se Str non contiene spazi, è una sola parola. Quindi del tipo:
'<abcdefgh oppure </abcdef
'e perciò è l'inizio di un tag. Ora suggerisce una lista di tutti i
'tag che iniziano in quel modo
'Si tratta di un tag di chiusura: cancella il </ iniziale
If Str.StartsWith("</") Then
Str = Str.Remove(0, 2)
Else
'Cancella il < iniziale
Str = Str.Remove(0, 1)
End If
'Str è il nome parziale del tag
Me.AddItemsToList(Tags, Str)
If lstSuggest.Items.Count > 0 Then
Me.ShowListAtCursor()
End If
Else
'Riduce il controllo al solo tag in modo che sia più facile
'da analizzare
Dim TagCursor As Int32 = Start - OpeningTag - 1
Dim QuoteOpened As Boolean = False
For I As Int32 = 0 To Tag.Length - 1
If Tag(I) = Chr(34) Then
QuoteOpened = Not QuoteOpened
Tag = Tag.Insert(I, "|")
Tag = Tag.Remove(I + 1, 1)
End If
If QuoteOpened Then
Tag = Tag.Insert(I, "|")
Tag = Tag.Remove(I + 1, 1)
End If
Next
'Quindi, se all'indice corrente c'è un pipe, significa che il cursore
'è dentro una stringa
If Tag(TagCursor) = "|" Then
'Nasconde la lista
lstSuggest.Visible = False
Else
'Ottiene la parola che si sta scrivendo
Dim PrevSpace As Int32 = Tag.LastIndexOf(" ", TagCursor, TagCursor + 1)
Dim TagName, PartialAttrName As String
'Trova il nome del tag, togliendo il < iniziale e lo spazio finale
TagName = Tag.Substring(0, Tag.IndexOf(" ")).Remove(0, 1)
PartialAttrName = Tag.Substring(PrevSpace + 1, TagCursor - PrevSpace)
'Ottiene solo gli attributi che iniziano con la stringa data
If Tags.Contains(TagName) AndAlso Attributes.ContainsKey(TagName) Then
Me.AddItemsToList(Attributes(TagName), PartialAttrName)
Me.ShowListAtCursor()
Else
lstSuggest.Visible = False
End If
End If
End If
End If
End Sub
Private Sub rtbCode_KeyPress(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles rtbCode.KeyPress
If (e.KeyChar = ">" Or e.KeyChar = vbCr) And My.Settings.ISEnabled Then
lstSuggest.Visible = False
If e.KeyChar = ">" Then
Dim OpeningTag As Int32 = rtbCode.Text.LastIndexOf("<", rtbCode.SelectionStart, rtbCode.SelectionStart + 1)
Try
Dim Str As String = rtbCode.Text.Substring(OpeningTag, rtbCode.SelectionStart - OpeningTag)
Dim TagName As String
If Not Str.Contains(" ") Then
TagName = rtbCode.Text.Substring(OpeningTag + 1, rtbCode.SelectionStart - OpeningTag - 1)
Else
TagName = rtbCode.Text.Substring(OpeningTag + 1, rtbCode.Text.IndexOf(" ", OpeningTag) - OpeningTag - 1)
End If
Me.AppendTextAtCursor("></" & TagName & ">")
e.Handled = True
Catch Ex As Exception
End Try
End If
End If
End Sub
Private Sub lstSuggest_DoubleClick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lstSuggest.DoubleClick
'Aggiunge la parte di parola mancante
If lstSuggest.SelectedIndex >= 0 Then
Try
Dim Str As String = CStr(lstSuggest.SelectedItem).Remove(0, lstSuggest.Tag.ToString.Length)
Me.AppendTextAtCursor(Str)
Catch Ex As Exception
End Try
End If
End Sub
Private Sub rtbCode_PreviewKeyDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PreviewKeyDownEventArgs) Handles rtbCode.PreviewKeyDown
If e.KeyCode = Keys.Space Then
If lstSuggest.Visible And lstSuggest.Items.Count > 0 Then
Dim Str As String = CStr(lstSuggest.Items(0)).Remove(0, lstSuggest.Tag.ToString.Length)
Me.AppendTextAtCursor(Str)
End If
ElseIf e.KeyCode = Keys.Down Then
If lstSuggest.Visible Then
lstSuggest.SelectedIndex = 0
lstSuggest.Focus()
End If
End If
End Sub
Private Sub strOpen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strOpen.Click
If TextModified Then
If MessageBox.Show("Salvare le modifiche apportate al codice prima di aprirne un altro?", Me.Text, MessageBoxButtons.YesNo, MessageBoxIcon.Question) = Windows.Forms.DialogResult.Yes Then
strSave_Click(Me, EventArgs.Empty)
TextModified = False
End If
End If
Dim Open As New OpenFileDialog
Open.Filter = "Pagine web|*.htm;*.html;*.php"
If Open.ShowDialog = Windows.Forms.DialogResult.OK Then
rtbCode.
Text = IO.
File.
ReadAllText(Open.
FileName) End If
End Sub
Private Sub strSave_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strSave.Click
If String.IsNullOrEmpty(LastSavingPath) Then
Dim Save As New SaveFileDialog
Save.Filter = "Pagine web|*.htm;*.html|Pagina PHP|*.php"
If Save.ShowDialog = Windows.Forms.DialogResult.OK Then
IO.
File.
WriteAllText(Save.
FileName, rtbCode.
Text) LastSavingPath = Save.FileName
lblStatus.Text = "File salvato con successo"
TextModified = False
End If
Else
IO.
File.
WriteAllText(LastSavingPath, rtbCode.
Text) lblStatus.Text = "File salvato con successo"
TextModified = False
End If
End Sub
Private Sub strSaveAs_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strSaveAs.Click
'Annulla la stringa, e richiama l'altra funzione, risparmiando spazio
LastSavingPath = Nothing
strSave_Click(Me, EventArgs.Empty)
End Sub
Private Sub strExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strExit.Click
If TextModified Then
If MessageBox.Show("Salvare le modifiche apportate al sorgente prima di uscire?", Me.Text, MessageBoxButtons.YesNo, MessageBoxIcon.Question) = Windows.Forms.DialogResult.Yes Then
strSave_Click(Me, EventArgs.Empty)
End If
End If
Me.Close()
End Sub
Private Sub strFind_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strFind.Click
Dim Word As String = InputBox("Immettere la stringa da cercare:", Me.Text)
If String.IsNullOrEmpty(Word) Then
Exit Sub
End If
If Word.Length < 2 Then
MessageBox.Show("Inserire una stringa di almeno due caratteri!", Me.Text, MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Exit Sub
End If
Dim Index As Int32
Index = rtbCode.Find(Word)
If Index > -1 Then
WordToSeek = Word
LastValidIndex = Index
rtbCode.Select(Index, Word.Length)
rtbCode.ScrollToCaret()
lblStatus.Text = "Trovata istanza di """ & Word & """ alla posizione " & Index
End If
End Sub
Private Sub strFindNext_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strFindNext.Click
If Not String.IsNullOrEmpty(WordToSeek) Then
Dim Index As Int32
If LastValidIndex < rtbCode.TextLength - 1 Then
Index = rtbCode.Find(WordToSeek, LastValidIndex + 1, RichTextBoxFinds.None)
If Index > -1 Then
LastValidIndex = Index
rtbCode.Select(Index, WordToSeek.Length)
rtbCode.ScrollToCaret()
lblStatus.Text = "Trovata istanza di """ & WordToSeek & """ alla posizione " & Index
Else
MessageBox.Show("Nessun'altra occorenza di """ & WordToSeek & """ è stata trovata!", Me.Text, MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
End If
Else
MessageBox.Show("Nessun'altra occorenza di """ & WordToSeek & """ è stata trovata!", Me.Text, MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
End If
End If
End Sub
Private Sub strReplace_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strReplace.Click
Dim Word As String = InputBox("Inserire la stringa da sotituire:", Me.Text)
Dim Replace As String = InputBox("Inserire la stringa sostituto:", Me.Text)
If (Not String.IsNullOrEmpty(Word)) And (Not String.IsNullOrEmpty(Replace)) Then
lblStatus.Text = "Attendere, sostituzione in corso..."
rtbCode.Enabled = False
Application.DoEvents()
rtbCode.Text = rtbCode.Text.Replace(Word, Replace)
Application.DoEvents()
rtbCode.Enabled = True
lblStatus.Text = "Sostituzione effettuata"
End If
End Sub
Private Sub strFont_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strFont.Click
Dim Font As New FontDialog
Font.AllowSimulations = True
If Font.ShowDialog = Windows.Forms.DialogResult.OK Then
rtbCode.Font = Font.Font
My.Settings.TextFont = Font.Font
End If
End Sub
Private Sub strEnabled_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strEnabled.Click
My.Settings.ISEnabled = strEnabled.Checked
If strEnabled.Checked Then
strEnabled.Text = "Attivato"
Else
strEnabled.Text = "Disattivato"
End If
End Sub
Private Sub strAbout_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strAbout.Click
My.Forms.The_Lair_AboutBox1.Show()
End Sub
Private Sub ExceptionHandler(ByVal sender As Object, ByVal e As Microsoft.VisualBasic.ApplicationServices.UnhandledExceptionEventArgs)
MessageBox.Show(String.Format( _
"Si è verificata un'eccezione del tipo {0}. Il testo di tale eccezione è di seguito riportato: {1}{1}{2}{1}{1}Contattare lo sviluppatore per maggiori dettagli.", _
e.Exception.GetType.FullName, vbCrLf, e.Exception.Message), Me.Text, MessageBoxButtons.OK, MessageBoxIcon.Error)
End Sub
End Class
