‘Main Recursive Logic for solving Tower Of Hanoi
Private Sub SolveHanoi(strFrom As String, strTO As String, strUsing As String, NOD As Integer)
If StopHere Then Exit Sub
If NOD > 0 Then
SolveHanoi strFrom, strUsing, strTO, NOD – 1 ‘Step 1
If StopHere Then Exit Sub
txtOutput.Text = txtOutput.Text & vbCrLf & “Disk ” & NOD & ” Moved From ” & strFrom & ” To ” & strTO
If StopHere Then Exit Sub
Select Case strFrom ‘Step 2
Case “Left”:
ShowTransition strFrom, strTO, strUsing, intDiskFromPole(intFromPtr)
Case “Right”:
ShowTransition strFrom, strTO, strUsing, intDiskToPole(intToPtr)
Case “Middle”:
ShowTransition strFrom, strTO, strUsing, intDiskUsingPole(intUsingPtr)
End Select
If StopHere Then Exit Sub
If optStandard.Value Then
AddDelay
ElseIf optDynamic.Value Then
Pause 1 / NODisks
End If
If StopHere Then Exit Sub
SolveHanoi strUsing, strTO, strFrom, NOD – 1 ‘Step 3
End If
End Sub

‘Delay Loop
Private Sub AddDelay()
Dim i As Integer
Dim j As Integer

For i = 0 To 800
For j = 0 To 800
DoEvents
Next j
Next i
End Sub

‘Here Transitions are shown
Private Sub ShowTransition(strFrom As String, strTO As String, strUsing As String, NOD As Integer)
Dim i As Integer
Dim DiskNO As Integer

DiskNO = NOD
For i = 1 To NODisks
Line1(i).Visible = False
Next
AdjustNOD strFrom, -1, DiskNO
AdjustNOD strTO, 1, DiskNO
ShowDisks
End Sub

‘Refresh all componnets for net session of Hanoi solving
Private Sub RemoveAllObjects()
On Error GoTo EndHere
Dim i As Integer
For i = 1 To NODisks
Controls.Remove (“Lin” & (i + 1))
Next i
EndHere:
End Sub

‘Adjust individual Stacks correspoding to each pole
Private Sub AdjustNOD(strPole As String, AddRemove As Integer, DiskValue As Integer)
If AddRemove = -1 Then
Select Case strPole
Case “Left”:
intDiskFromPole(intFromPtr) = 0
intFromPtr = intFromPtr – 1
Case “Right”:
intDiskToPole(intToPtr) = 0
intToPtr = intToPtr – 1
Case “Middle”:
intDiskUsingPole(intUsingPtr) = 0
intUsingPtr = intUsingPtr – 1
End Select
ElseIf AddRemove = 1 Then
Select Case strPole
Case “Left”:
intFromPtr = intFromPtr + 1
intDiskFromPole(intFromPtr) = DiskValue
Case “Right”:
intToPtr = intToPtr + 1
intDiskToPole(intToPtr) = DiskValue
Case “Middle”:
intUsingPtr = intUsingPtr + 1
intDiskUsingPole(intUsingPtr) = DiskValue
End Select
End If
End Sub

‘Print Current Stacks
Private Sub ShowDisks()
Dim i As Integer

‘ In Case “Left”:
For i = 1 To intFromPtr
Line1(intDiskFromPole(i)).X1 = 240 + 150 * intDiskFromPole(i)
Line1(intDiskFromPole(i)).Y1 = 5160 – 200 * i
Line1(intDiskFromPole(i)).X2 = 2880 + 240 – 150 * intDiskFromPole(i)
Line1(intDiskFromPole(i)).Y2 = 5160 – 200 * i
Line1(intDiskFromPole(i)).Visible = True
Next
‘ In Case “Right”:
For i = 1 To intToPtr
Line1(intDiskToPole(i)).X1 = 6220 + 150 * intDiskToPole(i)
Line1(intDiskToPole(i)).Y1 = 5160 – 200 * i
Line1(intDiskToPole(i)).X2 = 2880 + 6220 – 150 * intDiskToPole(i)
Line1(intDiskToPole(i)).Y2 = 5160 – 200 * i
Line1(intDiskToPole(i)).Visible = True
Next
‘ In Case “Middle”:
For i = 1 To intUsingPtr
Line1(intDiskUsingPole(i)).X1 = 3200 + 150 * (intDiskUsingPole(i))
Line1(intDiskUsingPole(i)).Y1 = 5160 – 200 * i
Line1(intDiskUsingPole(i)).X2 = 2880 + 3200 – 150 * (intDiskUsingPole(i))
Line1(intDiskUsingPole(i)).Y2 = 5160 – 200 * i
Line1(intDiskUsingPole(i)).Visible = True
Next
End Sub

