Indexed Dictionary

April 25, 2014, 3:46 pm

≫ Next: Seasonal colors

≪ Previous: CheckedListBox language extension library for VS2012

$

0

0

I occasionally have a need for an indexed dictionary. Here is my solution:

Code:

---

Public Class IndexedDictionary(Of TKey, TValue)

#Region "Properties"

    Private pCount As Integer
    <System.ComponentModel.Description("Gets the number of total pairs.")> _
    Public ReadOnly Property Count() As Integer
        Get
            Return pCount
        End Get
    End Property

    Private itms As List(Of KeyValuePair(Of TKey, TValue))
    <System.ComponentModel.Description("Gets the pairs.")> _
    Public ReadOnly Property Items() As List(Of KeyValuePair(Of TKey, TValue))
        Get
            Return itms
        End Get
    End Property

    Private key As List(Of TKey)
    Private ReadOnly Property Keys() As List(Of TKey)
        Get
            Return key
        End Get
    End Property

    Private uniqueKeys As Boolean
    <System.ComponentModel.Description("Gets/Sets if the keys in the items are unique.")> _
    Public Property KeysAreUnique() As Boolean
        Get
            Return uniqueKeys
        End Get
        Set(ByVal value As Boolean)
            uniqueKeys = value
        End Set
    End Property

    Private value As List(Of TValue)
    Private ReadOnly Property Values() As List(Of TValue)
        Get
            Return value
        End Get
    End Property

#End Region

#Region "Methods"

    Private Sub ResetCount()
        pCount = key.Count

        itms.Clear()

        For i As Integer = 0 To key.Count - 1
            itms.Add(New KeyValuePair(Of TKey, TValue)(key(i), value(i)))
        Next
    End Sub

    Public Sub Add(ByVal pair As KeyValuePair(Of TKey, TValue))
        If uniqueKeys AndAlso key.Contains(pair.Key) Then
            Throw New ArgumentException("An item with the same key has already been added and the KeysAreUnique property is True.")
        Else
            key.Add(pair.Key)
            value.Add(pair.Value)
            Me.ResetCount()
        End If
    End Sub

    Public Sub AddRange(ByVal pairs() As KeyValuePair(Of TKey, TValue))
        If uniqueKeys Then

            For Each pair As KeyValuePair(Of TKey, TValue) In pairs
                If key.Contains(pair.Key) Then
                    Throw New ArgumentException("An item with the same key has already been added and the KeysAreUnique property is True.")
                Else
                    key.Add(pair.Key)
                    value.Add(pair.Value)
                End If
            Next

            Me.ResetCount()
        Else
            For Each pair As KeyValuePair(Of TKey, TValue) In pairs
                key.Add(pair.Key)
                value.Add(pair.Value)
            Next

            Me.ResetCount()
        End If
    End Sub

    Public Function GetItem(ByVal i As Integer) As KeyValuePair(Of TKey, TValue)
        Return itms.Item(i)
    End Function

    Public Sub Remove(ByVal key As TKey)
        If uniqueKeys Then

            Me.key.Remove(key)

        Else

            For i As Integer = Me.key.Count - 1 To 0 Step -1
                If Me.key(i).ToString = key.ToString Then
                    Me.key.RemoveAt(i)
                End If
            Next

        End If
    End Sub

    Public Sub Remove(ByVal pair As KeyValuePair(Of TKey, TValue))
        If uniqueKeys Then

            Me.key.Remove(pair.Key)
            Me.value.Remove(pair.Value)

        Else

            For i As Integer = Me.key.Count - 1 To 0 Step -1
                If Me.key(i).ToString = pair.Key.ToString Then
                    Me.key.RemoveAt(i)
                    Me.value.RemoveAt(i)
                End If
            Next

        End If

        Me.ResetCount()
    End Sub

    Public Sub RemoveAt(ByVal i As Integer)

        Me.key.RemoveAt(i)
        Me.value.RemoveAt(i)
        Me.ResetCount()

    End Sub

#End Region

#Region "New Constructor"

    Public Sub New()
        itms = New List(Of KeyValuePair(Of TKey, TValue))
        key = New List(Of TKey)
        uniqueKeys = True
        value = New List(Of TValue)
        Me.ResetCount()
    End Sub

#End Region

End Class

---

---

Seasonal colors

April 29, 2014, 11:31 am

≫ Next: Contacts Management System

≪ Previous: Indexed Dictionary

$

0

0

The following code permits a developer to select a color based on a season of the year.

Code:

---

