Read: C# Tools for Code Quality

As an example, let’s say you have created a .NET website project in C# and also want to include another source code file that is written in Visual Basic (VB) into the same project. In this scenario, adding the two distinct source code files into the App_Code folder would not work. In order to make your ASP.Net website work based off more than one language, one solution would be, if the source-code file is small, a developer could convert the VB code into C# code on their own, or use any automated code converter to perform the same action.

However, if that source-code file is larger, or you want to use multiple programming languages for some reason (for example, if one language had features another did not natively have), then converting code from one programming language to another would be very time-consuming and an ineffective task.

Fortunately, there are other methods programmers can use to achieve this goal. We will start by creating a website from scratch, then move on to creating language-specific classes, make some changes in the website configuration, and, finally, test the functionality of our website.

How to Create an ASP.NET Website

To begin, let’s create the framework for our website using the Visual Studio integrated development environment (IDE). Follow the steps below:

• Launch the Visual Studio IDE and create a new project by clicking on Create a new project.
• Select ASP.NET Web Application (.NET Framework). Choose the programming language C# from the language dropdown option and click Next.

• On the next screen, configure your website project name and directory and then click Next.
• Now you should see your website project template has been created by Visual Studio.

Since you are working out of Visual Studio, you may want to check out the features of the new .NET Coding Pack, to add even more features to your code editor.

Creating language-specific Classes in .Net

In this part of the process, we will create two class files in two different languages: C# and Visual Basic. Following are the steps required to create two distinct classes in the App_Code folder:

• In the Solution Explorer, create two separate folders for each of the programming languages.
• In this tutorial, we are going to create two subfolders called CS and VB, and add two source code files named ClassCS.cs and ClassVB.vb into them.
• Add the following source code into the ClassCS.cs file by overwriting the existing source code:

public class ClassCS 
{ 
   public string Message; 
   public string GetMessage() 
   { 
      return this.Message; 
   } 
}

Next, add the following source-code into the ClassVB.vb file by overwriting the existing source-code:

Public Class ClassVB
 
    Public Message As String
 
    Public Function GetMessage() As String
        Return Me.Message
    End Function
 
End Class

Now you are ready to move onto the next step, which is modifying the configuration of our newly created ASP.Net website.

Modifying Website Configuration in ASP.Net

After creating the two separate files for two different programming languages in steps above, the next step is to change the website configuration so that ASP.NET can compile the two distinct folders separately. To change the configuration, follow the below steps:

• Open the web.config file and locate the section in the file.
• Add the section, as written below, inside the section.

Testing the Functionality of .NET Classes

After the website is configured successfully, let us now test if .NET can compile our two distinct source code files. To check if everything is working well, take the following steps:

• Create a Default.aspx page in your project folder.
• Create a label and two button controls on the Default.aspx page.
• On the click-event of the first button, we want to call the function written in ClassCS. Similarly, on the click-event of the second button, we want to call the function written in ClassVB. The code should look as follows:

protected void Button1_Click(object sender, EventArgs event)
{
   ClassCS obj = new ClassCS();
   obj.Message = "C# Function is called!";
   Label2.Text = obj.GetMessage();
}
 
protected void Button2_Click(object sender, EventArgs event)
{
   ClassVB obj = new ClassVB();
   obj.Message = "VB Function is called!";
   Label2.Text = obj.GetMessage();
}

• Next, in the Solution Explorer, right-click the Default.aspx page and select Set as Start Page and run the website project.
• In the last step, we want to test our classes. Call the function of a specific class on the click of the corresponding button. For instance, if you click on the second button, you should see the message: ‘VB Function is called!’

Final Thoughts on ASP.Net Muti-langage Web Pages

Using multiple programming languages in ASP.NET is useful in situations where developers and programmers are working independently and they may be using different languages, according to their preferences to support multiple development teams. We hope you have now learned how to support multiple programming languages while building ASP.NET web projects.

Read more ASP.NET software development and programming tutorials.

The post Using Multiple Programming Languages to Create an ASP.NET Website appeared first on CodeGuru.

VB Features in VS Studio

Below are some the new features tailored towards Visual Basic developers in the new update to the Visual Studio integrated development environment (IDE).

VS Studio Editor Font Cascadia

Visual Studio 2022 includes a new editor font named <b>Cascadia</b>. <b>Cascadia</b> includes two variants: <b>Mono</b> and <b>Code</b>. <b>Mono</b> would give you the standardized look, whereas <b>Code</b> includes some hidden gems.

Take this Visual Basic code segment for example:

Imports System

Module Program

    Sub Main(args As String())

        Dim Age As String = 43

        If Age >= 40 AndAlso Age <= 50 Then

            Console.WriteLine("Age between 40 and 50")

        End If

    End Sub

End Module

If you run this code in VS Studio 2022, you will notice that it is easily legible and is quite easy on the eyes. However, compare it by running the same code but use the <b>Cascadia</b> font instead (following the instructions provided below).

Notice the ligatures in particular (this expresses two or more characters as a single unit). To change editor fonts, follow these steps:

• Click Tools
• Choose Options
• In the left pane, select Fonts and Colors
• Navigate to Cascadia Code
• Click OK to change the font

Read: Introduction to Blockchain Programming in Visual Basic

Inheritance Margin

The Inheritance margin</i adds icons to the left margin and shows where inheritance has taken place (.i.e., it shows where the code is derived from). To see this in action, add the following code inside a Visual Basic class:

Imports Microsoft.VisualBasic

Public Class Class1
    Public Overridable Sub Function1()

    End Sub

End Class

Public Class Class2
    Inherits Class1

    Public Overrides Sub Function1()
        MyBase.Function1()
    End Sub

End Class

You will notice four blue squares on the left margin:

These indicators show where each class and function are derived from. To enable the Inheritance margin, follow these steps:

• Click Tools
• Choose Options
• Expand Text Editor
• Expand Basic
• Select Advanced
• Select Show inheritance margin
• Click OK

Subword Navigation

As .NET developers may know, most text editors allow you to navigate word by word. In Visual Studio, programmers could use Ctrl + Left or Ctrl + Right to navigate between words. Visual Studio 2022, however, includes subword navigation with which you can navigate through various parts of a word by using Ctrl + Alt + Left or Ctrl + Alt + Right. Attempt it with a variable name such as intMyAge or strMyName. As long as a word is comprised of a combination of words, this works perfectly.

Read: Making a Small Lotto Game in VB.NET

Preprocessor Symbols

Visual Studio 2022 now provides IntelliSense for Preprocessor Directives / Symbols.

Visual Studio 2022 Allows Developer to Paste Code

In older versions of Visual Studio, when you pasted code into the editor, you would have to manually include the appropriate imports. Visual Studio 2022 allows you to paste code into the editor and it will add the necessary imports automatically. Consider the Visual Basic code below:

        Dim Age As String = 43

        If Age >= 40 AndAlso Age <= 50 Then

            Console.WriteLine("Age between 40 and 50")

        End If

If we were to paste this inside a Main method, the System import would be included automatically, and it would look like:

Imports System

Module Program

    Sub Main(args As String())

        Dim Age As String = 43

        If Age >= 40 AndAlso Age <= 50 Then

            Console.WriteLine("Age between 40 and 50")

        End If

    End Sub

End Module

Reassigned Variables in VB

The new underline reassigned feature is helpful when you want to know if a variable has been reassigned or not. Here is a small example:

    Sub Main(args As String())

        Dim Age As String = 43

        If Age >= 40 AndAlso Age <= 50 Then

            Console.WriteLine("Age between 40 and 50")

            Age = 50

        End If


    End Sub

In the above example, the variable Age is underlined. This is because it’s value has changed from 43 to 50. To enable this feature, follow these steps:

• Click Tools
• Click Options
• Expand Text Editor
• Expand Basic
• Click Advanced
• Click Underline reassigned variables
• Choose OK

Read more Visual Basic and VB.NET programming tutorials with code examples.

Inline Parameter Changes

Inline parameter name hints display small indicators for parameter names. Here is an example of that in action:

In the above example, notice the ‘value:’ parameter in the WriteLine method of the Console object. This is quite handy because it will help – especially new developers – get to know the ins and outs of .NET

To enable this feature, follow these steps:

• Click Tools
• Click Options
• Expand Text Editor
• Expand Basic
• Click Advanced
• Select Display inline parameter name hints
• Choose OK

If you haven’t downloaded Visual Studio 2022, you can do so here. For more information on .NET 6, have a look here.

Read more .NET programming tutorials.

The post Visual Basic Features in Visual Studio 2022 appeared first on CodeGuru.

As you may or may not know: strings are strange creatures! I say so because there are so many ways to do a certain task. It is, however, up to us (as developers) to determine the correct way to achieve our goals.

In this article, I will show you different ways to change each letter of a word in a sentence to upper case. This is known as Title Case or Proper Case. Now, there are various quick ways to do this, but to figure out which method is the best is what you should be looking for.

Let’s create a quick example project.

Create a new Visual Basic Windows Forms application. On the Form, add four buttons and one TextBox. Do not worry too much about the names for the objects; this example makes use of the default names.

The Code

Add the following code behind Button1:

   Private Sub Button1_Click(sender As Object, e As EventArgs) _
         Handles Button1.Click

      Dim strInput() As String

      strInput = TextBox1.Text.Split(" "c)

      For i As Integer = 0 To strInput.Rank + 1

         strInput(i) = (strInput(i).Substring(0, 1).ToUpper & _
            strInput(i).Substring(1, strInput(i).Length - 1))
      Next

      Dim strOutput As String = String.Empty

      For j As Integer = 0 To strInput.Rank + 1

         If j = 0 Then

            strOutput = (strInput(j))

         Else

            strOutput = (strOutput & " " & strInput(j))

         End If

      Next

      TextBox1.Text = strOutput

   End Sub

This code tries to emulate some string functions by looping through each character and attempting to change it to an uppercase letter.

I have made use of the following text inside the TextBox to see if this code would work in a real-world situation:

ThIS iS really REALLY a SiMpLe test for YOU to SeE

Make sure to copy this text. You will be using it with the other buttons as well.

The result after clicking Button1 is shown in Figure 1:

Figure 1: Button 1

As you can see, the code behind Button1 fails to change all the words to proper case and it cuts off some text. This is not what we want! If all the words were completely in lower case, the code would have worked. So, let’s move on to Button2.

   Private Sub Button2_Click(sender As Object, e As EventArgs) _
         Handles Button2.Click

      Dim strInputOutput As String

      strInputOutput = TextBox1.Text

      strInputOutput = Globalization.CultureInfo.CurrentCulture _
         .TextInfo.ToTitleCase(strInputOutput)

      TextBox1.Text = strInputOutput

   End Sub

Here, you make use of the CultureInfo object to help set the case for the words. The result after clicking Button2 is shown in Figure 2:

Figure 2: Button 2

This looks somewhat better. If you look closely though, you will notice that the words that are entirely in Upper case have not been changed… Let’s hope Button3 works better!

   Private Sub Button3_Click(sender As Object, e As EventArgs) _
         Handles Button3.Click

      Dim strInput As String = TextBox1.Text

      Dim strOutput As String = StrConv(strInput, _
         VbStrConv.ProperCase)

      TextBox1.Text = strOutput

   End Sub

Here, the old VB6 function StrConv is used to attempt to convert the words to proper case, let’s look at Figure 3 to see if it worked:

Figure 3: Button 3

Perfect! Now, what is wrong then? Well, the StrConv function is an old Visual Basic 6 function. VB6 has not been around for a long time and it will basically be frowned upon to still use it, so technically, it is not what is actually needed. Finally, add the code for Button4.

   Function ChangeToProperCase(ByVal strInput As String) As String

      Dim strOutput As String = ""

      strInput = strInput.ToLower
      strOutput = Globalization.CultureInfo.CurrentCulture _
         .TextInfo.ToTitleCase(strInput)

      Return strOutput

   End Function

   Private Sub Button4_Click(sender As Object, e As EventArgs) _
         Handles Button4.Click

      Dim strInputOutput As String = TextBox1.Text

      strInputOutput = strInputOutput.ToProperCase()

      TextBox1.Text = strInputOutput

   End Sub

Add a Module with the following code:

Module ExtensionMethods

   <System.Runtime.CompilerServices.Extension()>
   Function ToProperCase(ByVal strInput As String) As String

      Dim strOutput As System.Globalization.TextInfo

      strOutput = New System.Globalization.CultureInfo("en-US", _
         False).TextInfo

      strInput = strInput.ToLower
      strInput = strOutput.ToTitleCase(strInput)

      Return strInput

   End Function

End Module

Perhaps it’s a bit too overly complicated? No. If you need a solution, albeit a basic one such as changing letters to Proper Case, it must be working properly and in this case it should be able to compensate for lower, upper, and mixed case words.

An Extension method is created that first converts the words to lowercase, then to Proper Case, then a Function calls this Extension method which then gets called in Button4 (see Figure 4).

Figure 4: Button 4

Conclusion

As always, there are many different ways to achieve a goal. The question, however, is determining which method is more appropriate for your current situation and which method gives the most functionality. I hope I have answered these questions. Until next time, happy coding!