‘On Solve Click do this …….
Private Sub cmdSolve_Click()
On Error GoTo ErrorHandler
NODisks = CInt(lstValues.Text)

ReDim Line1(NODisks) As Line

ReDim intDiskToPole(NODisks) As Integer
ReDim intDiskFromPole(NODisks) As Integer
ReDim intDiskUsingPole(NODisks) As Integer

Dim i As Integer

Label3.Caption = “S O L V I N G …”

txtOutput.Text = “”

For i = 1 To NODisks
intDiskFromPole(i) = i
Set Line1(i) = Controls.Add(“vb.line”, “Lin” & (i + 1))
Line1(i).BorderStyle = 6
Line1(i).BorderWidth = 10
Line1(i).BorderColor = &HC0FFFF + Hex(i) * 50
Next

intFromPtr = NODisks
intToPtr = 0
intUsingPtr = 0

For i = 1 To intFromPtr
Line1(intDiskFromPole(i)).X1 = 240 + 150 * (intDiskFromPole(i))
Line1(intDiskFromPole(i)).Y1 = 5160 – 200 * i
Line1(intDiskFromPole(i)).X2 = 2880 – 150 * (intDiskFromPole(i))
Line1(intDiskFromPole(i)).Y2 = 5160 – 200 * i
Line1(intDiskFromPole(i)).Visible = True
Next
‘If NODisks >= 1 And NODisks <= 9 Then
If MsgBox("Press Yes To Solve Tower Of Hanoi ……", vbYesNo) = vbYes Then
MousePointer = vbHourglass
SolveHanoi "Left", "Right", "Middle", NODisks
If Not StopHere Then
MousePointer = vbNormal
MsgBox "DONE!"
End If
End If
If Not StopHere Then
RemoveAllObjects
Label3.Caption = txtRules
'txtInput.Text = ""
End If
'End If
Exit Sub
ErrorHandler:
If Err.Number = 13 Or Err.Number = 9 Then
MsgBox "Please Select a proper numeric value.", vbCritical, "TOH Error"
RemoveAllObjects
Label3.Caption = txtRules
'txtInput.Text = ""
End If
End Sub

Private Sub Form_Load()
StopHere = False
Label3.Caption = "* * * * * * * * R U L E S F O R T O W E R O F H A N O I * * * * * * * " & vbCrLf & vbCrLf & vbCrLf
Label3.Caption = Label3.Caption & "A B O U T S O L V E R … " & vbCrLf & vbCrLf
Label3.Caption = Label3.Caption & "This game has 3 poles FROM, TO and USING. There are N no of Disks in the FROM pole that has to be moved to the TO pole by using the USING Pole" & vbCrLf
Label3.Caption = Label3.Caption & "In any move of the game, a given pole has to have a Larger Disk under a Smaller Disk but not vice versa" & vbCrLf
Label3.Caption = Label3.Caption & "This Solver Solves the problem in minimum possible number of transitions" & vbCrLf & vbCrLf
Label3.Caption = Label3.Caption & "P L A Y I N G T H E S O L V E R … " & vbCrLf & vbCrLf
Label3.Caption = Label3.Caption & "1. The Number Of disks has to be between 1 to 9" & vbCrLf
Label3.Caption = Label3.Caption & "2. The Solver moves disk After a small interval of approx half a sec." & vbCrLf
Label3.Caption = Label3.Caption & "3. For Larger Number of Disks the solver will take considerable amount of time. So avoid large values such as 8 or 9 for quick play. Try them otherwise" & vbCrLf
Label3.Caption = Label3.Caption & "==========================================================================================================================" & vbCrLf & vbCrLf
Label3.Caption = Label3.Caption & "Input the Number Of Disks ……. and Press 'Solve' "

'txtInput.Text = ""
lstValues.Text = "1"
txtOutput.Text = ""
txtRules = Label3.Caption
optStandard.Value = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
StopHere = True
End Sub

