Dim DaCercare As String
Dim GiaCercato As Integer 'contiene la posizione del puntatore all'interno del file aperto, per continuare la ricerca
Dim Nomefile As String 'contiene il percorso completo del file in uso (usato per il salvataggio normale)
Dim UndoRedo As Boolean
Dim RTF As Boolean 'specifica se sto lavorando con un documento RFT o no
Dim Modified As Boolean 'se è true allora il file in uso è stato modificato dall'utente
Dim UndoReg() As String 'contiene l'intero testo prima e dopo ogni digitazione
Dim I As Integer
Dim K As Integer
'====================EVENTI FORM====================
Private Sub Form_Load()
Modified = False
'carico e nascondo la clipboard
Load frmClipboard
frmClipboard.Visible = False
'imposto i filtri per la cdl
cd1.Filter = "Files di testo (.txt)|*.txt|File Rich Text Format (.rtf)|*.rtf|Tutti i files |*.*|"
'avvio un nuovo file
Nuovo
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If Modified = True Then
If MsgBox("Continuando perderai il lavoro svolto. Vuoi Uscire?", vbYesNo, "Uscire?") = vbNo Then Cancel = True: Exit Sub
End If
End
End Sub
Private Sub Form_Resize()
'qui c'era un bug... :-D
'adesso ridimensiona la richtextbox al ridimensionamento del form
'correzione effettuata da LordTzeentch
frmMain.ScaleMode = 1 ' questo fa si ke il form abbia lo stesso metodo di scale dei controlli
On Error Resume Next
txtTesto.Left = 0
txtTesto.Height = (frmMain.Height - txtTesto.Top) - 760
txtTesto.Width = frmMain.Width - 100
End Sub
Private Sub mnuAbout_Click()
MsgBox "Notepad 1.0" & Chr(13) & "Creato per Pierotofy.it" & _
Chr(13) & "Da ..::[BeaR]::.." & Chr(13) & Chr(13) & "P.S." & Chr(13) & _
"Se c'è qualche bug non esitate a contattarmi ;-)"
End Sub
'====================TOOLBAR====================
Private Sub tool1_ButtonClick(ByVal Button As ComctlLib.Button)
Select Case Button.Key
Case "nuovo"
Nuovo
Case "apri"
Apri
Case "salva"
Salva False
Case "print"
Printer.Print txtTesto.Text
Printer.EndDoc
Case "cut"
Taglia
Case "copy"
Copia
Case "paste"
Incolla
Case "undo"
mnuUndo_click
Case "redo"
mnuRedo_click
Case "textColor"
textColor
RFT = True
End Select
End Sub
'$$$$$$$$$$$$$$$$$$$$ MENU $$$$$$$$$$$$$$$$$$$$
'********************FILE********************
Private Sub mnuEsci_Click()
Esci
End Sub
Private Sub mnuNew_Click()
Nuovo
End Sub
Private Sub mnuOpen_Click()
Apri
End Sub
Private Sub mnuSave_Click()
Salva False
End Sub
Private Sub mnuSaveAs_Click()
Salva True
End Sub
Private Sub mnuPrint_Click()
Printer.Print txtTesto.Text
Printer.EndDoc
End Sub
'********************MODIFICA********************
Private Sub mnuCopy_Click()
Copia
mnuClipboard.Enabled = True
End Sub
Private Sub mnuPaste_Click()
Incolla
End Sub
Private Sub mnuCut_Click()
Taglia
End Sub
Private Sub mnuUndo_click()
'abilito il pulsante redo
If I > 0 Then
UndoRedo = True
I = I - 1
mnuRedo.Enabled = True
tool1.Buttons(13).MixedState = False
txtTesto.Text = UndoReg(I) 'annulla la modifica fatta
Else
tool1.Buttons(12).MixedState = True
mnuUndo.Enabled = False
End If
End Sub
Private Sub mnuRedo_click()
If I < 50 Then
I = I + 1
UndoRedo = True
txtTesto.Text = UndoReg(I)
Else 'se non si possono + ripristinare modifiche, disabilito il pulsante redo
mnuRedo.Enabled = False
tool1.Buttons(13).MixedState = True
End If
End Sub
Private Sub mnuSelectAll_Click()
txtTesto.SelStart = 0
txtTesto.SelLength = Len(txtTesto)
End Sub
Private Sub mnuFind_Click()
Find False
End Sub
Private Sub mnuFindAgain_click()
Find True
End Sub
Private Sub mnuCanc_Click()
txtTesto.SelText = ""
End Sub
'********************VISUALIZZA********************
Private Sub mnuclipboard_click()
frmClipboard.Visible = True
End Sub
'********************HELP********************
'====================SUB====================
Private Sub Nuovo()
If Modified = True Then 'se il file è stato modificato chiede conferma prima di proseguire
If MsgBox("Attenzione! Nopn hai salvato." & Chr(13) & "Continuando perderai il lavoro svolto. Vuoi creare un Nuovo file?", vbYesNo, "Nuovo...") = vbNo Then Exit Sub
End If
txtTesto.Text = ""
Nomefile = ""
Modified = False
I = 0 'azzera il numero di modifiche annullabili
ReDim UndoReg(0 To 50) 'svuota la cache delle modifiche annullabili
'blocco i pulsanti undo e redo
tool1.Buttons(12).MixedState = True
tool1.Buttons(13).MixedState = True
mnuRedo.Enabled = False
mnuUndo.Enabled = False
End Sub
Private Sub Apri()
Dim Percorso As String
Dim Testo As String
If Modified = True Then 'se il file è stato modificato chiede conferma prima di proseguire
If MsgBox("Attenzione! Non hai salvato." & Chr(13) & "Continuando perderai il lavoro svolto. Vuoi aprire un Nuovo file?", vbYesNo, "Apri...") = vbNo Then Exit Sub
End If
cd1.DialogTitle = "Apri File..."
cd1.ShowOpen
Percorso = cd1.FileName
If Percorso = "" Then Exit Sub
txtTesto.Text = ""
txtTesto.FileName = Percorso
If Right(Percorso, 4) = ".rtf" Then
RFT = True
Else
RTF = False
End If
Nomefile = Percorso
Modified = False
End Sub
Private Sub Salva(ConNome As Boolean)
'salva il file
Dim Percorso As String
If ConNome = True Then
cd1.DialogTitle = "Salva File..."
'in un nuovo file
cd1.ShowSave
Percorso = cd1.FileName
If Percorso = "" Then Exit Sub
Else
'nello stesso
Percorso = Nomefile
'se è il primo file aperto...
If Percorso = "" Then
'richiama il salva con nome
Salva True
Exit Sub
End If
End If
Percorso = (Left(Percorso, Len(Percorso) - 4)) + (LCase(Right(Percorso, 4)))
If Right(Percorso, 4) = ".rtf" Then
txtTesto.SaveFile (Percorso)
Else
If RTF Then
If MsgBox("Salvando il file in formato testo si perderanno le modifiche della formattazione." & Chr(13) & "Salvare in formato RTF?", vbYesNo + vbCritical, "Attenzione!") = vbYes Then
Percorso = Left(Percorso, Len(Percorso - 3)) & ".rtf" 'modifico l'estensione
txtTesto.SaveFile (Percorso)
End If
Else
Open Percorso For Output As #1
Print #1, txtTesto.Text
Close #1
End If
End If
Nomefile = Percorso
Modified = False
End Sub
Private Sub Copia()
If txtTesto.SelText <> "" Then
frmClipboard.lstApp.AddItem txtTesto.SelText
End If
Clipboard.Clear
Clipboard.SetText txtTesto.SelText
End Sub
Private Sub Incolla()
Modified = True
txtTesto.SelText = Clipboard.GetText
End Sub
Private Sub Taglia()
Modified = True
Clipboard.Clear
Clipboard.SetText txtTesto.SelText
txtTesto.SelText = ""
End Sub
Private Sub textColor()
cd1.ShowColor
txtTesto.SelColor = cd1.Color
Modified = True
End Sub
Private Sub Esci()
If MsgBox("Vuoi uscire?", vbYesNo, "Uscita") = vbYes Then
End
Else
Exit Sub
End If
End Sub
Private Sub txtTesto_Change()
If UndoRedo = True Then UndoRedo = False: Exit Sub 'se l'evento è stato generato dalla sub undo, allora esco da qst sub
Modified = True
tool1.Buttons(12).MixedState = False 'abilita l'undo
mnuUndo.Enabled = True
If I < 50 Then
I = I + 1
UndoReg(I) = txtTesto.Text 'memorizza la modifica fatta
Else
Dim K As Integer
Dim Temp As String
For K = 1 To I - 1 'sposta indietro di 1 posizione tutti i record
UndoReg(K) = UndoReg(K + 1)
Next K
UndoReg(I) = txtTesto.Text 'memorizza la modifica fatta
End If
End Sub
Private Sub txtTesto_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then 'se è stato clikkato il destro
PopupMenu mnuEdit 'visualizza il menu modifica
End If
End Sub
