Boggle Solver

Boggle Solver Project

After being introduced to the game of Boggle by my girlfriend (and losing out to her on one too many occasions) I decided that a computerised solver would lend itself naturally to higher scores.

Searching the net I found many such solvers, but only one of them written in Visual Basic. The one written in Visual Basic uses classes extensively and although it’s nicely written, it demonstrates the high overheads involved with creating a vast number of objects (ie. It’s quite slow).

At the heart of my Boggle solver, is the String Array class. The String Array class comprises of a dynamic array of strings with built-in binary search. This makes for a very fast Boggle solver.

There are two methods you can use to determine the words in a given Boggle board. One method is to recursively walk through the boggle board, testing each combination against a dictionary. The other method is to walk through the dictionary and try to make each given word on the Boggle board.

My Boggle solver uses the first method to create the word list then when you click on a word in the list it will use the second method to determine how that word is made on the Boggle board.

I’m not making the source code available at this stage but you are free to use the program itself.

Downloads

BoggleSolver.zip – contains: BoggleSolver.exe, BoggleSolver.chm (579 kb)

Links

Steven Hoyt’s Boggle Solver (Boggler) written in Visual Basic

An online Boggle Solver by James Cohen

String Array Class

Fast Binary Search using the String Array Class

I developed this class for use with the Boggle Project.

Note: For the BinarySearch method to work correctly, the String Array must be sorted and each Item must be unique.

Usage

Add StringArrayClass.cls to your project

   Dim s As StringArrayClass
   Set s = New StringArrayClass

   Dim l As Long

   'Add an unsorted list
   s.Add "goat"
   s.Add "zebra"
   s.Add "bear"
   s.Add "deer"
   s.Add "tiger"

   'Sort the list discarding any matches
   Set s = s.Sort(True)

   'Use a binary search to find if an item exists
   If s.BinarySearch("fox", l) = ebsItemNotFound Then
      'Add an item to its sorted position
      s.Add "fox", l
   End If

   'Loop through all the items
   For l = 0 To s.Count - 1
      Debug.Print s.Item(l)
   Next

   Set s = Nothing

Downloads

StringArrayClass.zip – contains: StringArrayClass.cls (1.5 kb)
Continue reading

Double Buffered Progress Control

The Progress Control

If you find the Progress Bar that ships with Visual Basic a bit bland then this might take your fancy. You can set a Fore Picture and/or Back Picture. You can set whether they’re Tiled, Stretched or AutoSized. The control is double-buffered, giving a smooth refresh.

There’s also a Percent Property that I find very useful.

Usage

Add Progress.ctl to your project and ensure that Progress.ctx is in the same folder as Progress.ctl

'Add a Progress Control, a Timer Control and a Command button on a form
'Copy and paste this code

Option Explicit

Private Sub Command1_Click()

   Command1.Enabled = False
   Progress1.Percent = 0
   Timer1.Enabled = True

End Sub

Private Sub Form_Load()

   Command1.Caption = "Test"
   Timer1.Enabled = False
   Timer1.Interval = 10

End Sub

Private Sub Timer1_Timer()

   If Progress1.Percent = 100 Then
      Timer1.Enabled = False
      Command1.Enabled = True
   Else
      Progress1.Percent = Progress1.Percent + 1
   End If

End Sub

Downloads

ProgressControl.zip – contains: Progress.ctl, Progress.ctx (3 kb)

ProgressProject.zip – An example of the Progress Control in use (18 kb)

Continue reading

Lotto Class

List Lotto Combinations with the Lotto Class

This class uses recursion to walk through all the possible lotto combinations (order independent) for a given lotto pool. This code can be easily adapted to walk through a pool of Letters or Strings.

Usage

Add LottoClass.cls to your project and declare it using WithEvents in the Declarations area of your Form or Class.

Private WithEvents Lotto As LottoClass

Private mStop As Boolean
Private mPercent As Long