Sub Pause(ByVal nSecond As Single)
'nSeconds should be the number of seconds you want the Pause to last
'(may be a decimal fraction .5)
Dim StartTime As Single
StartTime = Timer
Do While Timer – StartTime < nSecond
DoEvents 'Allows you to continue interacting with the rest of your program
' if we cross midnight, back up one day
If Timer < StartTime Then
' separating the numbers stops a nasty overflow error
StartTime = StartTime – 24 * 60 * 60
End If
Loop
End Sub

Private Sub Label3_Click()

End Sub

Private Sub datProducts_Validate(Action As Integer, Save As Integer)
Dim strMsg As String
Dim enumMsgResult As VbMsgBoxResult

If Save = True Or Action = vbDataActionUpdate _
Or mblnValidationFailed Or Action = vbDataActionAddNew Then
‘ One or more bound controls has changed or a previous validation failed,
‘ so verify that all fields have legal entries. If a field has an incorrect
‘ value, appenda string explaining the error to strMsg and set the focus
‘ to that field to facilitate correcting the error. We explain all
‘ errors encountered in a single message box.
strMsg = “”
If txtProductName.Text = “” Then
Utility.AddToMsg strMsg, “You must enter a Product name.”
txtProductName.SetFocus
End If

If strMsg “” Then
‘ We have something in the variable strMsg, which means that an error
‘ has occurred. Display the message. The focus is in the last
‘ text box where an error was found
enumMsgResult = MsgBox(strMsg, vbExclamation + vbOKCancel + _
vbDefaultButton1)

If enumMsgResult = vbCancel Then
‘Restore the data to previous values using the data control
datProducts.UpdateControls
mblnValidationFailed = False
Else
‘ Cancel the Validate event
Action = vbDataActionCancel
‘ Deny form Unload until fields are corrected
mblnValidationFailed = True
End If
Else
mblnValidationFailed = False
End If
End If

End Sub
Private Sub Form_Unload(Cancel As Integer)

‘ Don’t allow the unload until the data is validate or the
‘ update is cancelled
If mblnValidationFailed Then Cancel = True

End Sub
Private Sub mnuDataAdd_Click()

‘ Reset all controls to the default for a new record
‘ and make space for the record in the recordset copy
‘ buffer.
datProducts.Recordset.AddNew

‘Enable the save menu choice
mnuDataSave.Enabled = True

‘ Set the focus to the first control on the form
txtProductName.SetFocus
End Sub

Private Sub mnuDataDelete_Click()
Dim strMsg As String