The post Playing with Strings: Proper Case appeared first on CodeGuru.

If you are one of the many unlucky ones who has never won anything in a lottery, well, this article is for you. Because I didn’t win the lottery so that I could live a more comfortable life without stress and being tired all the time because of the three jobs I do, I decided to see if I can create a basic lottery type game. At least I can always win with my game, and it is free to play…

Let’s get right into it; there is actually quite a lot of work.

Design

Open Visual Studio and create a new Visual Basic.NET Windows Forms project. Add panels, timers, and buttons to your form so that it resembles Figure 1.

Figure 1: Design

Let’s move on to the code.

The Code

Add a new Class and name it clsShuffle, then add the next code in it.

Public Class clsShuffle

   Const intSize As Integer = 20
   Public intMin As Integer
   Public intMax As Integer

   Private dbSize(intSize - 1) As Double
   Private intThird As Integer
   Private intHalf As Integer

   Public dbRand As Double
   Public intRand As Integer

   Public Sub Shuffle(ByVal dbVal As Double)

      Dim stVal As String
      Dim i As Integer

      Take()

      stVal = Str$(dbVal)

      For i = 1 To Len(stVal)

         Mix(1 / Asc(Mid$(stVal, i, 1)))

      Next

      Randomize(Rnd(dbSize(intThird) * Math.Sign(dbVal)))

      For i = 1 To intSize * 2.5

         Mix(Rnd())

      Next

   End Sub

   Public ReadOnly Property RandomDouble() As Double

      Get

         intThird = (intThird + 1) Mod intSize
         intHalf = (intHalf + 1) Mod intSize

         dbSize(intThird) += dbSize(intThird) + Rnd()
         dbSize(intThird) = dbSize(intThird) - _
            Int(dbSize(intThird))

         dbRand = dbSize(intThird)

         Return dbRand

      End Get

   End Property


   Public ReadOnly Property RandomInt() As Integer

      Get

         intRand = Int(RandomDouble() * intMax - intMin + 1) + _
            intMin

         Return intRand

      End Get

   End Property

   Private Sub Take()

      Dim i As Integer

      For i = 1 To intSize - 1

         dbSize(i) = 1 / i

      Next

      intThird = intSize / 2
      intHalf = intSize / 3

      If intThird = intHalf Then

         intThird = intThird + 1

      End If

   End Sub

   Private Sub Mix(ByVal dbVal As Double)

      intThird = (intThird + 1) Mod intSize
      intHalf = (intHalf + 1) Mod intSize

      dbSize(intThird) += dbSize(intThird) + dbVal
      dbSize(intThird) = dbSize(intThird) - Int(dbSize(intThird))

   End Sub

End Class

On the form, add the following variables:

   Const iMax As Integer = 56
   Const iPowerMax As Integer = 46

   Private blnShow As Boolean = False

   Dim Balls(50)
   Dim PowerBalls(40)

   Dim cShuffleBalls As New clsShuffle
   Dim cShufflePowerBalls As New clsShuffle

   Dim intPowerBall As Integer

Add the Form Load event that starts the application:

   Private Sub frmLotto_Load(sender As Object, e As _
         System.EventArgs) Handles Me.Load

      Randomize()

      cShuffleBalls.Shuffle(Rnd)
      cShufflePowerBalls.Shuffle(Rnd)

      cShuffleBalls.intMin = 1
      cShuffleBalls.intMax = iMax

      cShufflePowerBalls.intMin = 1
      cShufflePowerBalls.intMax = iPowerMax

      tmrBalls.Start()

   End Sub

This sets all the default properties. Add the Timer Tick events for both Timers.

   Private Sub tmrBalls_Tick(sender As Object, e As _
         System.EventArgs) Handles tmrBalls.Tick

      blnShow = True
      pnlDrum.Invalidate()

   End Sub
   Private Sub tmrPower_Tick(sender As Object, e As _
         System.EventArgs) Handles tmrPower.Tick

      blnShow = True
      pnlPowerDrum.Invalidate()

   End Sub

This determines if the normal balls’ panel should show or only the Powerball’s panel. Add the code for the buttons:

   Private Sub btnNext_Click(sender As Object, e As _
         System.EventArgs) Handles btnNext.Click

      If btnNext.Text = "Play again" Then

         btnNext.Text = "Next Ball"
         tmrBalls.Start()

      End If

      Dim i As Integer

      i = Balls(0)

      If i = 5 Then

         For i = 0 To 5

            Balls(i) = 0

         Next

         Exit Sub

      End If

      NextBall(Balls)

      If Balls(0) = 5 Then

         btnNext.Text = "Play again"
         tmrBalls.Stop()
         pnlDrum.Hide()

         pnlPowerDrum.Show()
         tmrPower.Start()

      End If

   End Sub
   Private Sub btnClearAll_Click(sender As System.Object, e As _
         System.EventArgs) Handles btnClear.Click

      ClearBalls()

   End Sub
   Private Sub btnPowerBall_Click(sender As Object, e As _
         System.EventArgs) Handles btnPowerBall.Click

      NextPowerBall(PowerBalls)

      tmrBalls.Stop()
      pnlDrum.Show()
      pnlPowerDrum.Hide()
      tmrPower.Stop()


   End Sub

The Next Ball button picks another ball. The Powerball button picks the Powerball. The Clear button clears all the drawings from all the panels.

Add the ball picking sub procedures:

   Private Sub NextBall(ByVal tmpArray())

      Dim i As Integer
      Dim j As Integer = 0

      tmpArray(0) = tmpArray(0) + 1
      i = tmpArray(0)

      Do

         tmpArray(i) = cShuffleBalls.RandomInt

         Display(tmpArray(i))

         If i > 1 Then

            For j = 1 To (i - 1)

               If tmpArray(i) = tmpArray(j) Then

                  tmpArray(i) = 0

               End If

            Next

         End If

      Loop Until tmpArray(i)

   End Sub

   Private Sub NextPowerBall(ByVal arrTemp())

      Dim i As Integer
      Dim j As Integer = 0

      arrTemp(0) = arrTemp(0) + 1
      i = arrTemp(0)

      Do

         arrTemp(i) = cShuffleBalls.RandomInt

         DisplayPowerBall(arrTemp(i))

         If i > 1 Then

            For j = 1 To (i - 1)

               If arrTemp(i) = arrTemp(j) Then

                  arrTemp(i) = 0

               End If

            Next

         End If

      Loop Until arrTemp(i)

   End Sub

   Private Sub DisplayPowerBall(ByVal intVal As Integer)

      intPowerBall = intVal

      Select Case intPowerBall

         Case 1 To 40

            blnShow = True
            pnlPowerBall.Invalidate()

      End Select

   End Sub

The sub procedures randomize the next ball number with the help of the Shuffle class and picks a ball to display. This is where things get interesting. We need to display the balls somewhere. Now, because we have so many panels, it will be extremely difficult to post all the code here, that is why I have put it on GitHub here.

Let’s add the panels for the shuffling of the balls, as well as the panel for displaying some of the balls.

   Private Sub pnlTumble_Paint(sender As Object, e As _
         System.Windows.Forms.PaintEventArgs) Handles pnlDrum.Paint

      Dim i As Integer = 0
      Dim intX As Integer
      Dim intY As Integer

      Dim rRand As New Random
      Dim rctDraw As New Rectangle

      For i = 1 To 50

         intX = rRand.Next(1, 300)
         intY = rRand.Next(1, 400)

         rctDraw.Height = 50
         rctDraw.Width = 50

         rctDraw.Location = New Point(intX, intY)

         e.Graphics.FillEllipse(Brushes.White, rctDraw.X, _
            rctDraw.Y, 50, 50)

         Dim fDraw As Font = New Font("Arial", 10, FontStyle.Bold)

         Dim StringSize As SizeF = _
            e.Graphics.MeasureString(i.ToString(), fDraw)

         e.Graphics.DrawString(i.ToString(), fDraw, Brushes.Black, _
            (rctDraw.Left + 25) - (StringSize.Width / 2), _
            (rctDraw.Top + 25) - (StringSize.Height / 2))

      Next

      e.Graphics.Clear(Color.Black)
      e.Graphics.Dispose()

   End Sub

   Private Sub pnlPowerDrum_Paint(sender As Object, e As _
         System.Windows.Forms.PaintEventArgs) Handles _
         pnlPowerDrum.Paint

      Dim i As Integer = 0
      Dim xPos As Integer
      Dim yPos As Integer
      Dim rr As New Random
      Dim rect As New Rectangle

      For i = 1 To 40
         xPos = rr.Next(1, 300)
         yPos = rr.Next(1, 400)

         rect.Height = 50
         rect.Width = 50
         rect.Location = New Point(xPos, yPos)

         e.Graphics.FillEllipse(Brushes.Yellow, rect.X, rect.Y, _
            50, 50)

         Dim f As Font = New Font("Arial", 12, FontStyle.Bold)
         Dim StringSize As SizeF = _
            e.Graphics.MeasureString(i.ToString(), f)

         e.Graphics.DrawString(i.ToString(), f, Brushes.Black, _
            (rect.Left + 25) - (StringSize.Width / 2), _
            (rect.Top + 25) - (StringSize.Height / 2))
      Next
      e.Graphics.Clear(Color.Black)
      e.Graphics.Dispose()
   End Sub

Private Sub pnlPowerBall_Paint(sender As Object, e As _
         System.Windows.Forms.PaintEventArgs) Handles _
         pnlPowerBall.Paint

      If blnShow Then

         Dim rect As New Rectangle
         rect.Height = 93
         rect.Width = 93
         rect.Location = New Point(0, 0)

         e.Graphics.FillEllipse(Brushes.Yellow, rect.X, rect.Y, _
            93, 93)
         Dim strPowerBall As String = "Power Ball"
         Dim t As String = intPowerBall.ToString
         Dim f As Font = New Font("Arial", 16, FontStyle.Bold)
         Dim StringSize As SizeF = e.Graphics.MeasureString(t, f)
         e.Graphics.DrawString(t, f, Brushes.Black, _
            (rect.Width / 2) - (StringSize.Width / 2), _
            (rect.Height / 2) - (StringSize.Height / 2))

         Dim fmb As Font = New Font("Arial", 10, FontStyle.Bold)

         Dim mbStringSize As SizeF = _
            e.Graphics.MeasureString(strPowerBall, fmb)

         e.Graphics.DrawString(strPowerBall, fmb, Brushes.Black, _
            (rect.Left + 47) - (mbStringSize.Width / 2), _
            (rect.Top + 18) - (mbStringSize.Height / 2))

         e.Graphics.Dispose()

      End If

   End Sub

This shuffles all the balls and displays the power ball.

The logic to clear all the balls as well as paint each ball is present in the project on GitHub, here.

Conclusion

I hope you have enjoyed this article. Yes, it was a lot of work and it could have been done much better with much less code, but this enables newbies to also follow the logic properly.

The post Making a Small Lotto Game in VB.NET appeared first on CodeGuru.

If you have been following this series from the start, you will know that we have done a lot of work, more than I also expected, but it is most certainly going to be worth it. This part, the last part of this series, will add the usercontrol to the form and make it work from there.

If you haven’t followed the instructions set out in the first two parts of this series, please do so now. You can find the previous installments, “Creating a Maze Game in .NET, Part 1: Structure” and “Creating a Maze Game in .NET, Part 2: Adding Gameplay,” at these locations. If you are up to date with the series, well, let’s get cracking!

Add the following fields to your code:

C#

   Random intRand = new Random();
   List<Point> lstSol = new List<Point>();

   clsGame cGame = new clsGame();

VB.NET

   Dim intRand As New Random
   Dim lstSol As New List(Of Point)

   Dim cGame As New clsGame

We create a new Random object, a list object to hold the solution, and a new game object. Add the Load and Paint events:

C#

   private void Form1_Load(object sender, EventArgs e)
   {
      cboSize.SelectedIndex = 0;
   }

   private void Form1_Paint(object sender, PaintEventArgs e)
   {
      e.Graphics.DrawRectangle(Pens.Black, Maze1.Bounds);

   }

VB.NET

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

      cboSize.SelectedIndex = 0

   End Sub

   Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) _
         Handles Me.Paint

      e.Graphics.DrawRectangle(Pens.Black, Maze1.Bounds)

   End Sub

Nothing serious here. The combobox defaults to the first item in the list (which is Beginner) and the outer bounds for the game get drawn according to the Maze object’s size.

Add the SelectedIndexChanged event for the ComboBox.

C#

   private void cboSize_SelectedIndexChanged(object sender,
      EventArgs e)
   {
      int sel = cboSize.SelectedIndex;

      if (sel == -1)
         return;
      Maze1.ShowSolution = false;

      Maze1.Columns.Clear();

      int i = sel == 0 ? 30 : sel == 1 ? 40 : 50;
      int j = sel == 0 ? 22 : sel == 1 ? 16 : 13;

      for (int c = 0; c <= i - 1; c++)
      {
         Maze1.Columns.Add(new DataGridViewTextBoxColumn()
            { ReadOnly = true, Width = j });
         Maze1.Rows.Add();
         Maze1.Rows[Maze1.Rows.Count - 1].Height = j;
      }

      Maze1.Size = new Size(i * j + 1, i * j + 1);
      Maze1.ShowCellToolTips = false;
      Maze1.DefaultCellStyle.SelectionBackColor =
         Color.FromArgb(175, 255, 60);

      this.SetClientSizeCore(Maze1.Width + 24, Maze1.Bottom + 50);

      btnNew.PerformClick();
      Maze1.Select();

      Maze1.Refresh();
      this.Refresh();
      chkSolve.Checked = false;
   }

