Posts Tagged ‘VB

28
Apr
09

[Vb.Net] HTML Syntax Highlighter

Based very loosely on the original version I wrote in VBA for use in word.
Instead of looping through “words” this goes through each character and compares it with the colour of the last. Although this method may be slightly slower than splitting the string via spaces, the results are better as strings like Simon(“hithere”) would be incorrectly coloured.

    Private Sub SyntaxBtn_Press(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SyntaxBtn.Click
        CodeBox.SelectionStart = 0
        CodeBox.SelectionLength = 1
        Dim CurColour = CodeBox.SelectionColor
        Dim Output As String = "<div style='border: #660000 5px solid;color:#000000;'><pre style='background-color:#ffffff;padding:3px;line-height:15px;color:#000000;font-family: Courier New !important; font-size: 11px !important'>" & vbNewLine
        Output &= "<span style=""color:rgb(" & CurColour.R & ", " & CurColour.G & ", " & CurColour.B & ");"">"
        Output &= CodeBox.SelectedText
        Dim matches As System.Text.RegularExpressions.MatchCollection = System.Text.RegularExpressions.Regex.Matches(CodeBox.Text, "<")
        Progress.Maximum = CodeBox.TextLength + (matches.Count * 4)
        Progress.Value = 0
        For i As Integer = 1 To (CodeBox.TextLength + (matches.Count * 4))
            Progress.Value += 1
            CodeBox.SelectionStart = i
            CodeBox.SelectionLength = 1
            If CodeBox.SelectedText = "<" Then CodeBox.SelectedText = "\<"
            If CodeBox.SelectionColor <> CurColour Then CurColour = CodeBox.SelectionColor : Output &= "</span><span style=""color:rgb(" & CurColour.R & ", " & CurColour.G & ", " & CurColour.B & ");"">"
            Output &= CodeBox.SelectedText
        Next
        Output &= "</span> " & "</pre></div>"
        My.Computer.Clipboard.SetText(Output)
    End Sub

The example output for this is something like this:


Output &= \</span>\<span style="color:rgb(163, 21, 21);">"<span style=""color:rgb("\</span>\<span style="color:rgb(0, 0, 0);"> & CurColour.R & \</span>\<span style="color:rgb(163, 21, 21);">", "\</span>\<span style="color:rgb(0, 0, 0);"> & CurColour.G & \</span>\<span style="color:rgb(163, 21, 21);">", "\</span>\<span style="color:rgb(0, 0, 0);"> & CurColour.B & \</span>\<span style="color:rgb(163, 21, 21);">");"">"

\</span>\<span style="color:rgb(0, 0, 0);">        Output &= CodeBox.SelectedText

\</span>\<span style="color:rgb(0, 0, 255);">Dim\</span>\<span style="color:rgb(0, 0, 0);"> matches \</span>\<span style="color:rgb(0, 0, 255);">As\</span>\<span style="color:rgb(0, 0, 0);"> System.Text.RegularExpressions.MatchCollection = System.Text.RegularExpressions.Regex.Matches(CodeBox.Text, \</span>\<span style="color:rgb(163, 21, 21);">"<"\</span>\<span style="color:rgb(0, 0, 0);">)

Progress.Maximum = CodeBox.TextLength + (matches.Count * 4)

Progress.Value = 0

\</span>\<span style="color:rgb(0, 0, 255);">For\</span>\<span style="color:rgb(0, 0, 0);"> i \</span>\<span style="color:rgb(0, 0, 255);">As\</span>\<span style="color:rgb(0, 0, 0);"> \</span>\<span style="color:rgb(0, 0, 255);">Integer\</span>\<span style="color:rgb(0, 0, 0);"> = 1 \</span>\<span style="color:rgb(0, 0, 255);">To\</span>\<span style="color:rgb(0, 0, 0);"> (CodeBox.TextLength + (matches.Count * 4))

Progress.Value += 1

CodeBox.SelectionStart = i

CodeBox.SelectionLength = 1

\</span>\<span style="color:rgb(0, 0, 255);">If\</span>\<span style="color:rgb(0, 0, 0);"> CodeBox.SelectedText = \</span>\<span style="color:rgb(163, 21, 21);">"<"\</span>\<span style="color:rgb(0, 0, 0);"> \</span>\<span style="color:rgb(0, 0, 255);">Then\</span>\<span style="color:rgb(0, 0, 0);"> CodeBox.SelectedText = \</span>\<span style="color:rgb(163, 21, 21);">"\<"

\</span>\<span style="color:rgb(0, 0, 0);">            \</span>\<span style="color:rgb(0, 0, 255);">If\</span>\<span style="color:rgb(0, 0, 0);"> CodeBox.SelectionColor <> CurColour \</span>\<span style="color:rgb(0, 0, 255);">Then\</span>\<span style="color:rgb(0, 0, 0);"> CurColour = CodeBox.SelectionColor : Output &= \</span>\<span style="color:rgb(163, 21, 21);">"</span><span style=""color:rgb("\</span>\<span style="color:rgb(0, 0, 0);"> & CurColour.R & \</span>\<span style="color:rgb(163, 21, 21);">", "\</span>\<span style="color:rgb(0, 0, 0);"> & CurColour.G & \</span>\<span style="color:rgb(163, 21, 21);">", "\</span>\<span style="color:rgb(0, 0, 0);"> & CurColour.B & \</span>\<span style="color:rgb(163, 21, 21);">");"">"

\</span>\<span style="color:rgb(0, 0, 0);">            Output &= CodeBox.SelectedText

\</span>\<span style="color:rgb(0, 0, 255);">Next

\</span>\<span style="color:rgb(0, 0, 0);">        Output &= \</span>\<span style="color:rgb(163, 21, 21);">"</span> "\</span>\<span style="color:rgb(0, 0, 0);"> & \</span>\<span style="color:rgb(163, 21, 21);">"</pre></div>"

\</span>\<span style="color:rgb(0, 0, 0);">        \</span>\<span style="color:rgb(0, 0, 255);">My\</span>\<span style="color:rgb(0, 0, 0);">.Computer.Clipboard.SetText(Output)

\</span>\<span style="color:rgb(0, 0, 255);">End\</span>\<span style="color:rgb(0, 0, 0);"> \</span>\<span style="color:rgb(0, 0, 255);">Sub\</span> \</pre>\</div>
Advertisements
08
Apr
09

[VB.Net] Release: MSN Chat Log Reader 2

MSN Chat Log Reader 2

Main Window

Main Window

Features:

  • Custom Message colours
  • Custom Message options
  • Custom Save options
  • Remove messages from Log
  • Export as Comma Separated Text File (*.csv)
  • Export as Comma Separated Text File (*.txt)
  • Export as Tab Separated Text File (*.txt)
  • Reduces MSN Log file sizes when re-saved:
    msn-chat-log-reader-2-saved1

    Downloads & Source Code:
    Continue reading ‘[VB.Net] Release: MSN Chat Log Reader 2’

    08
    Apr
    09

    [VB.Net] Parse MSN Logs

    Little function for parsing MSN logs. They are structured in XML, so arnt too hard to read:

        Private Sub ParseMSNLogFile(ByVal Filename As String)
            ''Create our XML Reader
            Dim XML_Reader As New System.Xml.XmlTextReader(Filename)
            ''XML Headers
            XML_Reader.Read()
            XML_Reader.Read()
            XML_Reader.Read()
            XML_Reader.Read()
            XML_Reader.Read()
            ''Read Session Details
            Dim FirstSessionID = XML_Reader.GetAttribute("FirstSessionID")
            Dim LastSessionID = XML_Reader.GetAttribute("LastSessionID")
            ''Create Reading Loop
            While Not XML_Reader.EOF
                XML_Reader.Read()
                ''Get Message Date - Could alternatly get the DateTime attribute
                Dim MDate As String = XML_Reader.GetAttribute("Date")
                ''Get Message Time - Could alternatly get the DateTime attribute
                Dim MTime As String = XML_Reader.GetAttribute("Time")
                ''Get the ID of the current message
                Dim MSessionID As String = XML_Reader.GetAttribute("SessionID")
                XML_Reader.Read()
                XML_Reader.Read()
                ''Get the FriendlyName of the user who send the message
                Dim FromFriendlyName As String = XML_Reader.GetAttribute("FriendlyName")
                XML_Reader.Read()
                XML_Reader.Read()
                XML_Reader.Read()
                ''Get the FriendlyName of the user who recieved the message
                Dim ToFriendlyName As String = XML_Reader.GetAttribute("FriendlyName")
                XML_Reader.Read()
                XML_Reader.Read()
                ''Get the style of the message (Fonts & colours)
                Dim MStyle As String = XML_Reader.GetAttribute("Style")
                ''Get the messages content
                Dim MText As String = XML_Reader.ReadString
                XML_Reader.Read()
            End While
        End Sub

    That function in effects, does nothing other than read the file. It outputs nothing, and does not handle multi-person conversations.
    Check back for an example usage in a program in a bit.

    30
    Mar
    09

    [VB.Net] GetPixelColourCount

    Decided to turn my solution to the question here into an easy to use function.
    It uses the goto function, which I feel is frowned upon, but go ahead and complain ^_^

        ''' <summary >
        ''' Function to count the number of pixels of the same colour
        ''' </summary >
        ''' <param name="bmpImage" > The image as a Bitmap that you wish to count the pixels of</param >
        ''' <param name="Bounds" > The rectangle for the area that you wish to calculate</param >
        ''' <returns > A list of strings containing the pixels colour and the number of pixels of that colour</returns >
        ''' <remarks > sim0n</remarks >
        Private Function GetPixelColourCount(ByVal bmpImage As Bitmap, ByVal Bounds As RectangleF) As List(Of String())
            Dim Pixels As New List(Of String())
            For x As Integer = Bounds.Left To Bounds.Right - 1
                For y As Integer = Bounds.Top To Bounds.Bottom - 1
                    Dim Found As Boolean = False
                    For Each str As String() In Pixels
                        If str(0) = CStr(bmpImage.GetPixel(x, y).ToArgb) Then
                            str(1) = CStr(CInt(str(1)) + 1)
                            Found = True
                            GoTo pixelFound
                        End If
                    Next
                    Pixels.Add(New String() {CStr(bmpImage.GetPixel(x, y).ToArgb), 1})
    pixelFound:
                Next
            Next
            Return Pixels
        End Function

    Usage:
    Using image: http://privatewww.essex.ac.uk/~sjs/research/iso_colour_blocks.png

            ''Get our image from PictureBox1
            Dim btmp As New Bitmap(PictureBox1.Image)
            ''Set the cursor to wait
            Me.Cursor = Cursors.WaitCursor
            ''Loop through the results - Rectangle is the entire image
            For Each str As String() In GetPixelColourCount(btmp, New RectangleF(0, 0, btmp.PhysicalDimension.Width, btmp.PhysicalDimension.Height))
                Debug.WriteLine(Color.FromArgb(str(0)).ToString & " | Count: " & str(1))
            Next
            ''Reset Cursor
            Me.Cursor = Cursors.Default

    Would output:
    Color [A=255, R=85, G=85, B=85] | Count: 65536
    Color [A=255, R=0, G=255, B=0] | Count: 32768
    Color [A=255, R=127, G=0, B=128] | Count: 32768
    Color [A=255, R=0, G=0, B=255] | Count: 32768
    Color [A=255, R=127, G=128, B=0] | Count: 32768
    Color [A=255, R=255, G=0, B=0] | Count: 32768
    Color [A=255, R=0, G=127, B=128] | Count: 32768

    You can also just select regions of the image to calculate using the Bounds parameter, for example to get the colour of just one square, you could do:

      ''64 Pixels along
      ''0 Pixels down
      ''Width 64 pixels
      ''Heigh 64 Pixels
      For Each str As String() In GetPixelColourCount(btmp, New RectangleF(64, 0, 64, 64))
          Debug.WriteLine(Color.FromArgb(str(0)).ToString & " | Count: " & str(1))
      Next

    Would output:
    Color [A=255, R=127, G=128, B=0] | Count: 4096

    30
    Mar
    09

    [VB.Net] Q: Get the amount and colour of pixels in an Image

    The question asked “How do i get the amount and colour of pixels in an Image?”

    The Solution
    I had to think a bit about this one, dealing with image processing needs to be as efficent as possible, however I couldnt see a better way than just looping through the pixels and adding them to a list.
    Here is the solution that I posted to the users project:

        Dim PixelList As New List(Of String())
    
        Public Sub ColourInList(ByVal Colour As Color)
            Dim Found As Boolean = False
            For Each str As String() In PixelList
                If str(0) = CStr(Colour.ToArgb) Then
                    str(1) = CStr(CInt(str(1)) + 1)
                    Found = True
                    Exit For
                End If
            Next
            If Found = False Then PixelList.Add(New String() {CStr(Colour.ToArgb), 1})
        End Sub
    
        Private Sub PictureBox1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles PictureBox1.Click
            Dim btmp As New Bitmap(PictureBox1.Image)
            For x As Integer = 0 To btmp.Width - 1
                For y As Integer = 0 To btmp.Height - 1
                    ColourInList(btmp.GetPixel(x, y))
                Next
            Next
            For Each str As String() In PixelList
                Debug.WriteLine(Color.FromArgb(str(0)).ToString & " | Count: " & str(1))
            Next
        End Sub

    Would Output:
    Using this Image:
    http://privatewww.essex.ac.uk/~sjs/research/iso_colour_blocks.png

    Color [A=255, R=85, G=85, B=85] | Count: 65536
    Color [A=255, R=0, G=255, B=0] | Count: 32768
    Color [A=255, R=127, G=0, B=128] | Count: 32768
    Color [A=255, R=0, G=0, B=255] | Count: 32768
    Color [A=255, R=127, G=128, B=0] | Count: 32768
    Color [A=255, R=255, G=0, B=0] | Count: 32768
    Color [A=255, R=0, G=127, B=128] | Count: 32768

    28
    Mar
    09

    [VB.net] Keyboard Hook Class

    The keyboard hook from my old blog; “Low Level Keyboard Hook (Global) – Installing a Low Level Keyboard Hook”
    This version is slightly updated, to cast the vkCode to the .net Keys enum to make key handling easier.

    [16 June 2011 complete rewrite – should now work on every system -_-]

    Imports System.Runtime.InteropServices
    
    Public Class KeyboardHook
    
        <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)> _
        Private Overloads Shared Function SetWindowsHookEx(ByVal idHook As Integer, ByVal HookProc As KBDLLHookProc, ByVal hInstance As IntPtr, ByVal wParam As Integer) As Integer
        End Function
        <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)> _
        Private Overloads Shared Function CallNextHookEx(ByVal idHook As Integer, ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
        End Function
        <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)> _
        Private Overloads Shared Function UnhookWindowsHookEx(ByVal idHook As Integer) As Boolean
        End Function
    
        <StructLayout(LayoutKind.Sequential)> _
        Private Structure KBDLLHOOKSTRUCT
            Public vkCode As UInt32
            Public scanCode As UInt32
            Public flags As KBDLLHOOKSTRUCTFlags
            Public time As UInt32
            Public dwExtraInfo As UIntPtr
        End Structure
    
        <Flags()> _
        Private Enum KBDLLHOOKSTRUCTFlags As UInt32
            LLKHF_EXTENDED = &H1
            LLKHF_INJECTED = &H10
            LLKHF_ALTDOWN = &H20
            LLKHF_UP = &H80
        End Enum
    
        Public Shared Event KeyDown(ByVal Key As Keys)
        Public Shared Event KeyUp(ByVal Key As Keys)
    
        Private Const WH_KEYBOARD_LL As Integer = 13
        Private Const HC_ACTION As Integer = 0
        Private Const WM_KEYDOWN = &H100
        Private Const WM_KEYUP = &H101
        Private Const WM_SYSKEYDOWN = &H104
        Private Const WM_SYSKEYUP = &H105
    
        Private Delegate Function KBDLLHookProc(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
    
        Private KBDLLHookProcDelegate As KBDLLHookProc = New KBDLLHookProc(AddressOf KeyboardProc)
        Private HHookID As IntPtr = IntPtr.Zero
    
        Private Function KeyboardProc(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
            If (nCode = HC_ACTION) Then
                Dim struct As KBDLLHOOKSTRUCT
                Select Case wParam
                    Case WM_KEYDOWN, WM_SYSKEYDOWN
                        RaiseEvent KeyDown(CType(CType(Marshal.PtrToStructure(lParam, struct.GetType()), KBDLLHOOKSTRUCT).vkCode, Keys))
                    Case WM_KEYUP, WM_SYSKEYUP
                        RaiseEvent KeyUp(CType(CType(Marshal.PtrToStructure(lParam, struct.GetType()), KBDLLHOOKSTRUCT).vkCode, Keys))
                End Select
            End If
            Return CallNextHookEx(IntPtr.Zero, nCode, wParam, lParam)
        End Function
    
        Public Sub New()
            HHookID = SetWindowsHookEx(WH_KEYBOARD_LL, KBDLLHookProcDelegate, System.Runtime.InteropServices.Marshal.GetHINSTANCE(System.Reflection.Assembly.GetExecutingAssembly.GetModules()(0)).ToInt32, 0)
            If HHookID = IntPtr.Zero Then
                Throw New Exception("Could not set keyboard hook")
            End If
        End Sub
    
        Protected Overrides Sub Finalize()
            If Not HHookID = IntPtr.Zero Then
                UnhookWindowsHookEx(HHookID)
            End If
            MyBase.Finalize()
        End Sub
    
    End Class
    
    

    Usage:
    To create the hook

    Private WithEvents kbHook As New KeyboardHook

    Then each event can be handled:

    Private Sub kbHook_KeyDown(ByVal Key As System.Windows.Forms.Keys) Handles kbHook.KeyDown Debug.WriteLine(Key.ToString) End Sub Private Sub kbHook_KeyUp(ByVal Key As System.Windows.Forms.Keys) Handles kbHook.KeyUp Debug.WriteLine(Key) End Sub

    Note: To run this inside Visual Studio, you will need to go to:
    Project -> [Project Name] Properties -> Debug -> Uncheck “Enable the Visual Studio hosting process”
    As that intercepts the hooked messages before your program.

    28
    Mar
    09

    [VB.Net] Binary To String Conversion

        Public Function BinaryToString(ByVal Binary As String) As String
            Dim Characters As String = System.Text.RegularExpressions.Regex.Replace(Binary, "[^01]", "")
            Dim ByteArray((Characters.Length / 8 ) - 1) As Byte
            For Index As Integer = 0 To ByteArray.Length - 1
                ByteArray(Index) = Convert.ToByte(Characters.Substring(Index * 8, 8), 2)
            Next
            Return System.Text.ASCIIEncoding.ASCII.GetString(ByteArray)
        End Function

    Usage:

    Debug.WriteLine(BinaryToString("01110011 01101001 01101101 00110000 01101110"))

    Would output:

    sim0n

    Debug.WriteLine(BinaryToString("01110011,01101001,01101101,00110000,01101110,"))

    Would output:

    sim0n