PROGRAMA PARA UTILIZAR EL TEXTBOX Y EL RICHTEXTBOX

Creamos una aplicación a partir de un formulario, que le llamamos Textbox_richtextbox

Introducimos seis botones distribuidos como en la imagen , introducimos dos labels con el texto TEXTBOX y RICHTEXTBOX para diferenciar el cuadro de texto superior del inferior.

Antes que nada tenemos que introducir dos componentes necesarios para nuestra aplicación: el “CommonDialog” y el “RichTextBox”, el primero se incorpora pulsando el botón derecho sobre la barra de herramientas-componentes y añadiendo el Microsoft Common Dialog Control, el segundo añadimos el Microsoft RichTextBox Control.

Introducimos un menú con la siguiente estructura con el editor de menús

Posteriormente introducimos el código de la aplicación

'la variable origen nos dará el lugar desde donde queremos copiar o cortar

'si es true será del textbox si es false del richtextbox

Dim origen As Boolean

'Botones del textbox

'Cambiamos el color de Fondo

Private Sub Command1_Click()

CommonDialog1.ShowColor

Text1.BackColor = CommonDialog1.Color

End Sub

'Cambiamos el color de fuente

Private Sub Command2_Click()

CommonDialog1.ShowColor

Text1.ForeColor = CommonDialog1.Color

End Sub

'Cambiamos el timpo de fuente ("Si estuviera instalada")

Private Sub Command3_Click()

CommonDialog1.ShowFont

Text1.Font = CommonDialog1.FontName

End Sub

'Botones del Richtextbox

'Cambiamos el color de Fondo

Private Sub Command4_Click()

CommonDialog1.ShowColor

RichTextBox1.BackColor = CommonDialog1.Color

End Sub

'Cambiamos el color de fuente

Private Sub Command5_Click()

CommonDialog1.ShowColor

RichTextBox1.SelColor = CommonDialog1.Color

End Sub

'Cambiamos el tipo de fuente si estuviera instalada

Private Sub Command6_Click()

CommonDialog1.ShowFont

RichTextBox1.Font = CommonDialog1.FontName

End Sub

'inicializamos la variable origen

Private Sub Form_Load()

origen = True

mnuPegar.Enabled = False

End Sub

'Elementos del menú

'cursiva del richtextbox

Private Sub mnu_cursiva_rtxt_Click()

RichTextBox1.SelItalic = Not RichTextBox1.SelItalic

mnu_cursiva_rtxt.Checked = RichTextBox1.SelItalic

End Sub

'cursiva del textbox

Private Sub mnu_cursiva_Txt_Click()

Text1.FontItalic = Not Text1.FontItalic

mnu_cursiva_Txt.Checked = Text1.FontItalic

End Sub

'negrita del richtextbox

Private Sub mnu_negrita_rtxt_Click()

RichTextBox1.SelBold = Not RichTextBox1.SelBold

mnu_negrita_rtxt.Checked = RichTextBox1.SelBold

End Sub

'negrita del textbox

Private Sub mnu_negrita_txt_Click()

Text1.FontBold = Not Text1.FontBold

mnu_negrita_txt.Checked = Text1.FontBold

End Sub

'subrayado del richtextbox

Private Sub mnu_subrayado_rtxt_Click()

RichTextBox1.SelUnderline = Not RichTextBox1.SelUnderline

mnu_subrayado_rtxt.Checked = RichTextBox1.SelUnderline

End Sub

'subrayado del textbox

Private Sub mnu_subrayado_txt_Click()

Text1.FontUnderline = Not Text1.FontUnderline

mnu_subrayado_txt.Checked = Text1.FontUnderline

End Sub

'copiamos según sea el origen

Private Sub mnucopiar_Click()

If origen Then

If Text1.SelLength > 0 Then

Clipboard.Clear

Clipboard.SetText Text1.SelText, vbCFText

mnuPegar.Enabled = True

End If

Else

On Error Resume Next

Clipboard.SetText (RichTextBox1.SelText)

mnuPegar.Enabled = True

End If

End Sub

'cortamos según sea el origen

Private Sub mnuCortar_Click()

If origen Then

If Text1.SelLength > 0 Then

Clipboard.Clear

Clipboard.SetText Text1.SelText, vbCFText

Text1.SelText = ""

mnuPegar.Enabled = True

End If

Else

On Error Resume Next

Clipboard.SetText (RichTextBox1.SelText)

RichTextBox1.SelText = ""

mnuPegar.Enabled = True

End If

End Sub

'pegamos

Private Sub mnuPegar_Click()

If origen Then

On Error Resume Next

Text1.SelText = Clipboard.GetText

Else

On Error Resume Next

RichTextBox1.SelRTF = Clipboard.GetText

End If

End Sub

'abrimos un fichero de richtextbox

Private Sub mnuRichTextBox_Abrir_Click()

CommonDialog1.ShowOpen

RichTextBox1.LoadFile (CommonDialog1.FileName)

End Sub

'guardamos el contenido del richtextbox

Private Sub mnuRichTextBox_Guardar_Click()

CommonDialog1.ShowSave

RichTextBox1.SaveFile (CommonDialog1.FileName)

End Sub

'abrimos un archivo en el cuadro de texto textbox

Private Sub mnuTextBox_Abrir_Click()

Dim c

c = ""

CommonDialog1.Filter = "Archivos de texto (*.*) | *.txt | o RTF (*.rtf) |*.rtf"

CommonDialog1.ShowOpen

If CommonDialog1.FileName <> "" Then

Open CommonDialog1.FileName For Input As #1

Do While Not EOF(1)

c = c + Input(1, #1)

Loop

Close #1

Text1.Text = Left(c, Len(c) - 2)

End If

CommonDialog1.FileName = ""

End Sub

'guardar el contenido del textbox

Private Sub mnuTextBox_Guardar_Click()

CommonDialog1.Filter = "Archivos de texto (*.*) | *.txt | o RTF (*.rtf) |*.rtf"

CommonDialog1.ShowSave

If CommonDialog1.FileName <> "" Then

Open CommonDialog1.FileName For Output As #2

Print #2, Text1.Text

Close #2

End If

End Sub

'cuando clickamos en el richtextbox actualizamos el menú

Private Sub RichTextBox1_Click()

origen = False

If (RichTextBox1.SelBold <> Null And RichTextBox1.SelItalic <> nul And RichTextBox1.SelUnderline <> Null) Then

mnu_negrita_txt.Checked = Text1.FontBold

mnu_cursiva_Txt.Checked = Text1.FontItalic

mnu_subrayado_txt.Checked = Text1.FontUnderline

mnu_negrita_rtxt.Checked = RichTextBox1.SelBold

mnu_cursiva_rtxt.Checked = RichTextBox1.SelItalic

mnu_subrayado_rtxt.Checked = RichTextBox1.SelUnderline

End If

End Sub

'cuando clickamos en el textbox actualizamos el menú

Private Sub Text1_Click()

origen = True

If (RichTextBox1.SelBold <> Null And RichTextBox1.SelItalic <> nul And RichTextBox1.SelUnderline <> Null) Then

mnu_negrita_txt.Checked = Text1.FontBold

mnu_cursiva_Txt.Checked = Text1.FontItalic

mnu_subrayado_txt.Checked = Text1.FontUnderline

mnu_negrita_rtxt.Checked = RichTextBox1.SelBold

mnu_cursiva_rtxt.Checked = RichTextBox1.SelItalic

mnu_subrayado_rtxt.Checked = RichTextBox1.SelUnderline

End If

End Sub