VB.NET

   Private Sub cboSize_SelectedIndexChanged(sender As Object, _
         e As EventArgs) Handles cboSize.SelectedIndexChanged

      Dim sel As Integer = cboSize.SelectedIndex

      If sel = -1 Then Return
      Maze1.ShowSolution = False

      Maze1.Columns.Clear()

      Dim i As Integer = If(sel = 0, 30, If(sel = 1, 40, 50))
      Dim j As Integer = If(sel = 0, 22, If(sel = 1, 16, 13))

      For c As Integer = 0 To i - 1
         Maze1.Columns.Add(New DataGridViewTextBoxColumn With _
            {.ReadOnly = True, .Width = j})
         Maze1.Rows.Add()
         Maze1.Rows(Maze1.Rows.Count - 1).Height = j
      Next

      Maze1.Size = New Size(i * j + 1, i * j + 1)
      Maze1.ShowCellToolTips = False
      Maze1.DefaultCellStyle.SelectionBackColor = _
         Color.FromArgb(175, 255, 60)

      Me.SetClientSizeCore(Maze1.Width + 24, Maze1.Bottom + 50)

      btnNew.PerformClick()
      Maze1.Select()

      Maze1.Refresh()
      Me.Refresh()
      chkSolve.Checked = False
   End Sub

This code resizes the Maze object’s contents to adapt to the level of difficulty. The more advanced the level of the game, the more complicated and cluttered the screen becomes.

Add the New button’s code.

C#

   private void btnNew_Click(object sender, EventArgs e)
   {
      Maze1.ShowSolution = false;

      Maze1.Rows[0].Cells[clsGrid.ptEnd.X].Style.BackColor =
         Color.White;

      cGame.Generate(Maze1.Columns.Count, intRand);

      clsGrid.ptEnd = new Point(intRand.Next(0,
         Maze1.Rows.Count), 0);
      clsGrid.Cells[clsGrid.ptEnd.X][0].blnNorth = false;

      Maze1.Rows[0].Cells[clsGrid.ptEnd.X].Style.BackColor =
         Color.Green;
      Maze1.CurrentCell = Maze1.Rows[Maze1.Rows.Count - 1]
         .Cells[clsGrid.ptStart.X];
      chkSolve.Checked = false;
      Maze1.Refresh();

      bool[,] blnPrev = new bool[Maze1.Columns.Count - 1 + 1,
         Maze1.Rows.Count - 1 + 1];

      lstSol = new List<Point>();

      if (!cGame.Solve(Maze1.Columns.Count, clsGrid.ptStart.X,
            Maze1.Rows.Count - 1, blnPrev, lstSol))
         btnNew.PerformClick();

      Maze1.Select();
   }

VB.NET

   Private Sub btnNew_Click(sender As Object, e As EventArgs) _
         Handles btnNew.Click

      Maze1.ShowSolution = False

      Maze1.Rows(0).Cells(clsGrid.ptEnd.X).Style.BackColor = _
         Color.White

      cGame.Generate(Maze1.Columns.Count, intRand)

      clsGrid.ptEnd = New Point(intRand.Next(0, _
         Maze1.Rows.Count), 0)]
      clsGrid.Cells(clsGrid.ptEnd.X)(0).blnNorth = False

      Maze1.Rows(0).Cells(clsGrid.ptEnd.X).Style.BackColor = _
         Color.Green
      Maze1.CurrentCell = Maze1.Rows(Maze1.Rows.Count - 1) _
         .Cells(clsGrid.ptStart.X)
      chkSolve.Checked = False
      Maze1.Refresh()

      Dim blnPrev(Maze1.Columns.Count - 1, Maze1.Rows.Count - 1) _
         As Boolean

      lstSol = New List(Of Point)

      If Not cGame.Solve(Maze1.Columns.Count, clsGrid.ptStart.X, _
            Maze1.Rows.Count - 1, blnPrev, lstSol) Then
         btnNew.PerformClick()
      End If

      Maze1.Select()

   End Sub

This defaults all the objects on the screen. It provides a starting point as well as an ending point, and initializes all the objects to be used during game play.

Create the grid by adding the following code to the Maze object’s Paint event.

C#

   private void Maze1_Paint(object sender, PaintEventArgs e)
   {
      if (clsGrid.Cells == null)
         return;

      int sel = cboSize.SelectedIndex;
      if (sel == -1)
         return;

      int i = sel == 0 ? 30 : sel == 1 ? 40 : 50;
      int j = sel == 0 ? 22 : sel == 1 ? 16 : 13;

      for (int row = 0; row <= i - 1; row++)
      {
         for (int col = 0; col <= i - 1; col++)
         {
            if (clsGrid.Cells[col][row].blnNorth)
               e.Graphics.DrawLine(new Pen(Color.Black,
                  row == 0 ? 4 : 2), j * col, j * row,
                  j * (col + 1), j * row);
            if (clsGrid.Cells[col][row].blnSouth)
               e.Graphics.DrawLine(new Pen(Color.Black, 2),
                  j * col, j * (row + 1), j * (col + 1),
                  j * (row + 1));
            if (clsGrid.Cells[col][row].blnWest)
               e.Graphics.DrawLine(new Pen(Color.Black,
                  col == 0 ? 4 : 2), j * col, j * row,
                  j * col, j * (row + 1));
            if (clsGrid.Cells[col][row].blnEast)
               e.Graphics.DrawLine(new Pen(Color.Black, 2),
                  j * (col + 1), j * row, j * (col + 1),
                  j * (row + 1));
         }
      }
   }

VB.NET

   Private Sub Maze1_Paint(sender As Object, e As PaintEventArgs) _
         Handles Maze1.Paint

      If clsGrid.Cells Is Nothing Then Return

      Dim sel As Integer = cboSize.SelectedIndex
      If sel = -1 Then Return

      Dim i As Integer = If(sel = 0, 30, If(sel = 1, 40, 50))
      Dim j As Integer = If(sel = 0, 22, If(sel = 1, 16, 13))

      For row As Integer = 0 To i - 1
         For col As Integer = 0 To i - 1
            If clsGrid.Cells(col)(row).blnNorth Then
               e.Graphics.DrawLine(New Pen(Color.Black, _
                  If(row = 0, 4, 2)), j * col, j * row, _
                  j * (col + 1), j * row)
            End If
            If clsGrid.Cells(col)(row).blnSouth Then
               e.Graphics.DrawLine(New Pen(Color.Black, 2), _
                  j * col, j * (row + 1), j * (col + 1), _
                  j * (row + 1))
            End If
            If clsGrid.Cells(col)(row).blnWest Then
               e.Graphics.DrawLine(New Pen(Color.Black, _
                  If(col = 0, 4, 2)), j * col, j * row, _
                  j * col, j * (row + 1))
            End If
            If clsGrid.Cells(col)(row).blnEast Then
               e.Graphics.DrawLine(New Pen(Color.Black, 2), _
                  j * (col + 1), j * row, j * (col + 1), _
                  j * (row + 1))
            End If
         Next
      Next

   End Sub

Conclusion

Obviously, this project can be taken much, much further, but this is a good place to stop, because the inner workings and logic are complete. I hope that you have enjoyed this little series. Until next time, happy coding!

The post Creating a Maze Game in .NET, Part 3: Adding the Final Touches to the Form appeared first on CodeGuru.

Let’s jump right in.

Add a new class and name it Maze, for example.

Add the following code for this class:

C#

using System;
using System.Collections.Generic;
using System.Diagnostics;
using System.Globalization;
using System.IO;
using System.Linq;
using System.Reflection;
using System.Runtime.CompilerServices;
using System.Security;
using System.Text;
using System.Threading.Tasks;
using Microsoft.VisualBasic;
using System.Windows.Forms;
using System.Drawing;

namespace HTG_Maze_VB
{
   class Maze : DataGridView
   {
      private int WM_LBUTTONDOWN = 0x201;
      private int WM_LBUTTONDBLCLK = 0x203;
      private int WM_KEYDOWN = 0x100;

      public Maze()
      {
         this.DoubleBuffered = true;
      }

      private bool blnSolution;

      public bool ShowSolution
      {
         get
         {
            return blnSolution;
         }

         set
         {
            blnSolution = value;
         }

      }


      protected override void OnRowPrePaint(System.Windows.
         .DataGridViewRowPrePaintEventArgs e)
      {
         e.PaintParts = e.PaintParts &
            ~DataGridViewPaintParts.Focus;
         base.OnRowPrePaint(e);
      }

      protected override void OnPaint(System.Windows.Forms
         .PaintEventArgs e)
      {
         base.OnPaint(e);

         if (clsGrid.Cells == null)
            return;

         for (int row = 0; row <= base.Rows.Count - 1; row++)
         {
            for (int col = 0; col <= base.Columns.Count - 1;
               col++)
            {
               int intWidth = 2;
               Pen pRed = new Pen(Color.Red, intWidth);
               Pen pGreen = new Pen(Color.Green, intWidth);
               int intSize = base.Rows[0].Cells[0].Size.Width;

               if (ShowSolution ? Convert.ToBoolean
                     (clsGrid.Solution[col][row]) :
                     Convert.ToBoolean(clsGrid.Cells[col][row]
                    .intNorth > 0))
                  e.Graphics.DrawLine(ShowSolution ? pGreen :
                     pRed, System.Convert.ToInt32(intSize * col +
                     ((intSize - intWidth) / (double)2) + 1),
                     System.Convert.ToInt32(intSize * row),
                     System.Convert.ToInt32(intSize * col +
                     ((intSize - intWidth) / (double)2) + 1),
                     System.Convert.ToInt32(intSize * row +
                    ((intSize - intWidth) / (double)2) + 1));

               if (ShowSolution ? Convert.ToBoolean(clsGrid
                     .Solution[col][row]) : Convert.ToBoolean
                     (clsGrid.Cells[col][row].intSouth > 0))
                  e.Graphics.DrawLine(ShowSolution ? pGreen : pRed,
                     System.Convert.ToInt32(intSize * col +
                     ((intSize - intWidth) / (double)2) + 1),
                     System.Convert.ToInt32(intSize * row +
                     ((intSize - intWidth) / (double)2) + 1),
                     System.Convert.ToInt32(intSize * col +
                     ((intSize - intWidth) / (double)2) + 1),
                     System.Convert.ToInt32(intSize * (row + 1)));

               if (ShowSolution ? Convert.ToBoolean(clsGrid
                     .Solution[col][row]) : Convert.ToBoolean
                     (clsGrid.Cells[col][row].intWest > 0))
                  e.Graphics.DrawLine(ShowSolution ? pGreen : pRed,
                     System.Convert.ToInt32(intSize * col),
                     System.Convert.ToInt32(intSize * row +
                     ((intSize - intWidth) / (double)2) + 1),
                     System.Convert.ToInt32(intSize * col +
                     ((intSize - intWidth) / (double)2) + 1),
                     System.Convert.ToInt32(intSize * row +
                     ((intSize - intWidth) / (double)2) + 1));

               if (ShowSolution ? Convert.ToBoolean(clsGrid
                     .Solution[col][row]) : Convert.ToBoolean
                     (clsGrid.Cells[col][row].intEast > 0))
                  e.Graphics.DrawLine(ShowSolution ? pGreen : pRed,
                     System.Convert.ToInt32(intSize * col +
                     ((intSize - intWidth) / (double)2) - 1),
                     System.Convert.ToInt32(intSize * row +
                     ((intSize - intWidth) / (double)2) + 1),
                     System.Convert.ToInt32(intSize * (col + 1)),
                     System.Convert.ToInt32(intSize * row +
                     ((intSize - intWidth) / (double)2) + 1));
            }
         }
      }

      protected override void WndProc(ref
         System.Windows.Forms.Message m)
      {
         if (m.Msg == WM_KEYDOWN)
         {
            if (ShowSolution)
               return;

            int row = base.CurrentCell.RowIndex;
            int col = base.CurrentCell.ColumnIndex;

            int msgVal = m.WParam.ToInt32();

            switch ((Keys)msgVal)
            {
               case Keys.Up:
                  if (row > 0)
                  {
                     if (clsGrid.Cells[col][row].blnNorth == false)
                     {
                        clsGrid.Cells[col][row].intNorth += 1;
                        clsGrid.Cells[col][row - 1].intSouth += 1;
                        base.CurrentCell =
                           base.Rows[row - 1].Cells[col];
                     }
                  }
                  break;
               case Keys.Down:
                  if (row < base.Rows.Count - 1)
                  {
                     if (clsGrid.Cells[col][row].blnSouth == false)
                     {
                        clsGrid.Cells[col][row].intSouth += 1;
                        clsGrid.Cells[col][row + 1].intNorth += 1;
                        base.CurrentCell =
                           base.Rows[row + 1].Cells[col];
                     }
                  }
                  break;
               case Keys.Left:
                  if (col > 0)
                  {
                     if (clsGrid.Cells[col][row].blnWest == false)
                     {
                        clsGrid.Cells[col][row].intWest += 1;
                        clsGrid.Cells[col - 1][row].intEast += 1;
                        base.CurrentCell =
                           base.Rows[row].Cells[col - 1];
                     }
                  }
                  break;
               case Keys.Right:
                  if (col < base.Columns.Count - 1)
                  {
                     if (clsGrid.Cells[col][row].blnEast == false)
                     {
                        clsGrid.Cells[col][row].intEast += 1;
                        clsGrid.Cells[col + 1][row].intWest += 1;
                        base.CurrentCell =
                           base.Rows[row].Cells[col + 1];
                     }
                  }
                  break;
            }

            base.Refresh();

            return;
         }
         else if (m.Msg == WM_LBUTTONDBLCLK || m.Msg ==
               WM_LBUTTONDOWN)
            return;

         base.WndProc( ref m);
      }
   }
}