Module Seasons
    Public Enum Season
        Spring = 0
        Summer = 1
        Autumn = 2
        Winter = 3
    End Enum
    ''' <summary>
    ''' Return the season for the date passed in
    ''' </summary>
    ''' <param name="sender">Date</param>
    ''' <returns>A member of Season Enum</returns>
    ''' <remarks>Seasons are generally subjective where they begin and end, feel free to keep silent</remarks>
    Public Function GetSeason(ByVal sender As Date) As Season

        Dim value As Single = CSng(sender.Month) + sender.Day \ 100 ' <month>.<day(2 digit)>

        If value < 3.21 OrElse value >= 12.22 Then
            Return Season.Winter
        End If
        If value < 6.21 Then
            Return Season.Spring
        End If
        If value < 9.23 Then
            Return Season.Summer
        End If
        Return Season.Autumn
    End Function
    ''' <summary>
    ''' Return a seasonal color for a date
    ''' </summary>
    ''' <param name="sender">Date</param>
    ''' <returns></returns>
    ''' <remarks>Date is generally the current date</remarks>
    Public Function GetSeasonColor(ByVal sender As Date) As Color
        Dim c As Color

        Select Case GetSeason(Now)
            Case Season.Autumn
                c = Color.Brown
            Case Season.Spring
                c = Color.Pink
            Case Season.Summer
                c = Color.Purple
            Case Season.Winter
                c = Color.White
        End Select

        Return c

    End Function
    ''' <summary>
    ''' Set control background color to a pre-defined color for the current season
    ''' </summary>
    ''' <param name="sender">Control</param>
    ''' <remarks></remarks>
    <System.Diagnostics.DebuggerHidden()> _
    <System.Runtime.CompilerServices.Extension()> _
    Public Sub SeasonalBackColor(ByVal sender As Control)
        sender.BackColor = GetSeasonColor(Now)
    End Sub
End Module

---

Set current form's BackColor

Code:

---

Me.SeasonalBackColor()

---

Set a button's BackColor

Code:

---

cmdClose.SeasonalBackColor()

---

Please note I am sane but had a customer who asked for this.

Contacts Management System

April 30, 2014, 9:28 am

≫ Next: Programmatically add Watermark to Word document - VB.Net

≪ Previous: Seasonal colors

$

0

0

I see this homework question asked quite a bit, so I figured I'd post a link to a working example. The assignment is to create a program to add/delete/search for somebody with their phone number. The method I use utilizes a dictionary and LINQ:

Code:

---

Option Strict On
Option Explicit On
Module Module1

    Private contact As Dictionary(Of String, String)
    Sub Main()
        contact = New Dictionary(Of String, String)

        Call MainMenu()
    End Sub

    Private Function ValidateNumber(ByVal number As String) As Boolean
        If number.Length = 12 AndAlso _
            Integer.TryParse(number.Substring(0, 3), New Integer) AndAlso _
            Integer.TryParse(number.Substring(4, 3), New Integer) AndAlso _
            Integer.TryParse(number.Substring(8), New Integer) Then
            Return True
        Else
            Return False
        End If
    End Function

    Private Sub MainMenu()
        Do
            Console.Clear()

            Console.WriteLine("Search - 1")
            Console.WriteLine("Add    - 2")
            Console.WriteLine("Delete - 3")
            Console.Write("Enter in a selection: ")

            Dim response As String = Console.ReadLine
            Dim result As Integer

            If Integer.TryParse(response, result) AndAlso result > 0 AndAlso result < 4 Then
                Select Case result
                    Case 1
                        Call Search()
                    Case 2
                        Call Add()
                    Case 3
                        Call Delete()
                End Select
            End If
        Loop
    End Sub

    Private Sub Search()
        Do

            Console.Clear()
            Console.ForegroundColor = ConsoleColor.Cyan
            Console.WriteLine("You may return to the main menu at anytime by entering in 'exit'")
            Console.ForegroundColor = ConsoleColor.Gray
            Console.WriteLine()
            Console.Write("Contact's Name: ")

            Dim name As String = Console.ReadLine
            If name.ToLower = "exit" Then
                Exit Do
            End If

            Dim results() As String = Array.FindAll(contact.Keys.ToArray, Function(n) n.ToString.ToLower.StartsWith(name))
            Array.Sort(results)

            If results.Length > 0 Then
                For Each person As String In results
                    Console.WriteLine("    " & person & ": " & contact(person))
                Next
            Else
                Console.WriteLine("No matches found.")
            End If

            Console.WriteLine()
            Console.WriteLine("Press any key to go back to the search menu.")
            Console.ReadKey()

        Loop
    End Sub

    Private Sub Add()
        Do

            Console.Clear()
            Console.ForegroundColor = ConsoleColor.Cyan
            Console.WriteLine("You may return to the main menu at anytime by entering in 'exit'")
            Console.ForegroundColor = ConsoleColor.Gray
            Console.WriteLine()
            Console.Write("Contact's Name: ")

            Dim name As String = Console.ReadLine
            If name.ToLower = "exit" Then
                Exit Do
            End If

            Dim number As String
            Do
                Console.CursorLeft = 0
                Console.Write("Contact's Number(123-456-7890): ")
                number = Console.ReadLine

                If number.ToLower = "exit" Then
                    Exit Sub
                ElseIf ValidateNumber(number) Then
                    Exit Do
                Else
                    Console.WriteLine("Invalid number. Press any key to re-enter the number.")
                    Console.ReadKey()
                End If
            Loop

            If contact.ContainsKey(name) Then
                Console.WriteLine("There is already a person named " & name & " saved.")
                Console.WriteLine("Press any key to go back to the add menu.")
                Console.ReadKey()
            Else
                contact.Add(name, number)
                Console.WriteLine(name & " was successfully added.")
                Console.WriteLine("Press any key to go back to the add menu.")
                Console.ReadKey()
            End If

        Loop
    End Sub

    Private Sub Delete()
        Do

            Console.Clear()
            Console.ForegroundColor = ConsoleColor.Cyan
            Console.WriteLine("You may return to the main menu at anytime by entering in 'exit'")
            Console.ForegroundColor = ConsoleColor.Gray
            Console.WriteLine()
            Console.Write("Contact's Name: ")

            Dim name As String = Console.ReadLine
            If name.ToLower = "exit" Then
                Exit Do
            End If

            If contact.ContainsKey(name) Then
                contact.Remove(name)
                Console.WriteLine(name & " was successfully removed.")
                Console.WriteLine("Press any key to go back to the delete menu.")
                Console.ReadKey()
            Else
                Console.WriteLine("Could not find a person named " & name)
                Console.WriteLine("Press any key to go back to the add menu.")
                Console.ReadKey()
            End If

        Loop

    End Sub

End Module

---

Programmatically add Watermark to Word document - VB.Net

May 2, 2014, 7:54 am

≫ Next: Better way to delete application by PID

≪ Previous: Contacts Management System

$

0

0

Morning everyone,

Thought I would give back a bit of code that I have been working on all morning so others won't have to search and hack their way to the answer. The function below adds a centered watermark to all pages of a word document. Main class must import Microsoft.Office.Interop and (I think) System.Runtime.InteropServices.

With a little more work this could also be adapted to watermark photos but will leave that for someone else :)

Code:

---

Private Function AddWatermark(ByVal pdocument As Word.Document) As Word.Document
            Dim nShape As Word.Shape

            For Each section As Word.Section In pdocument.Sections
                nShape = section.Headers(Word.WdHeaderFooterIndex.wdHeaderFooterPrimary).Shapes.AddTextEffect(Microsoft.Office.Core.MsoPresetTextEffect.msoTextEffect1, "DRAFT", "Rockwell Extra Bold", 90, Microsoft.Office.Core.MsoTriState.msoTrue, Microsoft.Office.Core.MsoTriState.msoFalse, 0, 0)
                nShape.Fill.Visible = Microsoft.Office.Core.MsoTriState.msoTrue
                nShape.Line.Visible = Microsoft.Office.Core.MsoTriState.msoFalse
                nShape.Fill.Solid()
                nShape.Rotation = -45
                nShape.Fill.ForeColor.RGB = Word.WdColor.wdColorGray20
                nShape.RelativeHorizontalPosition = Word.WdRelativeHorizontalPosition.wdRelativeHorizontalPositionMargin
                nShape.RelativeVerticalPosition = Word.WdRelativeVerticalPosition.wdRelativeVerticalPositionMargin
                nShape.Left = Word.WdShapePosition.wdShapeCenter
                nShape.Top = Word.WdShapePosition.wdShapeCenter
            Next

            Return pdocument
        End Function

---

Better way to delete application by PID

May 15, 2014, 5:56 am

≫ Next: Random Polygon Algorithm

≪ Previous: Programmatically add Watermark to Word document - VB.Net

$

0

0

Wrong forum, please delete this post.

Random Polygon Algorithm

May 16, 2014, 1:23 pm

≫ Next: Iron man JARVIS project

≪ Previous: Better way to delete application by PID

$

0

0

First off, thanks to: Inferred, Ident, and Kaliman for helping me out on this one.


I created this random polygon algorithm in vb.net for the video game asteroids. I use the TwoPeasants algorithm and here are the steps:


Step 1. Create a List(Of PointF) to store the points of the polygon

Step 2. Create two points. One on the far left of the control and one on the far right of the control. Both points will have a random Y location from 0 to the Height of the control

Step 3. Create a GraphicsPath and add a line to that path. The line will be the two points created in step 2.

Step 4. Loop 'x' amount of times twice. Once for above the line and once for below the line

Step 5. In that loop, get the X position which will be 'x' divided by the controls width and the Y position will be a random point above or below the line(depending on which loop it is in)

Step 6. Add the point in that loop to the List

Step 7. Draw the polygon and set the control's region to that polygon

Source:

Code:

---

Option Strict On
Option Explicit On
Public Class Polygon : Inherits System.Windows.Forms.Control

    Private r As Random
    Private img As Bitmap

    Public ReadOnly Property Image As Bitmap
        Get
            Return img
        End Get
    End Property

    Private Function CreateAsteroid() As Bitmap
        'Create a bitmap that is the same dimensions as the control
        Dim b As Bitmap = New Bitmap(Me.Width, Me.Height)
        'Create a graphics from the bitmap
        Using g As Graphics = Graphics.FromImage(b)
            'Create a list to store our PointF
            Dim pts As List(Of PointF) = New List(Of PointF)

            'Get the left and right points that will make up our imaginary line
            Dim leftPt As PointF = New PointF(0, r.Next(0, Me.Height + 1))
            Dim rightPt As PointF = New Point(Me.Width, r.Next(0, Me.Height + 1))
            'Create the graphics path that will actually store the imaginary line
            Dim path As Drawing2D.GraphicsPath = New Drawing2D.GraphicsPath
            path.AddLine(leftPt, rightPt)

            'Add the left point to the list first
            pts.Add(leftPt)

            Dim topPoints As Integer = r.Next(1, 3)
            'Loop from 0 - 'n'
            For topY As Integer = 1 To topPoints
                'The x will be 'n' divided by the width plus whatever iteration we are on
                Dim x As Single = CSng(topY + (Me.Width / topPoints))
                'The y will be a random point above the imaginary line
                Dim y As Single = r.Next(-1, CInt(path.PathPoints.FirstOrDefault(Function(p) p.X = x).Y))

                'Add the point to the list
                pts.Add(New PointF(x, y))
            Next

            'Add the right point to the list
            pts.Add(rightPt)

            Dim botPoints As Integer = r.Next(1, 3)
            'Loop from 'n' - 0
            For bottomY As Integer = botPoints To 1 Step -1
                'The x will be 'n' divided by the width plus whatever iteration we are on
                Dim x As Single = CSng(bottomY + (Me.Width / topPoints))
                'The y will be a random point below the imaginary line
                Dim y As Single = r.Next(CInt(path.PathPoints.FirstOrDefault(Function(p) p.X = x).Y), Me.Height)

                'Add the point to the list
                pts.Add(New PointF(x, y))
            Next

            'Draw the polygon
            Using p As Pen = New Pen(Brushes.Black, 5)
                g.DrawPolygon(p, pts.ToArray)
            End Using

            'Reuse the graphics
            path = New Drawing2D.GraphicsPath
            'Add the polygon to the path
            path.AddPolygon(pts.ToArray)

            'Set the region
            Me.Region = New Region(path)

        End Using

        Return b
    End Function

    Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)
        MyBase.OnPaint(e)

        If img IsNot Nothing Then
            e.Graphics.DrawImage(img, New Point(1, 1))
        Else
            img = Me.CreateAsteroid
        End If
    End Sub

    Private Sub Asteroid_SizeChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.SizeChanged
        img = Me.CreateAsteroid
    End Sub

    Sub New()
        r = New Random
    End Sub


End Class

---

Iron man JARVIS project

May 26, 2014, 5:16 pm

≫ Next: Why Won't My Form_Load Executing?

≪ Previous: Random Polygon Algorithm

$

0

0

Hi All,

So this project is something I have hinted at in the main forum and feel it more belongs here, this thread is to monitor my progress and maybe get some help along the way.

The ultimate goal will be a JARVIS like system that Iron man has. Its main area to be used is costume making (there is a lot of makers out there), the system will take voice commands and turn that into an action on the suit itself, for example open faceplate will open the well faceplate.

The system will also run an augmented reality side, this will take 2 live feeds from HD webcams and overlay information on them, so far I have face detection working, I plan on adding person detection and maybe some other nice little tricks like calling people via voice, loudspeaker etc the augmented reality feed will be send to two tiny HD screens to be mounted in the eyes of the helmet. just in case you were wondering :)

In the end you user will hopefully be able to include this in their builds and use the suit more authentically and customize the commands according to how much they animate the suit.

I have a long road to go down so all feedback positive and negative is welcome, i also have a lot to learn in ways of speech recognition and image related topics (finding people).

now attached to this is the first ROUGH program, it takes a webcam feed (i have set it to camera 1 as that's what my laptop is, please change the camerasel value if you are playing with it), it also has the command open faceplate and close faceplate. It gives a status of the faceplate on screen but this will not be needed.

I had issues with the speed of voice recognition so I changed the code and it now works much better.

For the attached to work you will need to install and reference the Aforge.Net libaray and the Accord.Net libaray

Attached Files

• JARVIS.zip (13.5 KB)

Why Won't My Form_Load Executing?

May 29, 2014, 9:13 am

≫ Next: Save a reversed Quote Comma CSV file, with one line for each row of a DataGridView

≪ Previous: Iron man JARVIS project

$

0

0

I see the question asked: Why won't my form_load event fire? or Why isn't my form_load executing one way or another quite a bit and I felt the need to write an example on different solutions on how to solve this issue.

The first and most likely culprit is that you're missing your handles clause. If you've cut/paste code from the internet or from existing code or perhaps you're brave and trying to type out the event free handed, it's likely that the handles clause may get removed by the IDE. How can you tell if the handles clause is missing? Well if you form_load event(or any other event for that matter) looks like this:

Code:

---

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs)
    Console.WriteLine("Foo")
End Sub

---

Then you're missing the handles clause. Here is how the form_load event should look like:

Code:

---

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    Console.WriteLine("foo")
End Sub

---

Or

Code:

---

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Me.Load
    Console.WriteLine("foo")
End Sub

---

If that solves your problem, don't worry as it happens to the best of us too! If it doesn't solve your problem, then read on.

The second culprit can actually be a bug within the IDE. If you're running Windows 7, it is the x64 Bit system, and you have the Handles clause at the end of the event line; then it's more than likely this bug. What happens is if your code is to throw an exception in the form_load event, Windows will swallow that exception and not execute the remainder of the code in the event. Here is a good example of what would cause an exception in the form_load event and get swallowed by Windows:

Code:

---

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Me.Load
    Dim sr As IO.StreamReader

    Console.WriteLine(sr.ReadLine())
    Console.WriteLine("Finished")
End Sub

---

What would happen normally, is that an exception would occur because the StreamReader has not been set to a new instance. But let's assume for a second that we do not know why an exception would normally occur, how would we find out what is causing an exception? Well there are three popular options.

The first option is to move the code to the Form_Shown event. The Form_Shown event will not swallow the exception like the Form_Load would.

The second option is to wrap the whole code into a Try/Catch statement and wait for the exception to occur.

The third option is to set breakpoints on every line inside of the Form_Load event. You will know which line throws the exception as it will be the last line to trigger the break.

After you follow one of those options, you will recognize that a NullReferanceException would be thrown because(as stated before) the StreamReader is not set to a new instance. In this particular case I'd adjust how I declare the StreamReader.

These are the two most probable suspects. However, if you do have a unique situation where your form_load event will not execute; please let me know so that I may update this thread.

---

Save a reversed Quote Comma CSV file, with one line for each row of a DataGridView

June 5, 2014, 5:07 am

≫ Next: VB2010 Hangman game

≪ Previous: Why Won't My Form_Load Executing?

$

0

0

The following code will write out a 'Quote Comma' style CSV file, in upper case, with one line for each row of cells in a DataGridView ... but in the reverse order to what's shown on screen :)

It takes values from the DataGridView1 component shown in blue, and writes it to the file location marked in red, so please change these to the names of your DataGridView and File location if you want to use this code in your own project. Just copy and paste the code below onto a button, and modify it as needed :)

Please rate the post if you find this useful. Cheers.

Code:

---

        Dim rows = From row As DataGridViewRow In DataGridView1.Rows.Cast(Of DataGridViewRow)() _
          Where Not row.IsNewRow _
          Select Array.ConvertAll(row.Cells.Cast(Of DataGridViewCell).ToArray, Function(c) If(c.Value IsNot Nothing, c.Value.ToString, ""))
        Dim r(rows.Count) As String
        Using sw As New IO.StreamWriter("U:\Test.imf")
            For rowNum As Integer = rows.Count - 1 To 0 Step -1
                r = rows(rowNum)
                'Write a double quotation mark as the first character of the line.
                sw.Write("""")
                'Uppercase and join the strings together into a quote comma CSV format before writing them to the file.
                Dim uppercaseit As String = Nothing
                uppercaseit = String.Join(""",""", r)
                uppercaseit = uppercaseit.ToUpper()
                sw.Write(uppercaseit)
                'Write a double quotation mark as the last character of the line, and finish with a carriage return.
                sw.WriteLine("""")
            Next
            sw.Close()
        End Using

---

VB2010 Hangman game

June 6, 2014, 6:48 am

≫ Next: Lexical Analyzer

≪ Previous: Save a reversed Quote Comma CSV file, with one line for each row of a DataGridView

$

0

0

Hangman.zip
This is a simple game I made for my school. I hope to be able to deploy it on an interactive whiteboard eventually. We use hangman a lot to learn the alphabet and that is the reason I have included the option for single player or up to four teams.
Click "New Game and you use the letter buttons to choose the word(s) to be guessed. There is no reflection on screen for obvious reasons. At this stage, you can also choose the number of teams you want. Clicking "Finished" removes some of the command buttons and play begins.
Just click a letter to guess. If it is correct, it adds to the current team's score and if not, it adds to the hanged man.
When the game is over, all scores and the next team to play are preserved so you can play many consecutive games.
There is also a single player option without scores.
Further possible improvements:
Add sound, this is a must for my children.
Set team names

NOTE: If you decide to develop this game further, be aware you can NOT use Messagebox.Show. No idea why, but it seems to hang in the PictureBox.Paint sub.

This is a screenshot mid game:

I hope somebody has fun with this offering :)

Attached Images

 

Attached Files

• Hangman.zip (45.1 KB)

Lexical Analyzer

June 6, 2014, 8:41 am

≫ Next: VB.NET Circle-Circle collision bounce response working perfectly!

≪ Previous: VB2010 Hangman game

$

0

0

For those of you who do not know, I've been trying to create my own compiler. The first step in this is the lexical analyzer. Basically what a lexical analyzer does is separate everything in a source code and converts certain words/characters into tokens. The way that my lexical analyzer works in this GUI program is that it stores the tokens in an XML file in this format:

Code:

---

<source>
    <token>
        <name>token class name here</name>
        <value>token value here</value>
    </token>
    ....
    ....
</source>

---

Here is an image of the program in action:


The scanner scans in order, so some important ordering in the case above is that I have my number class above my decimal class. I also have the identifier very last in the order. The reason for the number before the decimal is because any decimal(in my case) can match a number, but not every number can match a decimal. The reason why I have the identifier last is because almost everything(in my case) can be interpreted as an identifier.

Here is the program(minus the binaries):
lexical_analyzer.zip

Here is the template that I use for my language in case you don't want to create the token classes:
custom template.xml

Now this program is not practical in creating a custom compiler, it just simply shows a technique of a scanner.

Attached Images

 

Attached Files

• lexical_analyzer.zip (68.3 KB)
• custom template.xml (914 Bytes)

VB.NET Circle-Circle collision bounce response working perfectly!

June 15, 2014, 10:15 am

≫ Next: [VB10] Class Code Creator

≪ Previous: Lexical Analyzer

$

0

0

This drove me crazy for a few weeks, but with the help of Mindcode, I got the collision response working perfectly!



The updated zipped project is attached at the bottom of this post.

Your keyboard's directional arrow keys control Circle1.


In this project:
2 Panels (Circle1 & Circle2) background and foreground color set to transparent
1 Timer (gameloop) with an interval of 1
1 Ovalshape, size 12x12, from toolbox
3 Labels

Code:

---

Option Strict On

Public Class Form1
    Dim veky As Double
    Dim vekx As Double
    Dim leng As Double
    Dim v1 As Double
    Dim v2 As Double
    Dim u1 As Double
    Dim u2 As Double

    Dim ax As Single = 0
    Dim ay As Single = 0
    Dim speedx As Single = 0
    Dim speedY As Single = 0
    Dim switch As Single
    Dim speedx2 As Single = 0
    Dim speedY2 As Single = 0
    Dim minusx As Single = 0
    Dim minusY As Single = 0
    Dim Friction As Single = 0.98

    Dim Uloc_x As Single = 90
    Dim Uloc_y As Single = 90
    Dim Uloc_x2 As Single = 606
    Dim Uloc_y2 As Single = 263
    Dim right_side As Integer
    Dim bottom_side As Integer

    Dim op As Integer
    Dim adj As Integer
    Dim p1 As Point
    Dim p2 As Point

    Dim p3 As Point = New Point(0.0F, 60.0F)
    Dim p4 As Point = New Point(0.0F, 0.0F)

    Dim Angle As Double

    Dim total As Integer
    Dim finalT As Integer

    Dim px As Integer
    Dim py As Integer
    Dim collision As Integer
    Dim getX As Integer
    Dim getY As Integer
    Dim getX2 As Integer
    Dim getY2 As Integer
    Dim delayer As Integer = 1

    Protected Overrides ReadOnly Property CreateParams() As CreateParams

        Get
            Dim cp As CreateParams = MyBase.CreateParams
            cp.ExStyle = cp.ExStyle Or &H2000000
            ' Turn on WS_EX_COMPOSITED
            Return cp
        End Get

    End Property



    Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown

        Select Case e.KeyCode
            Case Keys.Left
                ax = -0.3
            Case Keys.Right
                ax = 0.3
            Case Keys.Up
                ay = -0.3
            Case Keys.Down
                ay = 0.3
        End Select

    End Sub



    Private Sub Form1_KeyUp(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyUp
        ax = 0
        ay = 0
    End Sub



    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        SetStyle(ControlStyles.DoubleBuffer, True)
        SetStyle(ControlStyles.AllPaintingInWmPaint, True)

        gameloop.Start()

        OvalShape1.Visible = True
        OvalShape1.BorderColor = Color.Black

        EPLabel.Parent = Circle2
        C2Label.Parent = Circle2

    End Sub



    Private Sub gameloop_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles gameloop.Tick

        p1 = New Point(CInt(Uloc_x), CInt(Uloc_y))
        p2 = New Point(CInt(Uloc_x2), CInt(Uloc_y2))

        right_side = Me.Width
        bottom_side = Me.Height

        speedY += ay
        speedx += ax

        speedY *= Friction
        speedx *= Friction
        speedY2 *= Friction
        speedx2 *= Friction

        Uloc_x += speedx
        Uloc_y += speedY
        Uloc_x2 += speedx2
        Uloc_y2 += speedY2

        'bounce off walls
        If Uloc_y + 60 > bottom_side Then
            Uloc_y = bottom_side - 60
            speedY *= -1
        ElseIf Uloc_y < 0 Then
            Uloc_y = 0
            speedY *= -1
        End If

        If Uloc_x + 40 > right_side Then
            Uloc_x = right_side - 40
            speedx *= -1
        ElseIf Uloc_x - 10 < 0 Then
            Uloc_x = 10
            speedx *= -1
        End If

        If Uloc_y2 + 60 > bottom_side Then
            Uloc_y2 = bottom_side - 60
            speedY2 *= -1
        ElseIf Uloc_y2 < 0 Then
            Uloc_y2 = 0
            speedY2 *= -1
        End If

        If Uloc_x2 + 40 > right_side Then
            Uloc_x2 = right_side - 40
            speedx2 *= -1
        ElseIf Uloc_x2 < 0 Then
            Uloc_x2 = 10
            speedx2 *= -1
        End If

        'to get Angles
        'opposite side , adjacent side
        op = p2.X - p1.X
        adj = p1.Y - p2.Y

        'in radians
        Angle = Math.Atan(op / adj)

        'in degrees
        Angle = Math.Ceiling(Angle / 2 / Math.PI * 360)

        If Angle < 0 Then
            Angle = Angle * -1
        Else
        End If


        If Uloc_y < Uloc_y2 And Uloc_x < Uloc_x2 Then
            total = CInt(90 - Angle)
            finalT = CInt(90 + total)
            Angle = finalT
        Else
            If Uloc_y < Uloc_y2 And Uloc_x > Uloc_x2 Then
                total = CInt(90 - Angle)
                finalT = CInt(270 - total)
                Angle = finalT
            Else
                If Uloc_y > Uloc_y2 And Uloc_x > Uloc_x2 Then
                    total = CInt(90 - Angle)
                    finalT = CInt(270 + total)
                    Angle = finalT
                Else
                End If
            End If
        End If


        'collision detection and response
        px = p1.X - p2.X
        py = p1.Y - p2.Y
        px *= -1
        py *= -1
        collision = CInt(60 * 60 > px * px + py * py)

        If delayer = 1 Then

            If collision < 0 Then
               
                veky = ((Uloc_y + 30) - (Uloc_y2 + 30)) / 2
                vekx = ((Uloc_x + 30) - (Uloc_x2 + 30)) / 2
                leng = CSng(Math.Sqrt(veky * veky + vekx * vekx))
                vekx /= LenG
                veky /= leng
                v1 = vekx * speedx + veky * speedY
                v2 = vekx * speedx2 + veky * speedY2
                u1 = (1 * v1 + 1 * v2 - 1 * (v1 - v2)) / (1 + 1)
                u2 = (1 * v1 + 1 * v2 - 1 * (v2 - v1)) / (1 + 1)
                speedx = CSng(speedx + ((u1 - v1) * vekx))
                speedY = CSng(speedY + ((u1 - v1) * veky))
                speedx2 = CSng(speedx2 + ((u2 - v2) * vekx))
                speedY2 = CSng(speedY2 + ((u2 - v2) * veky))

                If Uloc_x + 30 > getX Then
                    Uloc_x = getX
                Else
                    If Uloc_x + 30 < getX Then     
                        Uloc_x = getX
                    End If
                End If

                If Uloc_y + 30 > getY Then             
                    Uloc_y = getY
                Else
                    If Uloc_y + 30 < getY Then                 
                        Uloc_y = getY
                    End If
                End If

            End If
            delayer = delayer + 1
        Else

            delayer = 1

        End If



        OvalShape1.Left = getX - 6
        OvalShape1.Top = getY - 6


        Me.Refresh()

    End Sub



    Private Sub Circle1_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Circle1.Paint

        e.Graphics.TranslateTransform(Uloc_x, Uloc_y)
        e.Graphics.RotateTransform(CSng(Angle))

        e.Graphics.DrawEllipse(Pens.Red, -30, -30, 60, 60)
        e.Graphics.DrawLine(Pens.Blue, 0, -60, 0, 0)
        e.Graphics.ResetTransform()

        C1Label.Left = CInt(Uloc_x - 20)
        C1Label.Top = CInt(Uloc_y - 46)
        getY2 = CInt((Uloc_y) + (60 * Math.Cos(Angle * Math.PI / 180)))
        getX2 = CInt((Uloc_x) - (60 * Math.Sin(Angle * Math.PI / 180)))
    End Sub



    Private Sub Circle2_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Circle2.Paint

        e.Graphics.TranslateTransform(Uloc_x2, Uloc_y2)
        e.Graphics.RotateTransform(CSng(Angle))


        e.Graphics.DrawEllipse(Pens.Red, -30, -30, 60, 60)
        e.Graphics.DrawLine(Pens.Blue, p3, p4)
        e.Graphics.ResetTransform()

        'get endpoint of circle2's line
        'after collision, circle1 is sent to the endpoint to prevent overlap
        getY = CInt((Uloc_y2) + (60 * Math.Cos(Angle * Math.PI / 180)))
        getX = CInt((Uloc_x2) - (60 * Math.Sin(Angle * Math.PI / 180)))

        C2Label.Left = CInt(Uloc_x2 - 20)
        C2Label.Top = CInt(Uloc_y2 - 46)
        EPLabel.Left = getX - 25
        EPLabel.Top = getY - 20

    End Sub

End Class

---

Attached Images

 

Attached Files

• CircleCircleCollision.zip (52.9 KB)

[VB10] Class Code Creator

June 21, 2014, 11:06 pm

≫ Next: HTML to DataGridView DataSource

≪ Previous: VB.NET Circle-Circle collision bounce response working perfectly!

$

0

0

A very simple VB.net Class code generator.




v1.04
* Param type combo now ownerdrawn using VS keyword colors.
v1.03 & v1.02
* Minor changes/updates.
v1.01
* Added "Property" option (enabled by default).
* Updated color word lists to support a few more VB keywords.
* Changed the way input data is checked.

Attached Images

 

Attached Files

• Class Code Creator v1.00.zip (26.7 KB)
• Class Code Creator v1.04.zip (27.3 KB)

HTML to DataGridView DataSource

June 23, 2014, 4:52 am

≫ Next: WhatsRep - Current reputations - Reputation Power - Top Ten members: Just for fun

≪ Previous: [VB10] Class Code Creator

$

0

0

Hi Guys!

Here, is a quite simplified version of this.

Code:

---

Private Function HtmlTableToDgv(HtmlTable As HtmlElement) As DataTable
        Dim table As New DataTable
        Dim rows As HtmlElementCollection = HtmlTable.GetElementsByTagName("tr")
        Dim hExists As Boolean = False
        If rows(0).InnerHtml.ToUpper.Contains("<TH") Then
            Dim headers As HtmlElementCollection = rows(0).GetElementsByTagName("th")
            For Each header As HtmlElement In headers
                table.Columns.Add(header.InnerText, Type.GetType("System.String"))
            Next
            hExists = True
        Else
            Dim fColumns As HtmlElementCollection = rows(0).GetElementsByTagName("td")
            For Each fColumn As HtmlElement In fColumns
                table.Columns.Add(Nothing, Type.GetType("System.String"))
            Next
        End If
        For rNumber As Integer = 0 To (rows.Count + CInt(hExists)) - 1
            table.Rows.Add()
            Dim columns As HtmlElementCollection = rows(rNumber - CInt(hExists)).GetElementsByTagName("td")
            For cNumber As Integer = 0 To columns.Count - 1
                table.Rows(rNumber).Item(cNumber) = columns(cNumber).InnerText
            Next
        Next
        Return table
    End Function

---

There are two important things:
1) You have to pass the table as an HtmlElement, not as a String.
2) You can use the functon to get only DataGridView DataSource. It doesn't create the control's itself.

After you paste the function in your Class or else, you can use it like:

Code:

---

myDataGridView.DataSource = HtmlTableToDgv(myHtmlTable) 'As HtmlElement

---

---

Comments:

• It will work with simple tables. Not the ones with "colspan" or "rowspan" attributes because DataGridView doesn't allow merged cells.
• It will check column headers from HTML table headers so if there any, will be added to DataGridView's column headers.
• Default column DataType is set to String but can be set to any System type as what you need. Adding a counter should work. All you have to do is modify these lines:

Code:

---

                If rows(0).InnerHtml.ToUpper.Contains("<TH") Then
                    Dim headers As HtmlElementCollection = rows(0).GetElementsByTagName("th")
                    Dim hNumber As Integer = 0 'Add the counter
                    For Each header As HtmlElement In headers
                        Select Case hNumber 'Select the cases for column numbers
                            Case 0
                                table.Columns.Add(header.InnerText, Type.GetType("System.String"))
                            Case Else
                                table.Columns.Add(header.InnerText, Type.GetType("System.Double"))
                        End Select
                        hNumber += 1
                    Next
                    hExists = True
                Else
                    Dim fColumns As HtmlElementCollection = rows(0).GetElementsByTagName("td")
                    For Each fColumn As HtmlElement In fColumns
                        table.Columns.Add(Nothing, Type.GetType("System.String"))
                    Next
                End If

---

The example above will return HTML table's first column DataType as String and others as Double. This example applies column DataTypes only to HTML tables with headers. If you don't have column headers, you should do a similiar edit for the Else statement.

Enjoy :)

WhatsRep - Current reputations - Reputation Power - Top Ten members: Just for fun

June 29, 2014, 7:23 am

≫ Next: High Precision Timer

≪ Previous: HTML to DataGridView DataSource

$

0

0

This is my first windows 8.1 release. I wanted to let this go before i write it aimed at 4.5 this week. Simply obtains the top Ten reputable members along side your own points and power. Just for some fun.

Please post any bugs, would love to hear from Vista or 7 users. tested on 8.1 and XP. I will write this for 4.5 this week.





All exe removed. Project attached or alternatively use edited**

Attached Files

• WhatsReps.zip (164.2 KB)

---

High Precision Timer

July 10, 2014, 2:07 pm

≫ Next: No window title but title in taskbar solution I found

≪ Previous: WhatsRep - Current reputations - Reputation Power - Top Ten members: Just for fun

$

0

0

Below is a high precision timer that uses the QueryPerformance API's. I tried to structure it just like a normal timer would be so that it makes it easier to use.

My might you want to use this timer over normal timer? Well, in my case I needed a game loop that will be consistently executed. With the normal timer, any intervals around 15 - 20 milliseconds are no longer accurate and for a game loop you want an interval of 16.6 milliseconds(60 FPS).

Here is the code:

Code:

---

Option Strict On
Option Explicit On
<System.ComponentModel.DefaultEvent("Tick")> _
Public Class PrecisionTimer
    Inherits System.ComponentModel.Component

    Private frequency As Long
    Private waitThread As Threading.Thread

#Region "Api"

    Private Declare Function QueryPerformanceCounter Lib "kernel32" (ByRef lpPerformanceCount As Long) As Integer
    Private Declare Function QueryPerformanceFrequency Lib "kernel32" (ByRef lpFrequency As Long) As Integer

#End Region

#Region "Events"

    Public Event Tick(ByVal sender As Object, ByVal e As EventArgs)

#End Region

#Region "Methods"

    Private Sub CheckCompatibility()
        Dim test As Long
        If Not CBool(QueryPerformanceCounter(test)) Then
            Throw New Exception("High-resolution counter is not supported for this computer.")
        End If
    End Sub

    Public Sub Start()
        Me.Enabled = True
        waitThread = New Threading.Thread(AddressOf Wait)
        waitThread.IsBackground = True
        waitThread.Start()
    End Sub

    Public Sub [Stop]()
        Me.Enabled = False
    End Sub

    Private Sub Wait()
        Dim counter1, counter2 As Long
        QueryPerformanceCounter(counter1)

        If Me.LowerCpuUsage Then

            Do
                QueryPerformanceCounter(counter2)
                Threading.Thread.Sleep(2)
            Loop Until (counter2 - counter1) / (frequency / 1000) >= Me.Interval

        Else

            Do
                QueryPerformanceCounter(counter2)
            Loop Until (counter2 - counter1) / (frequency / 1000) >= Me.Interval

        End If

        Console.WriteLine((counter2 - counter1) / (frequency / 1000))

        RaiseEvent Tick(Me, EventArgs.Empty)

        If Me.AutoReset Then
            Me.Enabled = False
        ElseIf Me.Enabled Then
            waitThread = New Threading.Thread(AddressOf Wait)
            waitThread.Start()
        End If

    End Sub

#End Region

#Region "New Constructor"

    Sub New()
        Call CheckCompatibility()
        QueryPerformanceFrequency(frequency)
        Me.Interval = 100
    End Sub

    Sub New(ByVal interval As Double)
        Call CheckCompatibility()
        QueryPerformanceFrequency(frequency)
        Me.Interval = interval
    End Sub

#End Region

#Region "Properties"

    Public Property AutoReset As Boolean
    Private pEnabled As Boolean
    Public Property Enabled() As Boolean
        Get
            Return pEnabled
        End Get
        Set(ByVal value As Boolean)
            If pEnabled <> value Then
                pEnabled = value
                If pEnabled Then RaiseEvent Tick(Me, EventArgs.Empty)
            End If
        End Set
    End Property
    Public Property Interval As Double
    Public Property LowerCpuUsage As Boolean

#End Region

End Class

---

I'd like to thank Jacob Roman for introducing me to the QueryPerformance API's.

No window title but title in taskbar solution I found

July 13, 2014, 12:27 pm

≫ Next: Accessing Rows and Cells in a WPF DataGrid

≪ Previous: High Precision Timer

$

0

0

I hope this helps someone, because it helped me.

My prior first method was using the following:

• Set Form to "Fixed Dialog"
• Type a window title
• Add following code to form:

Code:

---

    Protected Overrides ReadOnly Property CreateParams() As CreateParams
        Get
            Dim cp As CreateParams = MyBase.CreateParams
            cp.Style = cp.Style And Not &HC00000 ' WS_CAPTION
            Return cp
        End Get
    End Property

---

However the problem with the above solution is that in the designer now, you have to move the form objects around OTHERWISE it shows up like a huge gap either above or below in the form (the form extends in the wrong direction) very ugly in the designer then (you start not seeing your objects or have to live with live form being sized differently). This probably after the fact that the titlebar disappears in runtime but shows up in in the designer.

Then I found this better, easier and cleaner solution:

Set form to FixedDialog, erase Window Title.

Import this:

Code:

---

    <Runtime.InteropServices.DllImport("user32.dll")>
    Public Function SetWindowText(ByVal hwnd As IntPtr, ByVal windowName As String) As Boolean
    End Function

---

Add in mybase.load the following for your form:

Code:

---

        SetWindowText(Me.Handle.ToInt32, "User Information")

---

Additionally you can add an icon too

Code:

---

        Me.Icon = My.Resources.favicon

---

Give it a try, very simple and does the job right without molesting the form output. You get a titlebarless window form that has a Taskbar/ALT+TAB title and an icon.

Accessing Rows and Cells in a WPF DataGrid

July 22, 2014, 6:08 am

≫ Next: Integer Number to Words

≪ Previous: No window title but title in taskbar solution I found

$

0

0

Hi,

Most of the examples out there on how to access a WPF Row and Cell are in C#.

So, here's a VB.NET version of those extension methods defined in a Module and it's implementations are created in MainWindow.xaml.

Sample Extension Method to Select Rows Based on Index.

Code:

---

    ''' <summary>
    ''' Set selection based on indexes
    ''' </summary>
    <Extension()>
    Public Sub SelectDataGridRowByIndexes(dataGrid As DataGrid, ByVal ParamArray rowIndexes As Integer())
        If Not dataGrid.SelectionUnit.Equals(DataGridSelectionUnit.FullRow) Then
            Throw New ArgumentException("Change selection unit of the DataGrid to FullRow.")
        End If
        If Not dataGrid.SelectionMode.Equals(DataGridSelectionMode.Extended) Then
            Throw New ArgumentException("Change selectionMode of the DataGrid to Extended.")
        End If
        If rowIndexes.Length.Equals(0) OrElse rowIndexes.Length > dataGrid.Items.Count Then
            Throw New ArgumentException("Invalid number of indexes.")
        End If
        dataGrid.SelectedItems.Clear()
        dataGrid.UpdateLayout()

        For Each rowIndex As Integer In rowIndexes
       
            If rowIndex < 0 OrElse rowIndex > (dataGrid.Items.Count - 1) Then
                Throw New ArgumentException(String.Format("{0} is an invalid row index.", rowIndex))
            End If
            Dim item As Object = dataGrid.Items(rowIndex)
            Try
                dataGrid.SelectedItems.Add(item)
            Catch ex As Exception
            End Try
            Dim row As DataGridRow = TryCast(dataGrid.ItemContainerGenerator.ContainerFromIndex(rowIndex), DataGridRow)
            If row Is Nothing Then
                dataGrid.ScrollIntoView(item)
                row = TryCast(dataGrid.ItemContainerGenerator.ContainerFromIndex(rowIndex), DataGridRow)
            End If
            If row IsNot Nothing Then
                Dim cell As DataGridCell = GetCell(dataGrid, row, 0)
                If cell IsNot Nothing Then
                    cell.Focus()
                End If
            End If
        Next
    End Sub