Private Sub cmdStart_Click()

   mStop = False

   Set Lotto = New LottoClass

   mPercent = 0
   Lotto.StartDraw 40, 6

   Set Lotto = Nothing

End Sub

Private Sub cmdStop_Click()

   mStop = True

End Sub

Private Sub Lotto_Complete(DrawCount As Currency)

   Debug.Print "Total Lines: " & Lotto.DrawCount

End Sub

Private Sub Lotto_Result(Draw() As Long, Percent As Long, Cancel As Boolean)

   If mPercent <> Percent Then
      mPercent = Percent
      Debug.Print "Progress: " & Percent & "%"
   End If
   'The Draw can be easily entered into a database or saved to file
   'by either using the FormatDraw Function or Looping through the
   'Draw Array.
   'Debug.Print Lotto.FormatDraw
   Cancel = mStop

End Sub

Downloads

LottoClass.zip – contains: LottoClass.cls (1.0 kb)

Continue reading

MasterMind Solver

After playing Code Breakers (a MasterMind clone) at Neopets for a while, my head started to hurt. I thought there’s got to be a better way to win this thing. Hunting round the Net turned up the two very good resources in the Links section. I’ve adapted Frans van Gool’s excellent MasterMind Java Applet into my own Visual Basic beast.

My MasterMind Solver project shows all the remaining possible solutions at each stage of the game. This could be further optimised by deciding which is the best guess to elimate the most possibilities (and it’s not necessarily one of the remaining possibilities). But this one works good enough for me – and it’s simple too.

Downloads

MasterMindSolver.zip – contains: Complete Master Mind Solver Project (22 kb)

Links

The excellent MasterMind java applet by Frans van Gool (on which this project is based)

A very good article on MasterMind solving algorithms by Gary Darby

ComboBox Snippets

Auto-selecting items in a Combo Box

This snippet shows you how to auto-select a combox as the user types

Option Explicit

Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal _
wParam As Long, lParam As Any) As Long

Private Const CB_ERR = -1
Private Const CB_FINDSTRING = &H14C

Private Sub Combo1_KeyPress(KeyAscii As Integer)

   Dim r As Long
   Dim s As String
   Dim l As Long

   s = Left$(Combo1.Text, Combo1.SelStart) & Chr$(KeyAscii)
   r = SendMessage(Combo1.hwnd, CB_FINDSTRING, -1, ByVal s)
   If r <> CB_ERR Then
      With Combo1
         .ListIndex = r
         .SelStart = Len(s)
         .SelLength = Len(.Text) - Len(s)
      End With
      KeyAscii = 0
   End If

End Sub

Fast AddItem and Clear methods for the Combo Box

Using this code you can shorten the time it takes to load a Combo Box. It works best when you’re adding numbers (up to 3 times faster) or short strings (up to 2 times faster). Download the sample project to see for yourself.

Note: LB_ADDSTRING can be used in same way to add items to a List Box. But in the case of the List Box there is no speed increase.

Option Explicit

Private Const CB_ERR As Long = -1
Private Const CB_ADDSTRING As Long = &H143
Private Const CB_RESETCONTENT As Long = &H14B
Private Const CB_SETITEMDATA As Long = &H151

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal _
hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Sub AddItem(cmb As ComboBox, Text As Variant, Optional ItemData As Long)

   Dim l As Long
   Dim s As String

   If VarType(Text) = vbString Then
      s = Text
   Else
      s = Trim$(Str$(Text))
   End If

   l = SendMessage(cmb.hwnd, CB_ADDSTRING, 0&, ByVal s)
   If l <> CB_ERR Then
      SendMessage cmb.hwnd, CB_SETITEMDATA, l, ByVal ItemData
   End If

End Sub

Public Sub Clear(cmb As ComboBox)

   SendMessage cmb.hwnd, CB_RESETCONTENT, 0, 0&

End Sub

FastCombo.zip – contains: Fast Combo Sample Test (7 kb)