VB.NET

Public Class Maze
   Inherits DataGridView

   Dim WM_LBUTTONDOWN As Integer = &H201
   Dim WM_LBUTTONDBLCLK As Integer = &H203
   Dim WM_KEYDOWN As Integer = &H100

   Public Sub New()

      Me.DoubleBuffered = True

   End Sub

   Private blnSolution As Boolean

   Public Property ShowSolution() As Boolean

      Get
         Return blnSolution
      End Get

      Set(ByVal value As Boolean)
         blnSolution = value
      End Set

   End Property


   Protected Overrides Sub OnRowPrePaint(ByVal e As _
         System.Windows.Forms.DataGridViewRowPrePaintEventArgs)

      e.PaintParts = e.PaintParts And Not _
         DataGridViewPaintParts.Focus
      MyBase.OnRowPrePaint(e)

   End Sub

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

      If clsGrid.Cells Is Nothing Then Return

      For row As Integer = 0 To MyBase.Rows.Count - 1

         For col As Integer = 0 To MyBase.Columns.Count - 1

            Dim intWidth As Integer = 2
            Dim pRed As New Pen(Color.Red, intWidth)
            Dim pGreen As New Pen(Color.Green, intWidth)
            Dim intSize As Integer = _
               MyBase.Rows(0).Cells(0).Size.Width

            If If(ShowSolution(), clsGrid.Solution(col)(row), _
                  clsGrid.Cells(col)(row)).intNorth > 0 Then
               e.Graphics.DrawLine(If(ShowSolution(), pGreen, _
                  pRed), CInt(intSize * col + ((intSize - _
                  intWidth) / 2) + 1), CInt(intSize * row), _
                  CInt(intSize * col + ((intSize - intWidth) / 2) _
                  + 1), CInt(intSize * row + ((intSize - _
                  intWidth) / 2) + 1))
            End If

            If If(ShowSolution(), clsGrid.Solution(col)(row), _
                  clsGrid.Cells(col)(row)).intSouth > 0 Then
               e.Graphics.DrawLine(If(ShowSolution(), pGreen, _
                  pRed), CInt(intSize * col + ((intSize - _
                  intWidth) / 2) + 1), CInt(intSize * row + _
                  ((intSize - intWidth) / 2) + 1), CInt(intSize * _
                  col + ((intSize - intWidth) / 2) + 1), _
                  CInt(intSize * (row + 1)))
            End If

            If If(ShowSolution(), clsGrid.Solution(col)(row), _
                  clsGrid.Cells(col)(row)).intWest > 0 Then
               e.Graphics.DrawLine(If(ShowSolution(), pGreen, _
                  pRed), CInt(intSize * col), CInt(intSize * row _
                  + ((intSize - intWidth) / 2) + 1), CInt(intSize _
                  * col + ((intSize - intWidth) / 2) + 1), _
                  CInt(intSize * row + ((intSize - intWidth) / 2) _
                  + 1))

            End If

            If If(ShowSolution(), clsGrid.Solution(col)(row), _
                  clsGrid.Cells(col)(row)).intEast > 0 Then
               e.Graphics.DrawLine(If(ShowSolution(), pGreen, _
                  pRed), CInt(intSize * col + ((intSize - _
                  intWidth) / 2) - 1), CInt(intSize * row + _
                  ((intSize - intWidth) / 2) + 1), CInt(intSize * _
                  (col + 1)), CInt(intSize * row + ((intSize - _
                  intWidth) / 2) + 1))
            End If

         Next

      Next

   End Sub

   Protected Overrides Sub WndProc(ByRef m As _
         System.Windows.Forms.Message)

      If m.Msg = WM_KEYDOWN Then

         If ShowSolution Then Return

         Dim row As Integer = MyBase.CurrentCell.RowIndex
         Dim col As Integer = MyBase.CurrentCell.ColumnIndex

         If m.WParam.ToInt32 = Keys.Up Then

            If row > 0 Then
               If clsGrid.Cells(col)(row).blnNorth = False Then
                  clsGrid.Cells(col)(row).intNorth += 1
                  clsGrid.Cells(col)(row - 1).intSouth += 1
                  MyBase.CurrentCell = MyBase.Rows(row - _
                     1).Cells(col)
               End If

            End If

         ElseIf m.WParam.ToInt32 = Keys.Down Then

            If row < MyBase.Rows.Count - 1 Then
               If clsGrid.Cells(col)(row).blnSouth = False Then
                  clsGrid.Cells(col)(row).intSouth += 1
                  clsGrid.Cells(col)(row + 1).intNorth += 1
                  MyBase.CurrentCell = _
                     MyBase.Rows(row + 1).Cells(col)
               End If

            End If
         ElseIf m.WParam.ToInt32 = Keys.Left Then

            If col > 0 Then
               If clsGrid.Cells(col)(row).blnWest = False Then
                  clsGrid.Cells(col)(row).intWest += 1
                  clsGrid.Cells(col - 1)(row).intEast += 1
                  MyBase.CurrentCell = _
                     MyBase.Rows(row).Cells(col - 1)
               End If

            End If

         ElseIf m.WParam.ToInt32 = Keys.Right Then

            If col < MyBase.Columns.Count - 1 Then
               If clsGrid.Cells(col)(row).blnEast = False Then
                  clsGrid.Cells(col)(row).intEast += 1
                  clsGrid.Cells(col + 1)(row).intWest += 1
                  MyBase.CurrentCell = _
                     MyBase.Rows(row).Cells(col + 1)
               End If

            End If

         End If

         MyBase.Refresh()

         Return

      ElseIf m.Msg = WM_LBUTTONDBLCLK OrElse m.Msg = _
            WM_LBUTTONDOWN Then

         Return

      End If

      MyBase.WndProc(m)

   End Sub

End Class

Let’s see what happens here.

You specify the DoubleBuffered property in the class constructor. This prevents flickering when redrawing pictures. You created the ShowSolution property, which will allow you to see the Solution when clicked or play the game when it is not clicked.

You then override the RowPrePaint event which occurs before the DataGridView’s rows are painted, to identify which parts have the focus. The Paint event of the DataGridView is overridden, and this is where the fun happens. We loop through each cell and draw random connecting lines to form a maze.

Lastly, you override WndProc, which is the normal input for a window to intercept the keys that are pressed. This allows us to navigate through the maze in any cardinal direction and keep track of it by drawing a line as we try to navigate through the maze.

Conclusion

We are almost done. We must now add this to a form, and this is what we will do in Part 3. Until then, happy coding!

The post Creating a Maze Game in .NET, Part 2: Adding Gameplay appeared first on CodeGuru.

Inside this maze were electronic doors that needed to be tested whether or not they were open before continuing. The robotic mouse also understood a very basic set of instructions (such as move left, smell, and look), for it to navigate through the maze.

These tasks enable students to think critically to solve a problem with the instructions provided. This test has been in existence for almost 15 years, and ever since I made it, I wanted to create my own Maze game. Now, finally, with some time on my hands, I can finally show you how to create a Maze.

Welcome to Part 1, where we will create the gaming structure. This project can be done in either VB.NET or C#; I will provide code for both. Let’s start!

Practical

Create either a VB.NET or C# Windows Application, and add two classes named:

• clsGrid
• clsGame

Add the following to clsGrid:

C#

using System;

public class clsGrid
{
   public struct Cell
   {
      public bool blnNorth;
      public bool blnSouth;
      public bool blnWest;
      public bool blnEast;
      public bool blnDirty;
      public int intNorth;
      public int intSouth;
      public int intWest;
      public int intEast;
   }

   public static Cell[][] Cells;
   public static Cell[][] Solution;

   public static Point ptStart;
   public static Point ptEnd;
}

VB.NET

Public Class clsGrid

   Public Structure Cell

      Dim blnNorth As Boolean
      Dim blnSouth As Boolean
      Dim blnWest As Boolean
      Dim blnEast As Boolean
      Dim blnDirty As Boolean
      Dim intNorth As Integer
      Dim intSouth As Integer
      Dim intWest As Integer
      Dim intEast As Integer

   End Structure

   Public Shared Cells()() As Cell
   Public Shared Solution()() As Cell

   Public Shared ptStart As Point
   Public Shared ptEnd As Point

End Class

There isn’t much in the class, but it does set the boundaries for the walls of the grid, as well as holding the Cell arrays and their various Starting and Ending points. Add the Generate code for clsGame.

C#

   public void Generate(int intCols, Random rndRand)
   {

      for (int cell = 0; cell <= intCols - 1; cell++)
      {

         for (int r = 0; r <= intCols - 1; r++)

            clsGrid.Cells(cell)(r) = new clsGrid.Cell();
      }

      for (int col = 0; col <= clsGrid.Cells.GetUpperBound(0);
         col++)
      {
         for (int row = 0; row <=
            clsGrid.Cells(0).GetUpperBound(0); row++)
         {
            clsGrid.Cells(col)(row).blnDirty = false;
            clsGrid.Cells(col)(row).blnNorth = true;
            clsGrid.Cells(col)(row).blnSouth = true;
            clsGrid.Cells(col)(row).blnWest = true;
            clsGrid.Cells(col)(row).blnEast = true;
         }
      }

      List<Point> lstMaze = new List<Point>();

      int intEmpty = Math.Pow(intCols, 2);

      clsGrid.ptStart = new Point(rndRand.Next(0, intCols),
         intCols - 1);

      clsGrid.Cells(clsGrid.ptStart.X)(intCols - 1).blnSouth =
         false;

      lstMaze.Add(new Point(clsGrid.ptStart.X, intCols - 1));

      intEmpty -= 1;

      while (intEmpty > 0)
      {
         Point pPoint = lstMaze[rndRand.Next(0, lstMaze.Count)];

         List<Point> lstChoice = new List<Point>();

         if (pPoint.X > 0 & pPoint.X < intCols - 1)
         {
            if (pPoint.Y > 0 & pPoint.Y < intCols - 1)
               // l,t,r,b
               lstChoice.AddRange(new Point[] { new Point(pPoint.X
                  - 1, pPoint.Y), new Point(pPoint.X, pPoint.Y -
                  1), new Point(pPoint.X + 1, pPoint.Y), new
                  Point(pPoint.X, pPoint.Y + 1) });
            else if (pPoint.Y == 0)
               // l,r,b
               lstChoice.AddRange(new Point[] { new Point(pPoint.X
                  - 1, pPoint.Y), new Point(pPoint.X + 1,
                  pPoint.Y), new Point(pPoint.X, pPoint.Y + 1) });
            else if (pPoint.Y == intCols - 1)
               // l,t,r
               lstChoice.AddRange(new Point[] { new Point(pPoint.X
               - 1, pPoint.Y), new Point(pPoint.X, pPoint.Y - 1),
               new Point(pPoint.X + 1, pPoint.Y) });
         }
         else if (pPoint.X == 0)
         {
            if (pPoint.Y > 0 & pPoint.Y < intCols - 1)
               // t,r,b
               lstChoice.AddRange(new Point[] { new Point(pPoint.X,
                  pPoint.Y - 1), new Point(pPoint.X + 1, pPoint.Y),
                  new Point(pPoint.X, pPoint.Y + 1) });
            else if (pPoint.Y == 0)
               // r,b
               lstChoice.AddRange(new Point[] { new Point(pPoint.X
                  + 1, pPoint.Y), new Point(pPoint.X, pPoint.Y
                  + 1) });
            else if (pPoint.Y == intCols - 1)
               // t,r
               lstChoice.AddRange(new Point[] { new Point(pPoint.X,
                  pPoint.Y - 1), new Point(pPoint.X + 1,
                  pPoint.Y) });
         }
         else if (pPoint.X == intCols - 1)
         {
            if (pPoint.Y > 0 & pPoint.Y < intCols - 1)
               // l,t,b
               lstChoice.AddRange(new Point[] { new Point(pPoint.X
                  - 1, pPoint.Y), new Point(pPoint.X, pPoint.Y
                  - 1), new Point(pPoint.X, pPoint.Y + 1) });
            else if (pPoint.Y == 0)
               // l,b
               lstChoice.AddRange(new Point[] { new Point(pPoint.X
               - 1, pPoint.Y), new Point(pPoint.X, pPoint.Y
               + 1) });
            else if (pPoint.Y == intCols - 1)
               // l,t
               lstChoice.AddRange(new Point[] { new Point(pPoint.X
                  - 1, pPoint.Y), new Point(pPoint.X, pPoint.Y
                  - 1) });
         }

         lstChoice.RemoveAll(pt => clsGrid.Cells(pt.X)(pt.Y)
            .blnDirty);


         if (lstChoice.Count == 0)
            continue;

         Point pPoint2 = lstChoice[rndRand.Next(0,
            lstChoice.Count)];

         if (pPoint.X == pPoint2.X & pPoint2.Y < pPoint.Y)
         {
            if (clsGrid.Cells(pPoint.X)(pPoint.Y).blnNorth)
            {
               clsGrid.Cells(pPoint.X)(pPoint.Y).blnNorth = false;
               clsGrid.Cells(pPoint2.X)(pPoint2.Y).blnSouth =
                  false;
               clsGrid.Cells(pPoint2.X)(pPoint2.Y).blnDirty = true;
               intEmpty -= 1;
               lstMaze.Add(new Point(pPoint2.X, pPoint2.Y));
            }
            else
               continue;
         }
         else if (pPoint.X == pPoint2.X & pPoint2.Y > pPoint.Y)
         {
            if (clsGrid.Cells(pPoint.X)(pPoint.Y).blnSouth)
            {
               clsGrid.Cells(pPoint.X)(pPoint.Y).blnSouth = false;
               clsGrid.Cells(pPoint2.X)(pPoint2.Y).blnNorth =
                  false;
               clsGrid.Cells(pPoint2.X)(pPoint2.Y).blnDirty = true;
               intEmpty -= 1;
               lstMaze.Add(pPoint2);
            }
            else
               continue;
         }
         else if (pPoint.X > pPoint2.X & pPoint2.Y == pPoint.Y)
         {
            if (clsGrid.Cells(pPoint.X)(pPoint.Y).blnWest)
            {
               clsGrid.Cells(pPoint.X)(pPoint.Y).blnWest = false;
               clsGrid.Cells(pPoint2.X)(pPoint2.Y).blnEast =
                  false;
               clsGrid.Cells(pPoint2.X)(pPoint2.Y).blnDirty = true;
               intEmpty -= 1;
               lstMaze.Add(pPoint2);
            }
            else
               continue;
         }
         else if (pPoint.X < pPoint2.X & pPoint2.Y == pPoint.Y)
         {
            if (clsGrid.Cells(pPoint.X)(pPoint.Y).blnEast)
            {
               clsGrid.Cells(pPoint.X)(pPoint.Y).blnEast = false;
               clsGrid.Cells(pPoint2.X)(pPoint2.Y).blnWest = false;
               clsGrid.Cells(pPoint2.X)(pPoint2.Y).blnDirty = true;
               intEmpty -= 1;
               lstMaze.Add(pPoint2);
            }
            else
               continue;
        }
      }
   }