---

Sample Implementation of Selecting Rows based on index.

VB.NET Code:

''' <summary>
''' Highlight or Select Rows based on indexes
''' </summary>
''' <remarks></remarks>
Private Sub SelectRowsBasedOnIndexes()
       BindUsingList()
       grid1.SelectDataGridRowByIndexes(0, 1, 3)
End Sub

See attachment for other defined extension methods:

Software Used: VS 2012

KGC

Attached Files

• WPFDataGridExtension.zip (21.8 KB)

Integer Number to Words

August 2, 2014, 11:13 am

≫ Next: VB2010 Rubberbanded Lines

≪ Previous: Accessing Rows and Cells in a WPF DataGrid

$

0

0

Converts integers > Integer.MinValue to words. The code uses recursion FWIW.

Code:

---

Public Class NumberToWords

    ''' <summary>
    ''' Convert any Integer (except Integer.MinValue) to words
    ''' </summary>
    ''' <param name="someNum">the number to be converted</param>
    ''' <param name="negativePrefix">the prefix to use if the number is negative</param>
    ''' <returns>string representation of number</returns>
    ''' <remarks>won't convert Integer.MinValue</remarks>
    Public Shared Function Convert(someNum As Integer, Optional negativePrefix As String = "negative") As String
        'convert using NumToString
        Return NumToString(someNum, 0, negativePrefix)
    End Function

    Private Shared Function NumToString(num As Integer, level As Integer, Optional negativeprfx As String = "") As String
        'on entry level represents the recursive depth
        'Debug.Write(level & " ")

        Dim rv As New System.Text.StringBuilder
        Dim workingNum As Integer = num 'working number

        Const appender As String = ", "
        'Const appender As String = " "

        'for this to work the number must be positive
        'and greater than Integer.MinValue
        If workingNum = Integer.MinValue Then
            Throw New ArgumentException("Can't convert Integer.MinValue")
        End If
        'the negative, if any is
        'fixed at the end
        Dim isNeg As Boolean = False
        If workingNum < 0 Then
            isNeg = True
            'workingNum = -workingNum 'convert to positive if needed
            'or
            'old school
            'reverse the bits and add one
            workingNum = workingNum Xor &HFFFFFFFF
            workingNum += 1
        End If

        'is the number known?
        rv.Append(Defined(workingNum))
        If rv.Length = 0 Then 'known?
            'no
            'the groups
            Dim ones As Integer = 0
            Dim tens As Integer = 0
            Dim hundreds As Integer = 0
            Dim thousands As Integer = 0
            Dim millions As Integer = 0
            Dim billions As Integer = 0

            'get count of each grouping
            'decreasing workingNum by the grouping total

            'only during the first call to this method
            'can the number be > 999
            If level = 0 Then
                billions = workingNum \ NumWords.billion
                workingNum -= billions * NumWords.billion

                millions = workingNum \ NumWords.million
                workingNum -= millions * NumWords.million

                thousands = workingNum \ NumWords.thousand
                workingNum -= thousands * NumWords.thousand
            End If

            hundreds = workingNum \ NumWords.hundred
            workingNum -= hundreds * NumWords.hundred

            'special case for tens
            'if the number is less than 20
            'don't bother dividing by ten
            'because all numbers less than 20 are defined
            'note: 20 is known but should be treated as a ten

            If workingNum > 19 Then
                tens = workingNum \ NumWords.ten
                workingNum -= tens * NumWords.ten
            End If

            ones = workingNum 'what is left

            'now check each group
            'and recursively call iCvtNum
            'on the groups amount
            If level = 0 Then
                If billions > 0 Then
                    rv.Append(NumToString(billions, level + 1))
                    rv.Append(" ")
                    rv.Append(NumWords.billion.ToString)
                    rv.Append(appender)
                End If

                If millions > 0 Then
                    rv.Append(NumToString(millions, level + 1))
                    rv.Append(" ")
                    rv.Append(NumWords.million.ToString)
                    rv.Append(appender)
                End If

                If thousands > 0 Then
                    rv.Append(NumToString(thousands, level + 1))
                    rv.Append(" ")
                    rv.Append(NumWords.thousand.ToString)
                    rv.Append(appender)
                End If
            End If

            If hundreds > 0 Then
                rv.Append(NumToString(hundreds, level + 1))
                rv.Append(" ")
                rv.Append(NumWords.hundred.ToString)
                rv.Append(" ")
            End If

            If tens > 0 Then
                'the tens (10, 20, 30 ...) are defined
                rv.Append(NumToString(tens * NumWords.ten, level + 1)) ' times ten to get the defined number string
                rv.Append("-") 'for hyphens on the 'entys 20, 30, 40, etc
                'rv.Append(" ") 'no hyphens on the 'entys
            End If

            If ones > 0 Then
                rv.Append(NumToString(ones, level + 1))
                rv.Append(" ")
            End If
        End If

        'known numbers come directly here

        'was the number negative?
        If isNeg Then
            rv.Insert(0, " ")
            rv.Insert(0, negativeprfx)
        End If
        'get rid of trailing spaces and hyphens, if any
        Return rv.ToString.Trim(appender.ToCharArray).Trim("-"c)
    End Function

    Private Shared Function Defined(num As Integer) As String
        'is the number defined and less than 100
        If [Enum].IsDefined(GetType(NumWords), num) AndAlso num < 100 Then
            'yes
            Return [Enum].GetName(GetType(NumWords), num)
        Else
            'no
            Return ""
        End If
    End Function

    Enum NumWords
        zero = 0
        one = 1
        two = 2
        three = 3
        four = 4
        five = 5
        six = 6
        seven = 7
        eight = 8
        nine = 9
        ten = 10
        eleven = 11
        twelve = 12
        thirteen = 13
        fourteen = 14
        fifteen = 15
        sixteen = 16
        seventeen = 17
        eightteen = 18
        nineteen = 19
        twenty = 20
        thirty = 30
        forty = 40
        fifty = 50
        sixty = 60
        seventy = 70
        eighty = 80
        ninety = 90
        hundred = 100
        thousand = 1000
        million = 1000000
        billion = 1000000000
    End Enum
End Class

---

VB2010 Rubberbanded Lines

August 4, 2014, 7:42 am

≫ Next: [THEME] Unique Theme GDI+ 14 Controls VB.Net

≪ Previous: Integer Number to Words

$

0

0

The code that follows demonstrates the drawing of rubberbanded lines in VB2010. Tested with Windows 7.
The form setup consists of the form with a PictureBox within it. (The form code is not included, so that you will have make that yourself),

Code:

---

' a rubberbanded line(s) may be drawn in a PictureBox.  July 2014

Public Class Form1
    Dim ori As Point
    Dim lastori As Point
    Dim mousedwn, firstdown As Boolean 

    Private Sub PictureBox1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) _
        Handles PictureBox1.MouseDown
        mousedwn = True
        firstdown = True
        ori.X = e.X  'origin of line
        ori.Y = e.Y
    End Sub

    Private Sub PictureBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) _
        Handles PictureBox1.MouseMove
        If mousedwn Then
            If Not firstdown Then 'remove last line
                ControlPaint.DrawReversibleLine(PictureBox1.PointToScreen(ori), _
                                        PictureBox1.PointToScreen(lastori), SystemColors.Control)
            End If
            ControlPaint.DrawReversibleLine(PictureBox1.PointToScreen(ori), _
                                        PictureBox1.PointToScreen(New Point(e.X, e.Y)), SystemColors.Control)
            lastori.X = e.X
            lastori.Y = e.Y
            firstdown = False
        End If
    End Sub

    Private Sub PictureBox1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) _
        Handles PictureBox1.MouseUp
        mousedwn = False
        ' uncomment these lines to enable a single line at a time with length and angle
        ' Dim endpt As Point
        ' endpt.X = e.X
        'endpt.Y = e.Y
        'Dim len As Integer
        'len = Math.Sqrt((endpt.X - start.X) ^ 2 + (endpt.Y - start.Y) ^ 2) 'compute len of tape
        'Dim angle As Integer = Math.Asin((start.Y - endpt.Y) / len) * 57.2958  'test line only
        'MessageBox.Show("length of tape= " & CStr(len) & " angle is " & CStr(angle), "Measuring tape")
        ''remove line
        'ControlPaint.DrawReversibleLine(PictureBox1.PointToScreen(start), _
        '                                PictureBox1.PointToScreen(endpt), SystemColors.Control)
    End Sub
End Class


---

The program will let you draw any number of lines or a single line with length and angle info. See MouseUp event to change behavior.
Good luck.