‘Verify the deletion.
strMsg = “Are you sure you want to delete ” _
& IIf(txtProductName.Text “”, txtProductName.Text, _
“this record”) & “?”
If MsgBox(strMsg, vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then

‘ We really want to delete
datProducts.Recordset.Delete

‘ Make a valid record the current record and update the display.
datProducts.Recordset.MoveNext

‘ If we deleted the last record, move to the new last record
‘ because the current record pointer is not defined after
‘ deleting the last record, even though EOF is defined.
If datProducts.Recordset.EOF Then datProducts.Recordset.MoveLast
End If
End Sub

Private Sub mnuDataSave_Click()

‘ Invoke the update method to copy control contents to
‘ recordset fields and update the underlying table
datProducts.Recordset.Update
If datProducts.Recordset.EditMode dbEditAdd Then

‘ If we added move to the new record
datProducts.Recordset.MoveLast
End If

End Sub

Private Sub mnuEditUndo_Click()

‘ Undo all pending changes from form by copy recordset values
‘ to form controls
datProducts.UpdateControls

If datProducts.Recordset.EditMode = dbEditAdd Then

‘ Disable the menu save and cancel the update
datProducts.Recordset.CancelUpdate
mnuDataSave.Enabled = False
End If

End Sub

Private Sub mnuFileExit_Click()

Unload Me

End Sub

‘ form level variable used to store the selected parameter from the list
‘ in the keys combo box
Private m_lSelectedParameter As Long

‘ form level constant declarations used throughout the application to name
‘ the application and section when using the Get and Save settings methods
Private Const APPLICATION_TITLE = “VB6DBHT Chapter 11″
Private Const SECTION_NAME = “Jet 3.5″

Private Sub Form_Load()

‘ load all Jet Registry settings from application section fo the
‘ Windows Registry
LoadJetRegistryInformation APPLICATION_TITLE, SECTION_NAME

With cboKeys

‘ add all of the available parameters for the SetOption method

.AddItem “dbPageTimeout”
.AddItem “dbSharedAsyncDelay”
.AddItem “dbExclusiveAsyncDelay”
.AddItem “dbLockRetry”
.AddItem “dbUserCommitSync”
.AddItem “dbImplicitCommitSync”
.AddItem “dbMaxBufferSize”
.AddItem “dbMaxLocksPerFile”
.AddItem “dbLockDelay”
.AddItem “dbRecycleLVs”
.AddItem “dbFlushTransactionTimeout”

‘ select the first item in the combo box control
.ListIndex = 0

End With

End Sub

Private Sub cboKeys_Click()

Dim lDefaultSetting As Variant

With cboKeys

‘ get a long value from the text version of the key
m_lSelectedParameter = GetParameterFromKey(.Text)

‘ obtain the default setting for the key
lDefaultSetting = GetDefaultKeySetting(.Text)

‘ display the current setting from the applications Registry
‘ settings if there is one, otherwise, display the default
txtSetting = GetSetting(APPLICATION_TITLE, _
SECTION_NAME, _
.Text, _
lDefaultSetting)

End With

End Sub

Private Sub cmdClose_Click()

‘ end the application
Unload Me

End Sub

Private Sub cmdSave_Click()

‘ if there is an error, goto the code labeled by ERR_cmdSave_Click
On Error GoTo ERR_cmdSave_Click:

‘ constant declarations for expected errors
Const ERR_TYPE_MISMATCH = 13
Const ERR_RESERVED_ERROR = 3000

‘ attempt to set the DBEngine option for the given key
‘ an error will occur here if an incorrect setting data type is
‘ entered by the user
DBEngine.SetOption m_lSelectedParameter, GetValueFromSetting(txtSetting)

‘ if the SetOption method was successful, then save the new setting
‘ value in the application Registry section
SaveSetting APPLICATION_TITLE, SECTION_NAME, cboKeys.Text, txtSetting

‘ inform the user of the success
MsgBox “Change has been made.”, vbInformation, “Set Option”

Exit Sub

ERR_cmdSave_Click:

Dim sMessage As String

With Err

Select Case .Number

‘ wrong data type entered for key setting
Case ERR_TYPE_MISMATCH, ERR_RESERVED_ERROR:
sMessage = “Value is of incorrect format.”

‘ unexpected error, create a message from the error
Case Else:
sMessage = “ERROR #” & .Number & “: ” & .Description

End Select

End With

‘ inform the user of the error
MsgBox sMessage, vbExclamation, “ERROR”

‘ repopulate the setting text box with the current or default key
‘ setting and set focus to the text box

cboKeys_Click
txtSetting.SetFocus

End Sub

Private Sub cmdDelete_Click()

‘ remove the setting from the application section of the Windows
‘ Registry
DeleteSetting APPLICATION_TITLE, SECTION_NAME, cboKeys.Text

‘ refresh the setting text box with the default value
cboKeys_Click

‘ inform the user of the success
MsgBox “Key has been deleted.”, vbInformation, “Delete Key”

End Sub

——————–

‘Module

Option Explicit

Public Sub LoadJetRegistryInformation(sApplicationName As String, _
sSectionName As String)

‘ if there is an error, goto the code labeled by
‘ ERR_LoadJetRegistryInformation
On Error GoTo ERR_LoadJetRegistryInformation:

Dim vSettings As Variant
Dim nCount As Integer

‘ constant declaration for expected error
Const ERR_TYPE_MISMATCH = 13

‘ obtain all of the settings from the Registry section for the given
‘ application
vSettings = GetAllSettings(sApplicationName, sSectionName)

‘ set all of the options that were specified in the Jet 3.5 section for
‘ the current application
For nCount = 0 To UBound(vSettings, 1)

DBEngine.SetOption GetParameterFromKey _
(vSettings(nCount, 0)), _
GetValueFromSetting(vSettings(nCount, 1))

Next nCount

Exit Sub

ERR_LoadJetRegistryInformation:

With Err

Select Case .Number

‘ there was no settings specified in the Registry for the
‘ given application, just continue without displaying an
‘ error message
Case ERR_TYPE_MISMATCH:

‘ unexpected error, create a message from the error
Case Else:
MsgBox “ERROR #” & .Number & “: ” & .Description, _
vbExclamation, “ERROR”

End Select

End With

End Sub

Public Function GetValueFromSetting(vSetting As Variant) As Variant

‘ if the setting is a number, return a long, otherwise return a string

If (IsNumeric(vSetting)) Then
GetValueFromSetting = CLng(vSetting)
Else
GetValueFromSetting = CStr(vSetting)
End If

End Function

Public Function GetDefaultKeySetting(sKey As String) As Variant

‘ return the defualt key setting for the key specified

Select Case sKey

Case “dbPageTimeout”:
GetDefaultKeySetting = 5000

Case “dbSharedAsyncDelay”:
GetDefaultKeySetting = 0

Case “dbExclusiveAsyncDelay”:
GetDefaultKeySetting = 2000

Case “dbLockEntry”:
GetDefaultKeySetting = 20

Case “dbUserCommitSync”:
GetDefaultKeySetting = “Yes”

Case “dbImplicitCommitSync”:
GetDefaultKeySetting = “No”

Case “dbMaxBufferSize”:
GetDefaultKeySetting = 0

Case “dbMaxLocksPerFile”:
GetDefaultKeySetting = 9500

Case “dbLockDelay”:
GetDefaultKeySetting = 100

Case “dbRecycleLVs”:
GetDefaultKeySetting = 0

Case “dbFlushTransactionTimeout”:
GetDefaultKeySetting = 500

End Select

End Function

Public Function GetParameterFromKey(ByVal sKey As String) As Long

‘ return the correct constant for the given key

Select Case sKey

Case “dbPageTimeout”:
GetParameterFromKey = dbPageTimeout

Case “dbSharedAsyncDelay”:
GetParameterFromKey = dbSharedAsyncDelay

Case “dbExclusiveAsyncDelay”:
GetParameterFromKey = dbExclusiveAsyncDelay

Case “dbLockRetry”:
GetParameterFromKey = dbLockRetry

Case “dbUserCommitSync”:
GetParameterFromKey = dbUserCommitSync

Case “dbImplicitCommitSync”:
GetParameterFromKey = dbImplicitCommitSync

Case “dbMaxBufferSize”:
GetParameterFromKey = dbMaxBufferSize

Case “dbMaxLocksPerFile”:
GetParameterFromKey = dbMaxLocksPerFile

Case “dbLockDelay”:
GetParameterFromKey = dbLockDelay

Case “dbRecycleLVs”:
GetParameterFromKey = dbRecycleLVs

Case “dbFlushTransactionTimeout”:
GetParameterFromKey = dbFlushTransactionTimeout

End Select

End Function

Private Sub Command1_Click()

End Sub

Private Sub cmdMethod1_Click()
Dim thePath As String

thePath = InputBox(“What is the url to download the file?”, ” File Url”, “http://&#8221;)

‘The path has to be converted to Unicode
thePath = StrConv(thePath, vbUnicode)

DoFileDownload thePath
End Sub

Private Sub Command2_Click()

End Sub

Private Sub cmdMethod2_Click()
Dim retVal As Long ‘our return value
Dim theUrl As String ‘the url you want to download
Dim savePath As String ‘where you want to save the url
Dim pathExist As Long ‘will contain our path exist or not value

theUrl = InputBox(“What is the url you want to download?”, ” Url Path?”, “http://&#8221;)
If theUrl = “” Then Exit Sub

savePath = InputBox(“What is the path and filename to save the url to?”, ” Path and Filename to save”)
If savePath = “” Then Exit Sub

retVal = URLDownloadToFile(0, theUrl, savePath, 0, 0)

If retVal = 0 Then
MsgBox “File was downloaded successfully!”, vbExclamation, ” Download Successful”
Else
MsgBox “There was a error downloading the file. Make sure that the url is valid and try again!”, vbCritical, ” Error”
End If
End Sub

source:www.vbcodesource.com

Text=”Visual Basic, VB”

Print StrConv(text, vbProperCase)’ “Visual Basic, VB”

‘Private Declare Function GetDriveType Lib “kernel32″ Alias “GetDriveTypeA” (ByVal nDrive As String) As Long
‘Private Declare Function GetLogicalDriveStrings Lib “kernel32″ Alias “GetLogicalDriveStringsA” (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
‘Private Const DRIVE_REMOVABLE = 2
‘Private Const DRIVE_FIXED = 3
‘Private Const DRIVE_REMOTE = 4
‘Private Const DRIVE_CDROM = 5
‘Private Const DRIVE_RAMDISK = 6

‘Place the following code in under a command button or in a menu, etc…

Dim r&, allDrives$, JustOneDrive$, pos%, DriveType&
Dim CDfound As Integer
allDrives$ = Space$(64)
r& = GetLogicalDriveStrings(Len(allDrives$), allDrives$)
allDrives$ = Left$(allDrives$, r&)
Do
pos% = InStr(allDrives$, Chr$(0))
If pos% Then
JustOneDrive$ = Left$(allDrives$, pos%)
allDrives$ = Mid$(allDrives$, pos% + 1, Len(allDrives$))
DriveType& = GetDriveType(JustOneDrive$)
If DriveType& = DRIVE_CDROM Then
CDfound% = True
Exit Do
End If
End If
Loop Until allDrives$ = “” Or DriveType& = DRIVE_CDROM
If CDfound% Then
label1 = “The CD-ROM drive on your system is drive ” & UCase$(JustOneDrive$)
Else: label1 = “No CD-ROM drives were detected on your system.”
End If

Next

‘Source :www.example-code.com

mDate1 = CDate(“01-06-2002 7:38 am”)

‘ Add Hour To Add TimeOut
mDate2 = DateAdd(“h”, 9, mDate1)
mDate2 = DateAdd(“s”, 1800, mDate2)

‘ Add Over Time Amount!
mDate2 = DateAdd(“h”, 3, mDate2)
mDate2 = DateAdd(“s”, 1800, mDate2) ‘ & If There Time as 3:30 Or 5:30 then for 30 Use This Line

‘ Calculate Exact Time
mHour = DateDiff(“h”, mDate1, mDate2)
mDMint = DateDiff(“n”, mDate1, mDate2)
mhMint = Round(mHour – Int((mDMint / 60)), 0)
NetHr = (mHour – mhMint)

‘ Now Add Minits In Time
mMinits = Abs((NetHr * 60) – mDMint)
NetTime = NetHr + IIf((mMinits / 100) >= 0.3, 0.5, (mMinits / 100))

OverTimeAmount = (NetTime – 9.5)

End Sub

Sub SaveText(Lst As TextBox, file As String)
‘Call SaveText (Text1,”C:\Windows\System\Saved.txt”)
On Error GoTo error
Dim mystr As String
Open file For Output As #1
Print #1, Lst
Close 1
Exit Sub
error:
X = MsgBox(“There has been a error!”, vbOKOnly, “Error”)
End Sub

‘From:PulseWave

Private Type RECT
left                 As Integer
top                  As Integer
right                As Integer
bottom               As Integer
End Type

Private Type POINT
x                    As Long
y                    As Long
End Type

Private Declare Sub ClipCursor Lib “user32″ (lpRect As Any)
Private Declare Sub GetClientRect Lib “user32″ (ByVal hWnd As _
Long, lpRect As RECT)
Private Declare Sub ClientToScreen Lib “user32″ (ByVal hWnd As _
Long, lpPoint As POINT)
Private Declare Sub OffsetRect Lib “user32″ (lpRect As RECT, _
ByVal x As Long, ByVal y As Long)

Public Sub LimitCursorMovement(ctl As Object)

Dim client           As RECT
Dim upperleft        As POINT
Dim lHwnd As Long
On Error Resume Next
lHwnd = ctl.hWnd
If lHwnd = 0 Then Exit Sub
GetClientRect ctl.hWnd, client
upperleft.x = client.left
upperleft.y = client.top
ClientToScreen ctl.hWnd, upperleft
OffsetRect client, upperleft.x, upperleft.y
ClipCursor client
End Sub

Public Sub ReleaseLimit()
‘Releases the cursor limits
‘Be sure to call on unloading the form
ClipCursor ByVal 0&
End Sub

Private Sub cmdNormal_Click()
ReleaseLimit
End Sub

Private Sub cmdSetLimit_Click()
LimitCursorMovement Me
End Sub

Private Sub Form_Load()
ReleaseLimit

End Sub

Private Sub Form_Unload(Cancel As Integer)
ReleaseLimit
End Sub