VB.NET

   Public Sub Generate(ByVal intCols As Integer, ByVal rndRand _
         As Random)

      ReDim clsGrid.Cells(intCols - 1)

      For cell As Integer = 0 To intCols - 1

         ReDim clsGrid.Cells(cell)(intCols - 1)

         For r As Integer = 0 To intCols - 1

            clsGrid.Cells(cell)(r) = New clsGrid.Cell

         Next

      Next

      For col As Integer = 0 To clsGrid.Cells.GetUpperBound(0)

         For row As Integer = 0 To clsGrid.Cells(0) _
               .GetUpperBound(0)

            clsGrid.Cells(col)(row).blnDirty = False
            clsGrid.Cells(col)(row).blnNorth = True
            clsGrid.Cells(col)(row).blnSouth = True
            clsGrid.Cells(col)(row).blnWest = True
            clsGrid.Cells(col)(row).blnEast = True

         Next

      Next

      Dim lstMaze As New List(Of Point)

      Dim intEmpty As Integer = intCols ^ 2

      clsGrid.ptStart = New Point(rndRand.Next(0, intCols), _
         intCols - 1)

      clsGrid.Cells(clsGrid.ptStart.X)(intCols - 1).blnSouth = _
         False

      lstMaze.Add(New Point(clsGrid.ptStart.X, intCols - 1))

      intEmpty -= 1

      While intEmpty > 0

         Dim pPoint As Point = lstMaze(rndRand.Next(0, _
            lstMaze.Count))

         Dim lstChoice As New List(Of Point)

         If pPoint.X > 0 And pPoint.X < intCols - 1 Then

            If pPoint.Y > 0 And pPoint.Y < intCols - 1 Then

               'l,t,r,b'
               lstChoice.AddRange(New Point() {New Point(pPoint.X _
                  - 1, pPoint.Y), New Point(pPoint.X, pPoint.Y _
                  - 1), New Point(pPoint.X + 1, pPoint.Y), _
                  New Point(pPoint.X, pPoint.Y + 1)})

            ElseIf pPoint.Y = 0 Then

               'l,r,b'
               lstChoice.AddRange(New Point() {New Point(pPoint.X _
                  - 1, pPoint.Y), New Point(pPoint.X + 1, _
                  pPoint.Y), New Point(pPoint.X, pPoint.Y + 1)})

            ElseIf pPoint.Y = intCols - 1 Then

               'l,t,r'
               lstChoice.AddRange(New Point() {New Point(pPoint.X _
                  - 1, pPoint.Y), New Point(pPoint.X, pPoint.Y _
                  - 1), New Point(pPoint.X + 1, pPoint.Y)})

            End If

         ElseIf pPoint.X = 0 Then

            If pPoint.Y > 0 And pPoint.Y < intCols - 1 Then

               't,r,b'
               lstChoice.AddRange(New Point() {New Point(pPoint.X, _
                  pPoint.Y - 1), New Point(pPoint.X + 1, _
                  pPoint.Y), New Point(pPoint.X, pPoint.Y + 1)})

            ElseIf pPoint.Y = 0 Then

               'r,b'
               lstChoice.AddRange(New Point() {New Point(pPoint.X _
                  + 1, pPoint.Y), New Point(pPoint.X, pPoint.Y _
                  + 1)})

            ElseIf pPoint.Y = intCols - 1 Then

               't,r'
               lstChoice.AddRange(New Point() {New Point(pPoint.X, _
                  pPoint.Y - 1), New Point(pPoint.X + 1, pPoint.Y)})

            End If

         ElseIf pPoint.X = intCols - 1 Then

            If pPoint.Y > 0 And pPoint.Y < intCols - 1 Then

               'l,t,b'
               lstChoice.AddRange(New Point() {New Point(pPoint.X _
                  - 1, pPoint.Y), New Point(pPoint.X, pPoint.Y _
                  - 1), New Point(pPoint.X, pPoint.Y + 1)})

            ElseIf pPoint.Y = 0 Then

               'l,b'
               lstChoice.AddRange(New Point() {New Point(pPoint.X _
                  - 1, pPoint.Y), New Point(pPoint.X, pPoint.Y _
                  + 1)})

            ElseIf pPoint.Y = intCols - 1 Then

               'l,t'
               lstChoice.AddRange(New Point() {New Point(pPoint.X _
                  - 1, pPoint.Y), New Point(pPoint.X, pPoint.Y _
                  - 1)})

            End If

         End If

         lstChoice.RemoveAll(Function(pt) clsGrid.Cells(pt.X) _
            (pt.Y).blnDirty)


         If lstChoice.Count = 0 Then Continue While

         Dim pPoint2 As Point = lstChoice(rndRand.Next(0, _
            lstChoice.Count))

         If pPoint.X = pPoint2.X And pPoint2.Y < pPoint.Y Then

            If clsGrid.Cells(pPoint.X)(pPoint.Y).blnNorth Then

               clsGrid.Cells(pPoint.X)(pPoint.Y).blnNorth = False
               clsGrid.Cells(pPoint2.X)(pPoint2.Y).blnSouth = _
                  False
               clsGrid.Cells(pPoint2.X)(pPoint2.Y).blnDirty = True
               intEmpty -= 1
               lstMaze.Add(New Point(pPoint2.X, pPoint2.Y))

            Else

               Continue While

            End If

         ElseIf pPoint.X = pPoint2.X And pPoint2.Y > pPoint.Y Then

            If clsGrid.Cells(pPoint.X)(pPoint.Y).blnSouth Then
               clsGrid.Cells(pPoint.X)(pPoint.Y).blnSouth = False
               clsGrid.Cells(pPoint2.X)(pPoint2.Y).blnNorth = _
                  False
               clsGrid.Cells(pPoint2.X)(pPoint2.Y).blnDirty = True
               intEmpty -= 1

               lstMaze.Add(pPoint2)

            Else

               Continue While

            End If

         ElseIf pPoint.X > pPoint2.X And pPoint2.Y = pPoint.Y Then

            If clsGrid.Cells(pPoint.X)(pPoint.Y).blnWest Then

               clsGrid.Cells(pPoint.X)(pPoint.Y).blnWest = False
               clsGrid.Cells(pPoint2.X)(pPoint2.Y).blnEast = False
               clsGrid.Cells(pPoint2.X)(pPoint2.Y).blnDirty = True
               intEmpty -= 1
               lstMaze.Add(pPoint2)

            Else

               Continue While

            End If

         ElseIf pPoint.X < pPoint2.X And pPoint2.Y = pPoint.Y Then

            If clsGrid.Cells(pPoint.X)(pPoint.Y).blnEast Then
               clsGrid.Cells(pPoint.X)(pPoint.Y).blnEast = False
               clsGrid.Cells(pPoint2.X)(pPoint2.Y).blnWest = False
               clsGrid.Cells(pPoint2.X)(pPoint2.Y).blnDirty = True
               intEmpty -= 1
               lstMaze.Add(pPoint2)

            Else

               Continue While

            End If

         End If

      End While

   End Sub

The Generate sub is responsible for creating the design of the Maze. This is done by generating random points and identifying if the current spot is already used. Then, it draws the connecting lines to the various points.

Add the Solve Function.

C#

   public bool Solve(int intCol, int intX, int intY, bool[,]
      blnScanned, List<Point> lstSol)
   {
      bool blnCorrect = false;
      bool blnCheck = true;

      if (intX >= intCol || intX < 0 || intY >= intCol
            || intY < 0)
         blnCheck = false;
      else
      {
         if (new Point(intX, intY) == clsGrid.ptEnd)
         {
            blnCorrect = true;
            blnCheck = false;
         }

         if (blnScanned[intX, intY])
            blnCheck = false;
      }

      if (blnCheck)
      {
         blnScanned[intX, intY] = true;

         blnCorrect = blnCorrect | clsGrid.Cells(intX)(intY)
            .blnEast == false ? Solve(intCol, intX + 1, intY,
            blnScanned, lstSol) : false;

         blnCorrect = blnCorrect | clsGrid.Cells(intX)(intY)
            .blnSouth == false ? Solve(intCol, intX, intY + 1,
            blnScanned, lstSol) : false;

         blnCorrect = blnCorrect | clsGrid.Cells(intX)(intY)
            .blnWest == false ? Solve(intCol, intX - 1, intY,
            blnScanned, lstSol) : false;

         blnCorrect = blnCorrect | clsGrid.Cells(intX)(intY)
            .blnNorth == false ? Solve(intCol, intX, intY - 1,
            blnScanned, lstSol) : false;
      }

      if (blnCorrect)
         lstSol.Add(new Point(intX, intY));

      return blnCorrect;
   }

VB.NET

   Public Function Solve(ByVal intCol As Integer, ByVal intX As -
      Integer, ByVal intY As Integer, ByVal blnScanned(,) _
      As Boolean, ByVal lstSol As List(Of Point)) As Boolean

      Dim blnCorrect As Boolean = False
      Dim blnCheck As Boolean = True

      If intX >= intCol OrElse intX < 0 OrElse intY >= _
         intCol OrElse intY < 0 Then

         blnCheck = False

      Else

         If New Point(intX, intY) = clsGrid.ptEnd Then

            blnCorrect = True
            blnCheck = False

         End If

         If blnScanned(intX, intY) Then

            blnCheck = False

         End If

      End If

      If blnCheck Then

         blnScanned(intX, intY) = True

         blnCorrect = blnCorrect Or If(clsGrid.Cells(intX)(intY) _
            .blnEast = False, Solve(intCol, intX + 1, intY, _
            blnScanned, lstSol), False)

         blnCorrect = blnCorrect Or If(clsGrid.Cells(intX)(intY) _
            .blnSouth = False, Solve(intCol, intX, intY + 1, _
            blnScanned, lstSol), False)

         blnCorrect = blnCorrect Or If(clsGrid.Cells(intX)(intY) _
            .blnWest = False, Solve(intCol, intX - 1, intY, _
            blnScanned, lstSol), False)

         blnCorrect = blnCorrect Or If(clsGrid.Cells(intX)(intY) _
            .blnNorth = False, Solve(intCol, intX, intY - 1, _
            blnScanned, lstSol), False)

      End If

      If blnCorrect Then

         lstSol.Add(New Point(intX, intY))

      End If

      Return blnCorrect

  End Function

