Todo Visual Basic Net por Elinv

Visual Basic 2008 Express - Complejo Elinv - Módulo para colorear sintáxis de código por Elinv.

2012-02-20T07:06:00.001-08:00

Elinv y visual basic net

visual basic for, for visual basic,visual basic 6,

visual basic 6.0,que es visual basic 6.0,visual basic 2008,

visual basic tutorial,visual basic express,microsoft visual basic,

visual basic studio 2008,visual basic 2005,visual basic,descargar

'Superpoderoso ayudante del programador por Elinv
'Complejo Elinv.
'-------------------------------------------
'El proyecto pueden bajarlo aqui
'-------------------------------------------
'http://todovisualbasicnetporelinv.blogspot.com/p/complejo-elinv.html
'Código fuente del módulo para colorear código
'en visual basic (es mejorable)
'-------------------------------------------
Module Module1
Public nuevoregistro As Boolean
Public texto_a_traducir As String
Public Function colorear(ByVal codigo As String) As String
On Error Resume Next
Dim a As String, b As Long, b1 As Long, b2 As Long, b3 As Long, texto As String, c As String
b = 0
texto = ""
Do
b = (b) + 1
b1 = b
a = codigo
If b1 > Len(a) Then
Exit Do
Else 'Busca el carácter
c = Left(a, b1)
c = Right(c, 1)
If Mid(a, b, 6) = "Object" Or Mid(a, b, 6) = "Resume" Or Mid(a, b, 6) = "Integer" OrMid(a, b, 6) = "Random" Or Mid(a, b, 6) = "Append" Or Mid(a, b, 6) = "Output" Or Mid(a, b, 6) = "Access"Or Mid(a, b, 6) = "ElseIf" Or Mid(a, b, 6) = "String" Or Mid(a, b, 6) = "Select" Or Mid(a, b, 6) ="Binary" Or Mid(a, b, 6) = "ElseIf" Or Mid(a, b, 6) = "Public" Or Mid(a, b, 6) = "public" Or Mid(a, b, 6) = "elseif" Or Mid(a, b, 6) = "binary" Or Mid(a, b, 6) = "select" Or Mid(a, b, 6) = "string" Or Mid(a, b, 6) = "elseif" Or Mid(a, b, 6) = "access" Or Mid(a, b, 6) = "output" Or Mid(a, b, 6) = "append" OrMid(a, b, 6) = "random" Or Mid(a, b, 6) = "integer" Or Mid(a, b, 6) = "resume" Or Mid(a, b, 6) ="object" Then
If Mid(a, b + 6, 1) = "." Or Mid(a, b + 6, 1) = "," Or Mid(a, b + 6, 1) = " " OrMid(a, b + 6, 2) = vbCrLf Or b + 5 = Len(a) Then
If Mid(a, b - 2, 2) = vbCrLf Or Mid(a, b - 1, 1) = " " Or Mid(a, b, 1) = Mid(a, 1, 1) Then
texto = texto & "" & Mid(a, b, 6) & ""
b = b + 5
c = ""
Else
texto = texto & Mid(a, b, 6)
b = b + 5
End If
Else
texto = texto & Mid(a, b, 6)
b = b + 5
End If
ElseIf Mid(a, b, 2) = "Me" Or Mid(a, b, 2) = "As" Or Mid(a, b, 2) = "If" Or Mid(a, b, 2) = "Or" Or Mid(a, b, 2) = "Do" Or Mid(a, b, 2) = "On" Or Mid(a, b, 2) = "if" Or Mid(a, b, 2) = "or" OrMid(a, b, 2) = "Do" Or Mid(a, b, 2) = "on" Or Mid(a, b, 2) = "as" Or Mid(a, b, 2) = "me" Then
If Mid(a, b + 2, 1) = "." Or Mid(a, b + 2, 1) = "," Or Mid(a, b + 2, 1) = " " OrMid(a, b + 2, 2) = vbCrLf Or b + 1 = Len(a) Then
If Mid(a, b - 2, 2) = vbCrLf Or Mid(a, b - 1, 1) = " " Or Mid(a, b, 1) = Mid(a, 1, 1) Then
texto = texto & "" & Mid(a, b, 2) & ""
b = b + 1
c = ""
Else
texto = texto & Mid(a, b, 2)
b = b + 1
End If
Else
texto = texto & Mid(a, b, 2)
b = b + 1
End If
ElseIf Mid(a, b, 4) = "Form" Or Mid(a, b, 4) = "Read" Or Mid(a, b, 4) = "True" Or Mid(a, b, 4) = "Long" Or Mid(a, b, 4) = "Case" Or Mid(a, b, 4) = "GoTo" Or Mid(a, b, 4) = "Open" Or Mid(a, b, 4) = "Else" Or Mid(a, b, 4) = "Loop" Or Mid(a, b, 4) = "Next" Or Mid(a, b, 4) = "Then" Or Mid(a, b, 4) ="Exit" Or Mid(a, b, 4) = "else" Or Mid(a, b, 4) = "loop" Or Mid(a, b, 4) = "next" Or Mid(a, b, 4) ="then" Or Mid(a, b, 4) = "exit" Or Mid(a, b, 4) = "open" Or Mid(a, b, 4) = "goto" Or Mid(a, b, 4) ="case" Or Mid(a, b, 4) = "long" Or Mid(a, b, 4) = "true" Or Mid(a, b, 4) = "read" Or Mid(a, b, 4) ="form" Then
If Mid(a, b + 4, 1) = "." Or Mid(a, b + 4, 1) = "," Or Mid(a, b + 4, 1) = " " OrMid(a, b + 4, 2) = vbCrLf Or b + 3 = Len(a) Then
If Mid(a, b - 2, 2) = vbCrLf Or Mid(a, b - 1, 1) = " " Or Mid(a, b, 1) = Mid(a, 1, 1) Then
texto = texto & "" & Mid(a, b, 4) & ""
b = b + 3
c = ""
Else
texto = texto & Mid(a, b, 3)
b = b + 2
End If
Else
texto = texto & Mid(a, b, 3)
b = b + 2
End If
ElseIf Mid(a, b, 3) = "And" Or Mid(a, b, 3) = "Not" Or Mid(a, b, 3) = "Put" Or Mid(a, b, 3) = "Get" Or Mid(a, b, 3) = "End" Or Mid(a, b, 3) = "Sub" Or Mid(a, b, 4) = "Dim" Or Mid(a, b, 3) ="For" Or Mid(a, b, 4) = "Asc" Or Mid(a, b, 3) = "Chr" Or Mid(a, b, 3) = "asc" Or Mid(a, b, 3) = "for" OrMid(a, b, 3) = "chr" Or Mid(a, b, 3) = "end" Or Mid(a, b, 3) = "dim" Or Mid(a, b, 3) = "sub" Or Mid(a, b, 3) = "get" Or Mid(a, b, 3) = "put" Or Mid(a, b, 3) = "not" Or Mid(a, b, 3) = "and" Then
If Mid(a, b + 3, 1) = "." Or Mid(a, b + 3, 1) = "," Or Mid(a, b + 3, 1) = " " OrMid(a, b + 3, 2) = vbCrLf Or b + 2 = Len(a) Then
If Mid(a, b - 2, 2) = vbCrLf Or Mid(a, b - 1, 1) = " " Or Mid(a, b, 1) = Mid(a, 1, 1) Then
texto = texto & "" & Mid(a, b, 3) & ""
b = b + 2
c = ""
Else
texto = texto & Mid(a, b, 3)
b = b + 2
End If
Else
texto = texto & Mid(a, b, 3)
b = b + 2
End If
ElseIf Mid(a, b, 8) = "Function" Or Mid(a, b, 8) = "function" Then
If Mid(a, b + 8, 1) = "." Or Mid(a, b + 8, 1) = "," Or Mid(a, b + 8, 1) = " " OrMid(a, b + 8, 2) = vbCrLf Or b + 7 = Len(a) Then
If Mid(a, b - 2, 2) = vbCrLf Or Mid(a, b - 1, 1) = " " Or Mid(a, b, 1) = Mid(a, 1, 1) Then
texto = texto & "" & Mid(a, b, 8) & ""
b = b + 7
c = ""
Else
texto = texto & Mid(a, b, 8)
b = b + 7
End If
Else
texto = texto & Mid(a, b, 8)
b = b + 7
End If
ElseIf Mid(a, b, 7) = "Private" Or Mid(a, b, 7) = "private" Then
If Mid(a, b + 7, 1) = "." Or Mid(a, b + 7, 1) = "," Or Mid(a, b + 7, 1) = " " OrMid(a, b + 7, 2) = vbCrLf Or b + 6 = Len(a) Then
If Mid(a, b - 2, 2) = vbCrLf Or Mid(a, b - 1, 1) = " " Or Mid(a, b, 1) = Mid(a, 1, 1) Then
texto = texto & "" & Mid(a, b, 7) & ""
b = b + 6
c = ""
Else
texto = texto & Mid(a, b, 7)
b = b + 6
End If
Else
texto = texto & Mid(a, b, 7)
b = b + 6
End If
ElseIf Mid(a, b, 5) = "Error" Or Mid(a, b, 5) = "Print" Or Mid(a, b, 5) = "While" OrMid(a, b, 5) = "Close" Or Mid(a, b, 5) = "Input" Or Mid(a, b, 5) = "Write" Or Mid(a, b, 5) = "False" OrMid(a, b, 5) = "false" Or Mid(a, b, 5) = "close" Or Mid(a, b, 5) = "write" Or Mid(a, b, 5) = "input" OrMid(a, b, 5) = "while" Or Mid(a, b, 5) = "print" Or Mid(a, b, 5) = "error" Then
If Mid(a, b + 5, 1) = "." Or Mid(a, b + 5, 1) = "," Or Mid(a, b + 5, 1) = " " OrMid(a, b + 6, 2) = vbCrLf Or b + 4 = Len(a) Then
If Mid(a, b - 2, 2) = vbCrLf Or Mid(a, b - 1, 1) = " " Or Mid(a, b, 1) = Mid(a, 1, 1) Then
texto = texto & "" & Mid(a, b, 5) & ""
b = b + 4
c = ""
Else
b = b + 4
c = ""
End If
Else
texto = texto & Mid(a, b, 5)
b = b + 4
End If
ElseIf c = Chr(34) Then
texto = texto & "" & Chr(34)
c = ""
Do While Not c = Chr(34)
b = (b) + 1
b1 = b
If b1 > Len(a) Then
Exit Do
Else 'Busca el carácter
c = Left(a, b1)
c = Right(c, 1)
texto = texto & c
End If
Loop
texto = texto & ""
ElseIf c = "'" Then
texto = texto & "'"
Do While Not Mid(a, b, 2) = vbCrLf
b = (b) + 1
b1 = b
If b1 > Len(a) Then
Exit Do
Else 'Busca el carácter
c = Left(a, b1)
c = Right(c, 1)
If Not Mid(a, b, 2) = vbCrLf Then texto = texto & c
End If
Loop
texto = texto & ""
Else
texto = texto & c
End If
End If
Loop
colorear = "<pre>" & texto & "</pre>"
End Function
End Module