Zip Extraction Class

Extract Zip archives using the ZLib.dll

Well I’ve finally put the Zip Extraction Class together. It’s got a very simple and somewhat limited interface. Limitations include having to extract all the files in a zip archive and not setting the extracted file’s Modify Date to its Modify Date in the archive.

If you declare the ZipExtractionClass in the declerations area of a Class Module or Form using the WithEvents keyword then you gain access to the Status, Progress and Error Events.

Usage

Add ZipExtractionClass.cls to your project and ensure that zlib.dll is reachable

Option Explicit

Private WithEvents zip As ZipExtractionClass

Public sub Unzip

   Set zip = New ZipExtractionClass
   If zip.OpenZip("C:\Test\Test.zip") Then
      If zip.Extract("C:Test\Extract", True, True) Then
         MsgBox "Zip files extracted successfully", vbInformation
      End If
      zip.CloseZip
   End If
   Set zip = Nothing

End Sub

Downloads

ZipExtractionClass.zip – contains: ZipExtractionClass.cls, Appnote.txt, ZLib.dll (45.0 kb)

ZipProject.zip – contains: A sample project using the ZipExtractionClass (60 kb)

Links

The ZLib home page where you’ll find the ZLib.dll: www.zlib.org

The PKZip File Format: www.pkware.com

Continue reading

HTTP Class

Implement HTTP POST and GET with the HHTP Class using the Wininet Library

This class simplifies using the Wininet Library to implement HTTP requests. Using this class it’s a piece of cake to POST Url-Encoded form data to a server.

This code has been revised (28 Aug 2003): There was an error in the URLEncode function where a hexed value was not necessarily 2 digits long. The SendRequest function has also been updated to download the request directly from the server by default (Reload).

This code has been revised (02 Sep 2003): The While loop for reading the returned data in SendRequest had faulty logic (changed to While r and (Read <> 0))

This code has been revised (29 Nov 2003): Updated OpenHTTP to both add the option to connect to any port and the ability to authenticate using basic authentication (plain text).

What it can’t do

  • Return Progress Messages
  • Return Detailed Error Messages
  • Return the Response Header

Usage

Add HTTPClass.cls to your project

   'Example: POST a Form

   Dim h As HTTPClass

   Set h = New HTTPClass

   h.Fields("Username") = "Andrew"
   h.Fields("Email") = "andrew@paradoxes.info"
   h.Fields("Password") = "Secret"

   If h.OpenHTTP("www.paradoxes.info") Then
      Debug.Print h.SendRequest("test.asp", "POST")
   End If

   Set h = Nothing

   'Example: Download an Image to file

   Dim fh As Long
   Dim h As HTTPClass

   Set h = New HTTPClass

   If h.OpenHTTP("www.paradoxes.info") Then
      fh = FreeFile
      Open App.Path & "\vbcode.jpg" For Binary As #fh
      Put #fh, , h.SendRequest("/pics/vbcode.jpg", "GET")
      Close #fh
   End If

   Set h = Nothing

Downloads

HTTPClass.zip – contains: HTTPClass.cls (1.9 kb)

Continue reading

Stack Class

Store Items with this simple Stack Class

Sometimes I need to hold a few items in a stack and use the Collection Object to do this. There’s no need of course, now that that Stack Class is here anyway. I’ve used a Variant array to hold the items so it can take strings, numbers, objects etc.

The buffer size is set to 100. If you’re intending to store a lot more than 100 items in the stack (say 1000) then you’ll want to adjust the buffer size to increase efficiency (as the Items array would be redimensioned 10 times).

Usage

Add StackClass.cls to your project

'Example 1

   Dim Stack as StackClass

   Set Stack = New StackClass

   Stack.Push 1
   Stack.Push 2
   Stack.Push 3

   Debug.Print Stack.Peek  'Prints 3
   Debug.Print Stack.Pop   'Prints 3
   Debug.Print Stack.Pop   'Prints 2
   Debug.Print Stack.Pop   'Prints 1

   Set Stack = Nothing