Conclusion

Now that we have the structure, we can build the gaming logic into it in Part 2. I hope you look forward to it.

The post Creating a Maze Game in .NET, Part 1: Structure appeared first on CodeGuru.

In my previous article, “Introduction to Blockchain Programming,” I explained how to get started with BlockChain programs in VB. Today, let’s take it further, and create a test application. Please ensure that you have the code as explained in Part 1, because we will continue to build on to that application.

Code

Add a Module for our Extension methods:

Public Module Extensions

   <System.Runtime.CompilerServices.Extension>
   Public Function CutArray(Of T)(tSrc As T(), uStart As UInt64, _
         uLimit As UInt64) As T()

      If uLimit < 0 Then

         uLimit = BitConverter.ToUInt64(BitConverter._
            GetBytes(tSrc.LongLength), 0) + uLimit

      End If

      Dim uLength As UInt64 = uLimit - uStart

      Dim tResult As T() = New T(uLength - 1) {}

      For i As UInt64 = 0 To uLength - 1

         tResult(i) = tSrc(i + uStart)

      Next

      Return tResult

   End Function

   <System.Runtime.CompilerServices.Extension>
   Public Function NullArray(Of TSource)(ieSrc As _
         IEnumerable(Of TSource)) As Boolean

      Return ieSrc.All(Function(t) t Is Nothing)

   End Function

   Private ReadOnly HexStrings As String() = New String() {"00",
      "01", "02", "03", "04", "05", "06", "07", "08", "09", "0a",
      "0b", "0c", "0d", "0e", "0f", "10", "11", "12", "13", "14",
      "15", "16", "17", "18", "19", "1a", "1b", "1c", "1d", "1e",
      "1f", "20", "21", "22", "23", "24", "25", "26", "27", "28",
      "29", "2a", "2b", "2c", "2d", "2e", "2f", "30", "31", "32",
      "33", "34", "35", "36", "37", "38", "39", "3a", "3b", "3c",
      "3d", "3e", "3f", "40", "41", "42", "43", "44", "45", "46",
      "47", "48", "49", "4a", "4b", "4c", "4d", "4e", "4f", "50",
      "51", "52", "53", "54", "55", "56", "57", "58", "59", "5a",
      "5b", "5c", "5d", "5e", "5f", "60", "61", "62", "63", "64",
      "65", "66", "67", "68", "69", "6a", "6b", "6c", "6d", "6e",
      "6f", "70", "71", "72", "73", "74", "75", "76", "77", "78",
      "79", "7a", "7b", "7c", "7d", "7e", "7f", "80", "81", "82",
      "83", "84", "85", "86", "87", "88", "89", "8a", "8b", "8c",
      "8d", "8e", "8f", "90", "91", "92", "93", "94", "95", "96",
      "97", "98", "99", "9a", "9b", "9c", "9d", "9e", "9f", "a0",
      "a1", "a2", "a3", "a4", "a5", "a6", "a7", "a8", "a9", "aa",
      "ab", "ac", "ad", "ae", "af", "b0", "b1", "b2", "b3", "b4",
      "b5", "b6", "b7", "b8", "b9", "ba", "bb", "bc", "bd", "be",
      "bf", "c0", "c1", "c2", "c3", "c4", "c5", "c6", "c7", "c8",
      "c9", "ca", "cb", "cc", "cd", "ce", "cf", "d0", "d1", "d2",
      "d3", "d4", "d5", "d6", "d7", "d8", "d9", "da", "db", "dc",
      "dd", "de", "df", "e0", "e1", "e2", "e3", "e4", "e5", "e6",
      "e7", "e8", "e9", "ea", "be", "ec", "ed", "ee", "ef", "f0",
      "f1", "f2", "f3", "f4", "f5", "f6", "f7", "f8", "f9", "fa",
      "fb", "fc", "fd", "fe", "ff"}

   <System.Runtime.CompilerServices.Extension>
   Public Function ConvertToHex(value As Byte) As String

      Return HexStrings(value)

   End Function

End Module

The Extension Module provides extension methods for the NullArray and CutArray methods, as well as the ConvertToHex method. Add the Message class.

Class Message

   Private ReadOnly btToken As Byte() = {34, 64, 8, 145}

   Public Message As New Dictionary(Of String, String)() From {
      {"MessageHandshake", "Handshake"},
      {"MessageDisconnect", "Disconnect"},
      {"MessagePing", "Ping"},
      {"MessagePong", "Pong"},
      {"MessageGetPeers", "Get peers"},
      {"MessagePeers", "Peers"},
      {"MessageTransactions", "Transactions"},
      {"MessageBlock", "Blocks"},
      {"MessageGetChain", "Get chain"},
      {"MessageNotInChain", "Not in chain"}
   }
End Class

The Message class contains a Message method, which is a Dictionary object that holds the various messages can be output by our Token objects.

Add the RLPDecode class:

Public NotInheritable Class RLPDecode

   Private Shared ReadOnly uOffsetShort As UInt64 = &H80

   Private Shared ReadOnly uOffsetLong As UInt64 = &HB8

   Private Shared ReadOnly uOffsetShortList As UInt64 = &HC0

   Private Shared ReadOnly uOffsetLongList As UInt64 = &HF8

   Private Shared ReadOnly uMax As UInt64 = &HFF

   Public Shared Function Decode(btData As Byte(), _
         uPos As UInt64) As Decode

      If btData Is Nothing OrElse btData.Length < 1 Then

         Return Nothing

      End If

      Dim uPrefix As UInt64 = btData(uPos) And uMax
      If uPrefix = uOffsetShort Then

         Return New Decode(uPos + 1, New Byte(-1) {})

      ElseIf uPrefix < uOffsetShort Then

         Return New Decode(uPos + 1, New Byte() {btData(uPos)})

      ElseIf uPrefix < uOffsetLong Then

         Dim len As UInt64 = uPrefix - uOffsetShort

         Return New Decode(uPos + 1 + len, btData.CutArray(uPos + _
            1, uPos + 1 + len))

      ElseIf uPrefix < uOffsetShortList Then

         Dim uLength As UInt64 = uPrefix - uOffsetLong + 1

         Dim uBytesLength As UInt64 = Converter.ConvertByteArray _
            ToUInt64(btData.CutArray(uPos + 1, uPos + 1 + uLength))

         Return New Decode(uPos + 1 + uLength + uBytesLength, _
            btData.CutArray(uPos + 1 + uLength, uPos + 1 + _
            uLength + uBytesLength))

      ElseIf uPrefix < uOffsetLongList Then

         Dim uLen As UInt64 = uPrefix - uOffsetShortList

         Dim uPrev As UInt64 = uPos

         uPos += 1

         Return DecodeList(btData, uPos, uPrev, uLen)

      ElseIf uPrefix < uMax Then

         Dim uLength As UInt64 = uPrefix - uOffsetLongList + 1

         Dim uListLength As UInt64 = Converter.ConvertByteArrayTo_
            UInt64(btData.CutArray(uPos + 1, uPos + 1 + uLength))

         uPos = uPos + uLength + 1

         Dim uPrev As UInt64 = uListLength

         Return DecodeList(btData, uPos, uPrev, uListLength)

      End If

   End Function

   Private Shared Function DecodeList(uData As Byte(), uPos As _
         UInt64, uPrev As UInt64, uLength As UInt64) As Decode

      Dim lstSllice As New List(Of [Object])()

      Dim i As UInt64 = 0

      While i < uLength

         Dim dResult As Decode = Decode(uData, uPos)

         lstSllice.Add(dResult.GetDecoded())

         uPrev = dResult.GetPos()
         i += (uPrev - uPos)

         uPos = uPrev

      End While

      Return New Decode(uPos, lstSllice.ToArray())

   End Function

   Public Shared Function StringToByteArray(strHex As String) _
         As Byte()

      If strHex.Length Mod 2 = 1 Then

         Throw New Exception("No odd number of digits")

      End If

      Dim arrTemp As Byte() = New Byte((strHex.Length >> 1) _
         - 1) {}

      For i As Integer = 0 To (strHex.Length >> 1) - 1

         arrTemp(i) = CByte((GetHexVal(Hex(i << 1)) << 4) + _
            (GetHexVal(Hex((i << 1) + 1))))

      Next

      Return arrTemp

   End Function

   Private Shared Function GetHexVal(chrHex As Char) As Integer

      Dim iVal As Integer = Val(chrHex)

      Return iVal - (If(iVal < 58, 48, 87))

   End Function

End Class

Recursive Length Prefix (RLP) encodes nested arrays of binary data.

Add the RLPEncode class:

Public NotInheritable Class RLPEncode

   Private Shared ReadOnly uength As UInt64 = UInt64.MaxValue
   Private Shared ReadOnly uSized As Integer = 56
   Private Shared ReadOnly uOffsetShortItem As Integer = &H80
   Private Shared ReadOnly uOffsetShortList As Integer = &HC0

   Public Shared Function Encode(oInput As [Object]) As Byte()

      If TypeOf oInput Is Array Then

         Dim arrInput As [Object]() = DirectCast(oInput, _
            [Object]())

         If arrInput.Length = 0 Then

            Return EncodeLength(arrInput.Length, uOffsetShortList)

         End If

         Dim btOutput As Byte() = New Byte(-1) {}

         For Each arrayObject As [Object] In arrInput

            btOutput = Encoder.JoinByteArrays(btOutput,  _
               Encode(arrayObject))

         Next

         Dim btPrefix As Byte() = EncodeLength(btOutput.Length, _
            uOffsetShortList)

         Return Encoder.JoinByteArrays(btPrefix, btOutput)

      Else

         If oInput Is Nothing Then

            Throw New ArgumentNullException("Null input")

         End If

         Dim btHexInput As Byte() = Encoder.ToHex(oInput)

         If btHexInput.Length = 1 Then

            Return btHexInput

         Else

            Dim btFirst As Byte() = EncodeLength(btHexInput.Length, _
               uOffsetShortItem)

            Return Encoder.JoinByteArrays(btFirst, btHexInput)

         End If

      End If

   End Function

   Public Shared Function EncodeLength(uLength As ULong, iOffset _
         As Integer) As Byte()

      If uLength < uSized Then

         Dim btFirst As Byte = CByte(uLength + iOffset)
         Return New Byte() {btFirst}

      ElseIf DirectCast(uLength, UInt64) < uength Then

         Dim btLength As Byte() = Encoder.ConvertUInt64ToByte _
            Array(DirectCast(uLength, UInt64))

         Dim btFirst As Byte = CByte(btLength.Length + iOffset + _
            uSized - 1)

         Return Encoder.JoinByteArrays(New Byte() {btFirst}, _
            btLength)

      End If

      Throw New Exception("Input too long")

   End Function

End Class

Together, the Decode and Encode classes deal with nested arrays of binary data. They encode and decode the structure of integers.

Everything is now set up. Now, we can add a test class library to make use of all the BlockChain functionalities.

Create a Test class for each of the previous project’s classes. Let’s start with the CompactEncoderTest class that should be added to the new Class library.

Imports Microsoft.VisualStudio.TestTools.UnitTesting
Imports HTG_Ethereum
Imports System.Text