Visual Basic 2008 Express - Complejo Elinv - Superpoderoso ayudante del programador (Formulario para ver los códigos a pantalla completa en webbrowser.) por Elinv.

2012-02-20T07:03:00.000-08:00

Elinv y visual basic net

visual basic for, for visual basic,visual basic 6,

visual basic 6.0,que es visual basic 6.0,visual basic 2008,

visual basic tutorial,visual basic express,microsoft visual basic,

visual basic studio 2008,visual basic 2005,visual basic,descargar

'Superpoderoso ayudante del programador por Elinv
'Complejo Elinv.
'-------------------------------------------
'El proyecto pueden bajarlo aqui
'-------------------------------------------
'http://todovisualbasicnetporelinv.blogspot.com/p/complejo-elinv.html
'Código fuente del formulario para ver los códigos
'a pantalla completa.
'-------------------------------------------
Imports System.Management
Imports System.Threading
Imports System.IO
Public Class Form4
Dim fondo As Color
Dim fondo_portapapeles As Color
Dim contenido_portapapeles As String
Dim path_actual As String
Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e AsSystem.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
On Error Resume Next
My.Settings.Top = Me.Top
My.Settings.Left = Me.Left
My.Settings.Ancho = Me.Width
My.Settings.Alto = Me.Height
My.Settings.Save()
'My.Settings.pathactual = path_actual
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'On Error Resume Next
WebBrowser2.ScriptErrorsSuppressed = True
WebBrowser2.Navigate("about:blank")
WebBrowser2.Document.ExecCommand("EditMode", True, System.DBNull.Value)
WebBrowser1.ScriptErrorsSuppressed = True
WebBrowser1.Navigate("about:blank")
WebBrowser1.Document.ExecCommand("EditMode", True, System.DBNull.Value)
Application.DoEvents()
System.Threading.Thread.Sleep(1000)
WebBrowser1.Document.Body.InnerHtml = Form1.DatosBindingSource.Current("codigo")
If My.Settings.OnTop = True Then
Me.SiempreEncimaToolStripMenuItem.PerformClick()
Else
Me.NormalToolStripMenuItem.PerformClick()
End If
If My.Settings.Portapapeles = True Then
PortapapelesToolStripMenuItem.Text = "Portapapeles desactivar"
fondo_portapapeles = PortapapelesToolStripMenuItem.BackColor
PortapapelesToolStripMenuItem.BackColor = Color.Yellow
Timer1.Enabled = True
End If
If My.Settings.Vista_Tipo = True Then
TextoToolStripMenuItem.Checked = True
HtmlToolStripMenuItem.Checked = False
Else
TextoToolStripMenuItem.Checked = False
HtmlToolStripMenuItem.Checked = True
End If
If My.Settings.Ancho <> 0 And My.Settings.Alto <> 0 Then
Me.Top = My.Settings.Top
Me.Left = My.Settings.Left
Me.Width = My.Settings.Ancho
Me.Height = My.Settings.Alto
End If
'Nos fijamos si existe el directorio sino lo creamos
If System.IO.Directory.Exists(Application.StartupPath & "\Temporales") = False Then
System.IO.Directory.CreateDirectory(Application.StartupPath & "\Temporales")
End If
'Configuramos el path actual, si esta vacío.
If My.Settings.alcargar = False Then
path_actual = Application.StartupPath & "\imagenes\temporal.html"
ElseIf My.Settings.alcargar = True Then
'Si todo va bien veremos el archivo ultimamente utilizado.
If My.Settings.pathactual = "" Then
path_actual = Application.StartupPath & "\imagenes\temporal.html"
Else
path_actual = My.Settings.pathactual
ultimo_utilizado()
End If
End If
'Actualizamos la información sobre si se trabaja con el mismo archivo o no
If My.Settings.alcargar = False Then
AlCargarSeguirConMismoArchivoToolStripMenuItem.Checked = False
Else
AlCargarSeguirConMismoArchivoToolStripMenuItem.Checked = True
End If
'capturar el número de serie del disco rígido
Dim oQuery As String = "SELECT DeviceID FROM Win32_LogicalDisk"
Dim oSearch As ManagementObjectSearcher = New ManagementObjectSearcher(oQuery)
Dim oDisks As ManagementObjectCollection = oSearch.Get
For Each m As ManagementObject In oDisks
Dim DeviceID As PropertyData = m.Properties("DeviceID")
'MsgBox(DeviceID.Value)
Next
Dim disk As ManagementObject = New ManagementObject("win32_logicaldisk.deviceid='C:'")
Try
disk.Get()
If Not disk("VolumeSerialNumber") Is Nothing Then
'MsgBox(disk("VolumeSerialNumber").ToString)
End If
Catch ex As System.Management.ManagementException
'MsgBox(ex.Message)
End Try
End Sub
Private Sub SiempreEncimaToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e AsSystem.EventArgs) Handles SiempreEncimaToolStripMenuItem.Click
On Error Resume Next
Me.TopMost = True
fondo = SiempreEncimaToolStripMenuItem.BackColor
NormalToolStripMenuItem.BackColor = fondo
SiempreEncimaToolStripMenuItem.BackColor = Color.Yellow
My.Settings.OnTop = True
End Sub
Private Sub NormalToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e AsSystem.EventArgs) Handles NormalToolStripMenuItem.Click
On Error Resume Next
Me.TopMost = False
SiempreEncimaToolStripMenuItem.BackColor = fondo
fondo = NormalToolStripMenuItem.BackColor
NormalToolStripMenuItem.BackColor = Color.Yellow
My.Settings.OnTop = False
End Sub
Private Sub PortapapelesToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e AsSystem.EventArgs) Handles PortapapelesToolStripMenuItem.Click
On Error Resume Next
If PortapapelesToolStripMenuItem.Text = "Portapapeles activar" Then
PortapapelesToolStripMenuItem.Text = "Portapapeles desactivar"
fondo_portapapeles = PortapapelesToolStripMenuItem.BackColor
PortapapelesToolStripMenuItem.BackColor = Color.Yellow
Timer1.Enabled = True
My.Settings.Portapapeles = True
Else
PortapapelesToolStripMenuItem.Text = "Portapapeles activar"
PortapapelesToolStripMenuItem.BackColor = fondo_portapapeles
Timer1.Enabled = False
My.Settings.Portapapeles = False
End If
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
On Error Resume Next
If Clipboard.ContainsText = True Then
If contenido_portapapeles <> Clipboard.GetText.ToString Then
contenido_portapapeles = Clipboard.GetText.ToString
If My.Settings.Vista_Tipo = False Then
WebBrowser1.Document.ExecCommand("Paste", True, System.DBNull.Value)
WebBrowser1.Document.Body.InnerHtml = WebBrowser1.Document.Body.InnerHtml & "<hr>"
Else
WebBrowser1.Document.Body.InnerHtml = WebBrowser1.Document.Body.InnerHtml & Clipboard.GetText.ToString & vbCrLf & "<hr>"
End If
End If
End If
End Sub
Private Sub HtmlToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles HtmlToolStripMenuItem.Click
On Error Resume Next
TextoToolStripMenuItem.Checked = False
HtmlToolStripMenuItem.Checked = True
My.Settings.Vista_Tipo = False
End Sub
Private Sub TextoToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextoToolStripMenuItem.Click
On Error Resume Next
TextoToolStripMenuItem.Checked = True
HtmlToolStripMenuItem.Checked = False
My.Settings.Vista_Tipo = True
End Sub
Private Sub GrabarToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e AsSystem.EventArgs) Handles GrabarToolStripMenuItem.Click
Dim oSW As New StreamWriter(path_actual)
Dim Linea As String = WebBrowser1.Document.Body.OuterHtml
oSW.WriteLine(Linea)
oSW.Flush()
oSW.Close()
Me.Text = path_actual & ", respaldo realizado exitosamente!!"
Thread.Sleep(2000)
Application.DoEvents()
Me.Text = "Portapapeles y anotador Elinv."
End Sub
Private Sub GrabarComoToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e AsSystem.EventArgs) Handles GrabarComoToolStripMenuItem.Click
Dim saveFileDialog1 As New SaveFileDialog()
saveFileDialog1.Filter = "htmt Archivos (*.htm)|*.htm|html Archivos (*.html)|*.html"
saveFileDialog1.FilterIndex = 2
saveFileDialog1.RestoreDirectory = True
If saveFileDialog1.ShowDialog() = DialogResult.OK Then
Dim oSW As New StreamWriter(saveFileDialog1.FileName)
Dim Linea As String = WebBrowser1.Document.Body.OuterHtml
oSW.WriteLine(Linea)
oSW.Flush()
oSW.Close()
path_actual = saveFileDialog1.FileName.ToString
My.Settings.pathactual = path_actual
End If
End Sub
Private Sub AlCargarSeguirConMismoArchivoToolStripMenuItem_Click(ByVal sender As System.Object,ByVal e As System.EventArgs) Handles AlCargarSeguirConMismoArchivoToolStripMenuItem.Click
On Error Resume Next
If AlCargarSeguirConMismoArchivoToolStripMenuItem.Checked = True Then
AlCargarSeguirConMismoArchivoToolStripMenuItem.Checked = False
My.Settings.alcargar = False
Else
AlCargarSeguirConMismoArchivoToolStripMenuItem.Checked = True
My.Settings.alcargar = True
End If
End Sub
Private Sub LeerToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles LeerToolStripMenuItem.Click
Dim openFileDialog1 As New OpenFileDialog()
openFileDialog1.Filter = "htmt Archivos (*.htm)|*.htm|html Archivos (*.html)|*.html"
openFileDialog1.FilterIndex = 2
openFileDialog1.RestoreDirectory = True
If openFileDialog1.ShowDialog() = DialogResult.OK Then
Dim SPath As String = openFileDialog1.FileName
Dim sContent As String = vbNullString
With My.Computer.FileSystem
' verifica si existe el path
If .FileExists(SPath) Then
' lee todo el contenido
sContent = .ReadAllText(SPath)
Else
MsgBox("ruta inválida", MsgBoxStyle.Critical, "error")
End If
End With
WebBrowser1.Document.Body.InnerHtml = sContent
path_actual = SPath
My.Settings.pathactual = path_actual
End If
End Sub
Private Sub ultimo_utilizado()
Dim sContent As String = vbNullString
With My.Computer.FileSystem
' verifica si existe el path
If .FileExists(path_actual) Then
' lee todo el contenido
sContent = .ReadAllText(path_actual)
Else
MsgBox("ruta inválida", MsgBoxStyle.Critical, "error")
End If
End With
WebBrowser1.Document.Body.InnerHtml = sContent
End Sub
Private Sub NuevoToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e AsSystem.EventArgs) Handles NuevoToolStripMenuItem1.Click
WebBrowser1.Document.Body.InnerHtml = ""
path_actual = Application.StartupPath & "\imagenes\temporal.html"
End Sub
Private Sub TraductorToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e AsSystem.EventArgs) Handles TraductorToolStripMenuItem.Click
On Error Resume Next
texto_a_traducir = Me.WebBrowser1.Document.Body.OuterHtml
Dim objFrm As New Form3
objFrm.Show()
End Sub
Private Sub TraducirTextoSeleccionadoToolStripMenuItem_Click(ByVal sender As System.Object, ByVal eAs System.EventArgs) Handles TraducirTextoSeleccionadoToolStripMenuItem.Click
WebBrowser1.Document.ExecCommand("Copy", False, vbNull)
WebBrowser2.Document.Body.InnerHtml = ""
WebBrowser2.Document.ExecCommand("Paste", False, vbNull)
texto_a_traducir = Me.WebBrowser2.Document.Body.OuterHtml
Dim objFrm As New Form3
objFrm.Show()
End Sub
End Class