'Example 2

   Dim Stack as StackClass

   Set Stack = New StackClass

   Stack.Push 1
   Stack.Push 2
   Stack.Push 3

   While Stack.Count > 0
      Debug.Print Stack.Pop 'Prints 3, then 2, then 1
   Wend

   Set Stack = Nothing

Downloads

StackClass.zip – contains: StackClass.cls (717 bytes)

Continue reading

PropertyBag Class

Persist private objects with the PropertyBag Class

If you use the PropertyBag Object then you’ll know how indispensable it is. It does have some drawbacks though (primarily the lack of persistence for private object modules). My PropertyBag Class goes a long way towards fixing those drawbacks. I’ve added the ability to persist private object modules, to output to file (binary) or string (base64 encoded), to optionally compress the output using the zlib library, and I’ve managed to keep it compatible with the Microsoft’s PropertyBag!

I must give mention to Francesco Balena (see the links at the bottom of the page) whose article on the PropertyBag inspired me.

What it can do

  • Retains compatibility with Visual Basic’s built-in PropertyBag
  • Persist Private Class Modules using the IPropertyBagClass Interface
  • Save/Load the PropertyBagClass contents to file or string
  • Optionally compress the PropertyBagClass Contents using the ZLib dll

Usage

Add PropertyBagClass.cls and IPropertyBagClass.cls to your Project

'To persist a Private Object you need to Implement the IPropertyBag Class
'MyGameClass Object
Option Explicit

Implements IPropertyBagClass

Public Name As String
Public Score As Long
Public HitPoints As Long
Public Lives As Long

Public PosX As Long
Public PosY As Long

Private Sub IPropertyBagClass_ReadProperties(PropBag As PropertyBagClass)

   Name = PropBag.ReadProperty("Name", "")
   Score = PropBag.ReadProperty("Score", 0)
   HitPoints = PropBag.ReadProperty("HitPoints", 0)
   Lives = PropBag.ReadProperty("Lives", 0)

   PosX = PropBag.ReadProperty("PosX", 0)
   PosY = PropBag.ReadProperty("PosY", 0)

End Sub

Private Sub IPropertyBagClass_WriteProperties(PropBag As PropertyBagClass)

   PropBag.WriteProperty "Name", Name
   PropBag.WriteProperty "Score", Score
   PropBag.WriteProperty "HitPoints", HitPoints
   PropBag.WriteProperty "Lives", Lives

   PropBag.WriteProperty "PosX", PosX
   PropBag.WriteProperty "PosY", PosY

End Sub

'And to save it...

   Dim mg As MyGameClass
   Dim pb As PropertyBagClass

   Set pb = New PropertyBagClass
   pb.WriteProperty "MyGame", MyGame
   If Not pb.SaveToFile(Path, False, True) Then
      MsgBox "Couldn't save the file " & Path, vbExclamation
   End If
   Set pb = Nothing

'And to reload it...

   Dim mg As MyGameClass
   Dim pb As PropertyBagClass

   Set pb = New PropertyBagClass
   If pb.LoadFromFile(Path) Then
      Set mg = New MyGameClass
      'Note: When reading a private object you have to create an instance
      'of it first and pass it as the default parameter
      Set mg = pb.ReadProperty("MyGame", mg)
      Set MyGame = mg
      Set mg = Nothing
   Else
      MsgBox "Couldn't load the file " & Path, vbExclamation
   End If
   Set pb = Nothing

Downloads

PropertyBagClass.zip – contains: PropertyBagClass.cls, IPropertyBagClass.cls, zlib.dll (29.5 kb)

MyGame.zip – A simple project to demonstarte how to persist private objects (27.4 kb)

Links

Another good article on vbaccelerator about persisting objects/data to XML by Steve McMahon

Continue reading