Public Class CompactEncoderTest
   Private Shared ReadOnly T As Byte = 16
   <TestMethod>
   Public Sub TestCompactEncodeOne()
      Dim test As Byte() = New Byte() {1, 2, 3, 4, 5}
      Dim expected As Byte() = New Byte() {&H11, &H23, &H45}
      Dim result As Byte() = CompactEncoder.CompactEncode(test)
      Assert.AreEqual(Encoding.ASCII.GetString(result),
         Encoding.ASCII.GetString(expected))
   End Sub

   <TestMethod>
   Public Sub TestCompactEncodeTwo()
      Dim test As Byte() = New Byte() {0, 1, 2, 3, 4, 5}
      Dim expected As Byte() = New Byte() {&H0, &H1, &H23, _
         &H45}
      Dim result As Byte() = CompactEncoder.CompactEncode(test)
      Assert.AreEqual(Encoding.ASCII.GetString(result), _
         Encoding.ASCII.GetString(expected))
   End Sub

   <TestMethod>
   Public Sub TestCompactEncodeThree()
      Dim test As Byte() = New Byte() {0, 15, 1, 12, 11, 8,
         T}
      Dim expected As Byte() = New Byte() {&H20, &HF, _
         &H1C, &HB8}
      Dim result As Byte() = CompactEncoder.CompactEncode(test)
      Assert.AreEqual(Encoding.ASCII.GetString(result), _
      Encoding.ASCII.GetString(expected))
   End Sub

   <TestMethod>
   Public Sub TestCompactEncodeFour()
      Dim test As Byte() = New Byte() {15, 1, 12, 11, 8, T}
      Dim expected As Byte() = New Byte() {&H3F, &H1C, &HB8}
      Dim result As Byte() = CompactEncoder.CompactEncode(test)
      Assert.AreEqual(Encoding.ASCII.GetString(result), _
         Encoding.ASCII.GetString(expected))
   End Sub

   <TestMethod>
   Public Sub TestCompactHexDecode()
      Dim test As Byte() = Encoding.ASCII.GetBytes("verb")
      Dim expected As Byte() = New Byte() {7, 6, 6, 5, 7, 2,
         6, 2, 16}
      Dim result As Byte() = CompactEncoder.CompactHexDecode(test)
      Assert.AreEqual(Encoding.ASCII.GetString(result),
         Encoding.ASCII.GetString(expected))
   End Sub

   <TestMethod>
   Public Sub TestCompactDecodeOne()
      Dim test As Byte() = New Byte() {&H11, &H23, &H45}
      Dim expected As Byte() = New Byte() {1, 2, 3, 4, 5}
      Dim result As Byte() = CompactEncoder.CompactDecode(test)
      Assert.AreEqual(Encoding.ASCII.GetString(result), _
         Encoding.ASCII.GetString(expected))
   End Sub

   <TestMethod>
   Public Sub TestCompactDecodeTwo()
      Dim test As Byte() = New Byte() {&H0, &H1, &H23, _
         &H45}
      Dim expected As Byte() = New Byte() {0, 1, 2, 3, 4, 5}
      Dim result As Byte() = CompactEncoder.CompactDecode(test)
      Assert.AreEqual(Encoding.ASCII.GetString(result), _
         Encoding.ASCII.GetString(expected))
   End Sub

   <TestMethod>
   Public Sub TestCompactDecodeThree()
      Dim test As Byte() = New Byte() {&H20, &HF, &H1C,
         &HB8}
      Dim expected As Byte() = New Byte() {0, 15, 1, 12, 11, 8,
         T}
      Dim result As Byte() = CompactEncoder.CompactDecode(test)
      Assert.AreEqual(Encoding.ASCII.GetString(result), _
         Encoding.ASCII.GetString(expected))
   End Sub

   <TestMethod>
   Public Sub TestCompactDecodeFour()
      Dim test As Byte() = New Byte() {&H3F, &H1C, &HB8}
      Dim expected As Byte() = New Byte() {15, 1, 12, 11, 8, T}
      Dim result As Byte() = CompactEncoder.CompactDecode(test)
      Assert.AreEqual(Encoding.ASCII.GetString(result), _
         Encoding.ASCII.GetString(expected))
   End Sub
End Class

These send Test to interrogate the results and compares them to what was expected.

Add the Test for RLPDecoder:

Imports Microsoft.VisualStudio.TestTools.UnitTesting
Imports HTG_Ethereum
Imports System.Text

<TestClass>
Public Class RLPDecoderTest
   <TestMethod>
   Public Sub TestDecodeSingleCharacter()
      Dim test As String = "64"
      Dim expected As String = "d"
      Dim result As [Object] = Encoding.ASCII.GetString _
         (DirectCast(RLPDecode.Decode(RLPDecode.StringToByteArray _
         (test), UInt64.MinValue).GetDecoded(), Byte()))
      Assert.AreEqual(expected, result)
   End Sub

   <TestMethod>
   Public Sub TestDecodeSingleString()
      Dim test As String = "83646f67"
      Dim expected As String = "dog"
      Dim result As [Object] = Encoding.ASCII.GetString _
         (DirectCast(RLPDecode.Decode(RLPDecode.StringToByteArray _
         (test), UInt64.MinValue).GetDecoded(), Byte()))
      Assert.AreEqual(expected, result)
   End Sub

   <TestMethod>
   Public Sub TestDecodeEmptyString()
      Dim test As String = "80"
      Dim expected As String = ""
      Dim result As [Object] = Encoding.ASCII.GetString _
         (DirectCast(RLPDecode.Decode(RLPDecode.StringToByteArray _
         (test), UInt64.MinValue).GetDecoded(), Byte()))
      Assert.AreEqual(expected, result)
   End Sub

   <TestMethod>
   Public Sub TestDecodeArrayOfEmptyStrings()
      Dim test As String = "c0"
      Dim expected As String() = New String() {}
      Dim expectedBool As Boolean = (expected Is Nothing OrElse _
         expected.Length = 0)
      Dim result As [Object]() = DirectCast(RLPDecode.Decode _
         (RLPDecode.StringToByteArray(test), UInt64.MinValue) _
         .GetDecoded(), [Object]())
      Dim resultBool As Boolean = result.NullArray()
      Assert.AreEqual(expectedBool, resultBool)
   End Sub

   <TestMethod>
   Public Sub TestDecodeZero()
      Dim test As String = "80"
      Dim expected As UInt64 = 0
      Dim result As [Object] = Converter.ConvertByteArrayTo _
         UInt64(DirectCast(RLPDecode.Decode(RLPDecode.StringTo _
         ByteArray(test), UInt64.MinValue).GetDecoded(), Byte()))
      Assert.AreEqual(expected, result)
   End Sub

   <TestMethod>
   Public Sub TestDecodeLowInteger()
      Dim test As String = "0f"
      Dim expected As UInt64 = 15
      Dim result As [Object] = Converter.ConvertByteArrayTo _
         UInt64(DirectCast(RLPDecode.Decode(RLPDecode.StringTo _
         ByteArray(test), UInt64.MinValue).GetDecoded(), Byte()))
      Assert.AreEqual(expected, result)
   End Sub

   <TestMethod>
   Public Sub TestDecodeMediumInteger()
      Dim test As String = "820400"
      Dim expected As UInt64 = 1024
      Dim result As [Object] = Converter.ConvertByteArrayTo _
         UInt64(DirectCast(RLPDecode.Decode(RLPDecode.StringTo _
         ByteArray(test), UInt64.MinValue).GetDecoded(), Byte()))
      Assert.AreEqual(expected, result)
   End Sub

   <TestMethod>
   Public Sub TestDecodeBigInteger()
      Dim test As String = "88ffffffffffffffff"
      Dim expected As UInt64 = 18446744073709551615UL
      Dim result As [Object] = Converter.ConvertByteArrayTo _
         UInt64(DirectCast(RLPDecode.Decode(RLPDecode.StringTo _
         ByteArray(test), UInt64.MinValue).GetDecoded(), Byte()))
      Assert.AreEqual(expected, result)
   End Sub

   <TestMethod>
   Public Sub TestDecodeLongString()
      Dim test As String = "b8384c6f72656d20697073756d20646f6c6f _
         722073697420616d65742c20636f6e7365637465747572206164697 _
         069736963696e6720656c6974"
      Dim expected As String = "test"
      Dim result As [Object] = Encoding.ASCII.GetString(DirectCast _
         (RLPDecode.Decode(RLPDecode.StringToByteArray(test), _
         UInt64.MinValue).GetDecoded(), Byte()))
      Assert.AreEqual(expected, result)
   End Sub

   <TestMethod>
   Public Sub TestDecodeEmptyStringList()
      Dim test As String = "c0"
      Dim expected As String() = New String(-1) {}
      Dim expectedBool As Boolean = (expected Is Nothing OrElse _
         expected.Length = 0)
      Dim result As [Object]() = DirectCast(RLPDecode.Decode _
         (RLPDecode.StringToByteArray(test), UInt64.MinValue) _
         .GetDecoded(), [Object]())
      Dim resultBool As Boolean = result.NullArray()
      Assert.AreEqual(expectedBool, resultBool)
   End Sub

   <TestMethod>
   Public Sub TestDecodeShortStringList()
      Dim test As String = "cc83646f6783676f6483636174"
      Dim expected As String() = New String() {"dog", "god", "cat"}
      Dim result As [Object]() = DirectCast(RLPDecode.Decode _
         (RLPDecode.StringToByteArray(test), UInt64.MinValue) _
         .GetDecoded(), [Object]())
      Assert.AreEqual(expected(0), Encoding.ASCII.GetString _
         (DirectCast(result(0), Byte())))
      Assert.AreEqual(expected(1), Encoding.ASCII.GetString _
         (DirectCast(result(1), Byte())))
      Assert.AreEqual(expected(2), Encoding.ASCII.GetString _
         (DirectCast(result(2), Byte())))
   End Sub

   <TestMethod>
   Public Sub TestDecodeLongStringList()
      ' fails'
      Dim test As String = "f83e83636174b8384c6f72656d20697073756 _
         d20646f6c6f722073697420616d65742c20636f6e736563746574757 _
         2206164697069736963696e6720656c6974"
      Dim expected As String() = New String() {"cat", "test"}
      Dim result As [Object]() = DirectCast(RLPDecode.Decode _
         (RLPDecode.StringToByteArray(test), UInt64.MinValue) _
         .GetDecoded(), [Object]())
      Assert.AreEqual(expected(0), Encoding.ASCII.GetString _
         (DirectCast(result(0), Byte())))
      Assert.AreEqual(expected(1), Encoding.ASCII.GetString _
         (DirectCast(result(1), Byte())))
   End Sub

   <TestMethod>
   Public Sub TestDecodeMultiList()
      ' fails'
      Dim test As String = "cc01c48363617483646f67c102"
      Dim expected As [Object]() = New [Object]() {DirectCast(1, _
         UInt64), New [Object]() {"cat"}, "dog", New [Object]() _
         {DirectCast(2, UInt64)}}
      Dim result As [Object]() = DirectCast(RLPDecode.Decode _
         (RLPDecode.StringToByteArray(test), UInt64.MinValue) _
         .GetDecoded(), [Object]())
      Assert.AreEqual(expected(0), Converter.ConvertByteArrayTo _
         UInt64(DirectCast(result(0), Byte())))
      Assert.AreEqual(expected(1).ToString(), result(1).ToString())
      Assert.AreEqual(expected(2), Encoding.ASCII.GetString _
         (DirectCast(result(2), Byte())))
      Assert.AreEqual(DirectCast(expected(3), [Object]())(0), _
         Converter.ConvertByteArrayToUInt64(DirectCast(DirectCast _
         (result(3), [Object]())(0), Byte())))
   End Sub

   <TestMethod>
   Public Sub TestDecodeListOfEmptyLists()
      ' fails'
      Dim test As String = "c4c2c0c0c0"
      Dim expected As [Object]() = New [Object]() {New [Object]() _
         {New [Object]() {}, New [Object]() {}}, New [Object]() {}}
      Dim result As [Object]() = DirectCast(RLPDecode.Decode _
         (RLPDecode.StringToByteArray(test), UInt64.MinValue) _
         .GetDecoded(), [Object]())
      Assert.AreEqual(expected.NullArray(), result.NullArray())
   End Sub

   <TestMethod>
   Public Sub TestDecodeTwoListsOfEmptyLists()
      Dim test As String = "c7c0c1c0c3c0c1c0"
      Dim expected As [Object]() = New [Object]() {New [Object]() _
         {}, New [Object]() {New [Object]() {}}, New [Object]() _
         {New [Object]() {}, New [Object]() {New [Object]() {}}}}
      Dim result As [Object]() = DirectCast(RLPDecode.Decode _
         (RLPDecode.StringToByteArray(test), UInt64.MinValue) _
         .GetDecoded(), [Object]())
      Assert.AreEqual(expected.NullArray(), result.NullArray())
   End Sub
End Class

It makes use of the methods and tries to obtain the correct results.

Finally, add the Test class for the DiscReason class:

Imports Microsoft.VisualStudio.TestTools.UnitTesting
Imports HTG_Ethereum

<TestClass>
Public Class DiscReasonTest
   <TestMethod>
   Public Sub TestGetDiscReason()
      Assert.AreEqual(Disconnected.GetReason(0), "Disconnect _
         requested")
      Assert.AreEqual(Disconnected.GetReason(1), "Disconnect _
         TCP sys error")
      Assert.AreEqual(Disconnected.GetReason(6), "Disconnect _
         wrong genesis block")
      Assert.AreEqual(Disconnected.GetReason(7), "Disconnect _
         incompatible network")
      Assert.AreEqual(Disconnected.GetReason(8), "Unknown")
      Assert.AreEqual(Disconnected.GetReason(9), "Unknown")
      Assert.AreEqual(Disconnected.GetReason(100), "Unknown")
   End Sub
End Class

Conclusion

The BlockChain is a very complicated animal. It is an interesting technology, and it is still in its infancy, but knowing how it works is quite fun.

The post BlockChain Programming and VB.NET, Part 2 appeared first on CodeGuru.

Hello, and welcome to my article. In this short article, you will learn how to make a simple diary in Visual Basic.NET.

Practical

Create a new Visual Basic.NET Console Application. After the application has loaded, add a Class named clsEntry and add the following Properties and methods into it.

Class clsEntry

   Public Property dtDateOfentry As DateTime
   Public Property strContent As String

   Public Sub New(ByVal dtDate As DateTime, _
         ByVal strText As String)

      dtDateOfentry = dtDate
      strContent = strText

   End Sub

   Public Overrides Function ToString() As String

      Return dtDateOfentry & " " & strContent

   End Function

End Class

clsEntry contains two properties: DateOfEntry and strContent. The plan is to be able to enter a date and then supply the Diary entry. The plan further is to be able to search for entries as well as Delete entries based on the Date the entries were made. Add a Class named clsDatabase to the project.

Add the following Namespace to clsDatabase:

Imports System.Collections.Generic

We need this Namespace because we will be working with generic types. Add a List object to store the diary entries.

   Private lstEntries As List(Of clsEntry)

Add the Constructor:

   Public Sub New()

      lstEntries = New List(Of clsEntry)()

   End Sub

This instantiates the lstEntries object, and it is now ready to be used. Add the following two sub procedures to Add items or to Delete items:

   Public Sub Add(ByVal dtDate As DateTime, ByVal strText _
         As String)

      lstEntries.Add(New clsEntry(dtDate, strText))

   End Sub
   Public Sub Delete(ByVal dtDate As DateTime)

      Dim lstResults As List(Of clsEntry) = Find(dtDate, True)

      For Each Entry As clsEntry In lstResults

         lstEntries.Remove(Entry)

      Next

   End Sub

Add adds an entry based on the entered text and date. Delete deletes the entry or entries which were entered on a certain date. Add the Find method.

   Public Function Find(ByVal dtDate As DateTime, ByVal blnTime _
         As Boolean) As List(Of clsEntry)

      Dim lstResults As List(Of clsEntry) = New List(Of clsEntry)()

      For Each Entry As clsEntry In lstEntries

         If ((blnTime) AndAlso (Entry.dtDateOfentry = _
            dtDate)) OrElse ((Not blnTime) AndAlso _
            (Entry.dtDateOfentry.Date = dtDate.Date))
         Then lstResults.Add(Entry)

      Next

      Return lstResults

   End Function

This searches for Entries. Add the clsDiary class and add the following:

Class clsDiary

   Private dbData As clsDatabase

   Public Sub New()

      dbData = New clsDatabase()

   End Sub

   Private Function GetDate() As DateTime

      Console.WriteLine("Enter Date and Time")

      Dim dtDate As DateTime

      While Not DateTime.TryParse(Console.ReadLine(), dtDate)

         Console.WriteLine("Error. Try again:")

      End While

      Return dtDate

   End Function

   Public Sub Print(ByVal dtDay As DateTime)

      Dim lstResults As List(Of clsEntry) = dbData.Find(dtDay, _
         False)

      For Each Entry As clsEntry In lstResults

         Console.WriteLine(Entry)

      Next

   End Sub

   Public Sub Add()

      Dim dtDate As DateTime = GetDate()

      Console.WriteLine("Enter the entry text:")

      Dim strText As String = Console.ReadLine()

      dbData.Add(dtDate, strText)

   End Sub

   Public Sub Search()

      Dim dtDate As DateTime = GetDate()

      Dim lstResults As List(Of clsEntry) = dbData.Find(dtDate, _
         False)

      If lstResults.Count() > 0 Then

         Console.WriteLine("Found:")

         For Each Entry As clsEntry In lstResults

            Console.WriteLine(Entry)

         Next

      Else

         Console.WriteLine("Nothing found.")

      End If

   End Sub

   Public Sub Delete()

      Dim dtDate As DateTime = GetDate()

      dbData.Delete(dtDate)

   End Sub

   Public Sub Welcome()

      Console.Clear()
      Console.WriteLine("Welcome to your virtual diary!")
      Console.WriteLine("Today is: {0}", DateTime.Now)
      Console.WriteLine()

      Console.WriteLine("Diary Entries For Today:")

      Print(DateTime.Today)

      Console.WriteLine()
      Console.WriteLine("Diary Entries For Tomorrow:")

      Print(DateTime.Now.AddDays(1))

      Console.WriteLine()

   End Sub

End Class

You may see some similarities with the clsDatabase class; this is due to separation of the data from the business logic. The Database class serves as the storage manager, whereas the Diary class simply needs to invoke those methods or subs.

Make it work. Add the following code for the Module:

Module Module1

   Sub Main(ByVal args As String())

      Dim objDiary As clsDiary = New clsDiary()

      Dim cSelection As Char = "0"c

      While cSelection <> "4"c

         objDiary.Welcome()
         Console.WriteLine()

         Console.WriteLine("Choose:")
         Console.WriteLine("1 - Add an entry")
         Console.WriteLine("2 - Search for entries")
         Console.WriteLine("3 - Delete entries")
         Console.WriteLine("4 - Exit")

         cSelection = Console.ReadKey().KeyChar
         Console.WriteLine()

         Select Case cSelection

            Case "1"c

               objDiary.Add()

            Case "2"c

               objDiary.Search()

            Case "3"c

               objDiary.Delete()

            Case "4"c

               Console.WriteLine("Press any key to quit.")

            Case Else

               Console.WriteLine("Error.")

         End Select

         Console.ReadKey()

      End While

   End Sub

End Module

This sets up a new clsDiary object, and then determines what you have entered. Based on your supplied value, it will either add entries, delete entries, or search for entries. This is shown in Figures 1-3.

Figure 1: Start

Figure 2: Entries Added

Figure 3: Entries Found

Conclusion

In this article, you have seen how quickly you can make a simple diary. Although it is not connected to a real world database, the principles are similar.

The post Creating a Simple OOP Diary with Visual Basic.NET appeared first on CodeGuru.

First, we create a module with API declarations related to desktop creation and desktop switching.

Private Const DESKTOP_SECURE As Long = 131527
Private Const DESKTOP_SWITCHDESKTOP As Long = 256
Private Const SND_ASYNC As Long = 1
Private Const SND_NOSTOP As Long = 16
Private Const SND_PURGE As Long = 64
Private Const SND_FILENAME As Long = 131072
Private Const SPI_SETDESKWALLPAPER As Long = 20
Private Const SPIF_UPDATEINIFILE As Long = 1
Private Const SPIF_SENDWININICHANGE As Long = 2
Private Const DESKTOP_LOGON As String = "Winlogon"
Private Const DESKTOP_WINSTATION0 As String = "WinSta0"
Private Const DESKTOP_DEFAULT As String = "Default"
Private Type SECURITY_ATTRIBUTES nLength As Long _
   lpSecurityDescriptor As Long _
   bInheritHandle As Long
End Type

Private Declare Function apiCloseDesktop Lib "user32" Alias _
   "CloseDesktop" (ByVal hDesktop As Long) As Long
Private Declare Function apiCreateDesktop Lib "user32" Alias _
   "CreateDesktopA" (ByVal lDesktop As String, ByVal lDevice _
   As Long, ByVal devmode As Long, ByVal dwFlags As Long, ByVal _
   desiredAccess As Long, ByRef secAttribute As _
   SECURITY_ATTRIBUTES) As Long
Private Declare Function apiGetCurrentThreadId Lib "kernel32" _
   Alias "GetCurrentThreadId" () As Long
Private Declare Function apiGetDC Lib "user32" Alias "GetDC" _
   (ByVal hWnd As Long) As Long
Private Declare Function apiGetProcessWindowStation Lib "user32" _
   Alias "GetProcessWindowStation" () As Long
Private Declare Function apiGetSystemDirectory Lib "kernel32" _
   Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, _
   ByVal nSize As Long) As Long
Private Declare Function apiGetThreadDesktop Lib "user32" _
   Alias "GetThreadDesktop" (ByVal dwThread As Long) As Long
Private Declare Function apiGetWindowDC Lib "user32" _
   Alias "GetWindowDC" (ByVal hWnd As Long) As Long
Private Declare Function apiOpenInputDesktop Lib "user32" _
   Alias "OpenInputDesktop" (ByVal dwFlags As Long, _
   ByVal fInherit As Boolean, ByVal dwDesiredAccess As Long) _
   As Long
Private Declare Function apiPaintDesktop Lib "user32" Alias _
   "PaintDesktop" (ByVal hDC As Long) As Long
Private Declare Function apiPlaySound Lib "winmm" Alias _
   "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, _
   ByVal dwFlags As Long) As Long
Private Declare Function apiSetThreadDesktop Lib "user32" Alias _
   "SetThreadDesktop" (ByVal hDesktop As Long) As Long
Private Declare Function apiSwitchDesktop Lib "user32" Alias _
   "SwitchDesktop" (ByVal hDesktop As Long) As Long
Private Declare Function apiSystemParametersInfo Lib "user32" _
   Alias "SystemParametersInfoA" (ByVal uAction As Long, _
   ByVal uParam As Long, ByVal lParam As String, _
   ByVal fuWinIni As Long) As Long
Private Declare Function apiWaitForSingleObject Lib "kernel32" _
   Alias "WaitForSingleObject" (ByVal hHandle As Long, _
   ByVal dwMilliseconds As Long) As Long
Private oldDskThread As Long
Private oldDskInput As Long
Private hwnDsk As Long

Primary Functions

Next, we wrap up the primary APIs into convenient functions.

Public Function CreateDesktop(ByVal sDesktopName As String) _
      As Long
   On Error Resume
   Next
   Dim sa As SECURITY_ATTRIBUTES hwnDsk = _
      apiCreateDesktop(sDesktopName, ByVal 0, ByVal 0, 0, _
      DESKTOP_SECURE, sa)
   If hwnDsk = 0
      Then CreateDesktop = 0: Exit Function
   CreateDesktop = hwnDsk
End Function
Public Function SwitchToDeskTop() As Long
   On Error Resume
   Next
   Dim st As Long Dim sd As Long st = apiSetThreadDesktop(hwnDsk) _
      sd = apiSwitchDesktop(hwnDsk) If sd <> 0 Then _
      SwitchToDeskTop = 1
End Function
Public Sub CloseDeskTop()
   On Error Resume
   Next
   apiCloseDesktop (hwnDsk)
End Sub

Secure Desktop Prompt Message

Finally, we create a function that ties it all together. This function prompts the actual user at the keyboard/mouse with a question to authorize or deny privileges. Because applications are currently suspended on the default desktop, we can be sure that the user has clicked “Yes” to the question displayed on the Message Box.

Public Function PromptMessageUAC(ByVal message As String, _
      ByVal title As String, Optional ByVal timeout As Long) _
      As MB_RESULT
   On Error Resume
   Next
   DoEvents

   Dim dskname As String
   Dim rn As Long Randomize rn = Rnd * (2147483647 - 1) + 1 _
      dskname = CStr(rn) oldDskThread = apiGetThreadDesktop _
      (apiGetCurrentThreadId) oldDskInput = _
      apiOpenInputDesktop(0, False, DESKTOP_SWITCHDESKTOP)
   If CreateDesktop(dskname) = 0
      Then Exit Function
   SwitchToDeskTop PromptMessageUAC = MessageBoxShow(message, _
      title, MB_YES_NO_SECURE, 20000, 0) CloseDeskTop _
      apiSetThreadDesktop (oldDskThread) apiSwitchDesktop _
      (oldDskInput)
   DoEvents
End Function

Message Box API

In a separate module, we declare the API and constants for a Message Box with optional timeout, similar to that of the UAC dialog timeout.

Private Const MB_OK As Long = &H0;
Private Const MB_OKCANCEL As Long = &H1;
Private Const MB_ABORTRETRYIGNORE As Long = &H2;
Private Const MB_YESNOCANCEL As Long = &H3;
Private Const MB_YESNO As Long = &H4;
Private Const MB_RETRYCANCEL As Long = &H5;
Private Const MB_MAX_TIMEOUT As Long = &HFFFFFFFF;
Private Const MB_ICONERROR As Long = &H10;
Private Const MB_ICONQUESTION As Long = &H20;
Private Const MB_ICONWARNING As Long = &H30;
Private Const MB_ICONINFORMATION As Long = &H40;
Private Const MB_SERVICE_NOTIFICATION As Long = &H200000;

Public Const MB_YES_NO_SECURE As Long = MB_YESNO Or _
   MB_ICONQUESTION Or MB_SERVICE_NOTIFICATION

Public Enum MB_RESULT IOK = 1 ICANCEL = 2 IABORT = 3 IRETRY = 4 _
   IIGNORE = 5 IYES = 6 INO = 7 ITRYAGAIN = 10 ICONTINUE = 11
End Enum

Private Declare Function apiMessageBoxTimeOut Lib "user32" _
   Alias "MessageBoxTimeoutA" (ByVal prmlngWindowHandle As Long, _
   ByVal prmstrMessage As String, ByVal prmstrCaption As String, _
   ByVal prmlngType As Long, ByVal prmwLanguage As Integer, _
   ByVal prmdwMiliseconds As Long) As Long

Public Function MessageBoxShow(ByVal message As String, _
   ByVal Caption As String, ByVal flags As Long, _
   ByVal TimeOutMilliseconds As Long, ByVal hWnd As Long) _
   As MB_RESULT
   On Error GoTo poop MessageBoxShow = apiMessageBoxTimeOut(hWnd, _
      message, Caption, flags, 0, TimeOutMilliseconds)
   Exit Function poop: MessageBoxShow = -1
End Function

Usage

To use the main function, you would simply set the parameters of the function and read its return value. The following example sets the timeout to 20 seconds (i.e., 20000 milliseconds):

Private Sub Command1_Click() Dim o As MB_RESULT o = _
      PromptMessageUAC("Are you sure?", "Secure message _
      transaction", 20000)
   If o = MB_RESULT.IYES
      Then MsgBox "User is sure"
   ElseIf o = MB_RESULT.INO
      Then MsgBox "user is unsure"
   ElseIf o = 32000 Then MsgBox "User did not decide. _
      Message box has timed out"
   ElseIf IsNumeric(o) = False
      Then MsgBox o
   End If
End Sub

The post User Account Control Message Box appeared first on CodeGuru.