কোড ব্যাংক ভিজুয়াল বেসিক ৬

Visual Basic 6.0 Code Bank

-Team Error-

This is a collection of highly requested Visual Basic code that I put together back in 2013 and 2014. Almost all of these samples will work on fine on Visual Basic 6.0 .If you aren't able to find what you need here, you can search by keywords.

Visual Basic Code Bank
Code Title	Code Description
Add a Menu to Another Program	An example of how to add a menu to another program.
Beep like QBasic's Sound	This shows you how to set the frequency & duration of a beep sound (kinda like qbasic's sound function).
Center a Form	Check this code out if you want to know how to put your forms in the center of the screen.
Convert VB3 Forms to VB6 Forms	This will explain how to convert 16 bit Visual Basic forms to 32 bit Visual Basic forms.
Count Lines	This code shows you how to count the number of lines that are in a textbox.
Count the Times Loaded	This code shows you how to count the number of times the user has used your program.
Count Words	This code shows you how to count the number of words that are in a textbox.
Cut, Copy, Paste, & Undo	Ever wanted to use the cut, copy, paste, & undo commands in your program? Check this out.
Disable/Enable Ctrl+Alt+Del	This shows you how to use the Windows API to disable/enable ctrl+alt+del. This only works for Windows 95 and Windows 98.
Encrypt/Decrypt Text	This code will let you easily encrypt/decrypt strings of text.
Flip Picture	This is an example that shows you a fast way to flip a picture in a picturebox horizontally or vertically.
Font Lister	This code shows you one way on how you can add a list of all the fonts on your computer to a listbox.
Form Mover	This code will show you how to move a form with a label.
Get HTML Color	This example shows you how to get the HTML value of a color.
Get Your Computer's Name	This is some code that shows you how to get your computer's name (yep, it has a name).
Hex-Editor Related Code	VB probably isn't the best language to make a hex editor with, but here are some hex type examples anyway.
HTML Color Fade	This is a short example on how to fade one color into another with HTML tags.
HTML Color Fade Preview	This is an example on how to preview color faded text in a picturebox.
HTML Waving Text	This is an example on how to generate the HTML code for waving text.
Icons in System Tray	For some reason this is requested a lot, so I thought I'd put up an example on how to do it. This code only works in Windows 95 and Windows 98.
Kill Duplicate Items in a Listbox	Ever wanta get rid of all the duplicates that are in a listbox? This code shows you how.
Listbox Open	An example of how to open files to a listbox.
Listbox Save	An example of how to save the list inside of a listbox.
Macro Font Draw	This is a code example that shows you how to create an ASCII Art Font option for an ASCII Art Shop program.
Open Default Browser	This example shows you how to open up to a webpage using your default browser.
PictureBox Fade	This code shows you how to fade a picturebox from one color to another.
Play Midi	Shows you one way you can play a midi (*.mid) file.
Play Wav	Shows you one way you can play a wav file.
Random Numbers	This code shows you how to generate random numbers within a given range.
Replacing Text in a String	This code shows you one way to replace text within a string.
Resize it (Form Stretch)	This code lets you easily resize the controls on your form when you resize it. It creates a cool stretch effect.
Scramble	Shows you how to scramble words. This code is good for something like a Scrambler game.
Screen Saver Creation	This explains how to create screen savers in Visual Basic.
Score Keeper	This is a KeepScore function. It's for keeping score in games like Scrambler where points are usually kept in a listbox with people's names.
Select All the List Items	This shows you the fastest way to select all the items in a listbox (the Windows API way).
Set Windows Wallpaper	This code shows you how to set the wall paper for Windows.
Spell Checker	This is a code example that shows you how to make a spell checker for your VB programs! It works by calling up MSWord's spell checker to spell check your documents.
StayOnTop	This code will make your forms so they stay on top of all of the other windows on the screen.
Tile a Pic in the Background	This shows you how to tile a picture in the background of a form.
Timeout/Pause	This code will allow your program to use timeout statements, giving time for certain events to happen.
VB3 Interface for VB5/6	Just when you get used to VB3's interface, they change things up on you in VB5 and VB6. This explains how to set VB5/6's interface so it acts just like VB3.
Total	41 Code Examples

---

Add a Menu to Another Program

This code shows you how to add a menu to another program. The only thing is that nothing will happen when you click on the items. To make something happen when you click on an item you have to subclass the menu (I'd help with that but I don't have any subclassing controls, or at least not right now). Put this in your *.bas file:

Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long

Public Declare Function CreatePopupMenu Lib "user32" () As Long

Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long

Public Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long

Public Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long

Public Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long

Public Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long

Public 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 Const MF_ENABLED = &H0&

Public Const MF_POPUP = &H10&

Public Const MF_STRING = &H0&

Public Const WM_NCPAINT = &H85

Then put something like this in a button:

Dim newMenu As Long

newMenu = CreatePopupMenu

Call AppendMenu(newMenu, MF_ENABLED Or MF_STRING, 0, "Item One")

Call AppendMenu(newMenu, MF_ENABLED Or MF_STRING, 1, "Item Two")

Call AppendMenu(newMenu, MF_ENABLED Or MF_STRING, 2, "Item Three")

Call AppendMenu(newMenu, MF_ENABLED Or MF_STRING, 3, "Item Four")

Call AppendMenu(newMenu, MF_ENABLED Or MF_STRING, 4, "Item Five")

' Find the notepad application window

Dim notepad As Long

notepad = FindWindow("notepad", vbNullString)

' Add our menu to the window we found above

Dim notepadMenu As Long

notepadMenu = GetMenu(notepad)

Call AppendMenu(notepadMenu, MF_POPUP, newMenu, "Item List")

' Ensure that the user sees the new menu immediately

Call SendMessage(notepad, WM_NCPAINT, 0&, 0&)

---

Beep Function

This shows you how to set the frequency & duration of a beep sound. Put this in your *.bas file1:53 AM 8/19/2007:

Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

Put something like this in a button:

Dim ret As Long

ret = Beep(1500, 300)

Or, if you want to do something a little more fun, try this:

Dim ret As Long, i As Integer

For i = 0 To 4000 Step 100

    ret = Beep(i, 100)

Next

---

Center A Form

Here's how to center a form so it will appear in the middle of the screen, put this in a button:

Me.Top = (Screen.Height - Me.Height) / 2

Me.Left = (Screen.Width - Me.Width) / 2

---

Convert VB3 Forms to VB6 Forms

Here's how to convert old 16 bit VB froms into 32 bit VB forms: In a 16 bit version of VB (like VB3), select "File" from the menu, then click on "Save File As..." A dialog box will pop up. Look for a checkbox on that dialog box that says "Save as Text." Make sure that is checked. Once you do that, save the file. You should now be able to use that form in 32 bit versions of VB (like VB6).

---

Count the Lines of Text in a TextBox

This code will count how many lines of text there are in a string by counting the number of times the "carriage return" character shows up and adding one to that. This code will not count lines of text that wrap in a textbox. Put this code in a button:

Dim lineCount As Integer, pos As Integer, txt As String

lineCount = 0

pos = 1

txt = Text1.Text

Do While pos <> 0

    pos = InStr(pos + 1, txt, Chr$(13))

    lineCount = lineCount + 1

    DoEvents

Loop

MsgBox "Number of line(s) of text in text1.text: " + CStr(lineCount), 32, "Line Count"

---

Count the Number of Times a Program is Opened

This code shows you how to count the number of times your program is used. Place this function in your *.bas file:

Function getLoadedCount() As Double

    Dim programINI As String, countString As String, countNum As Double

    programINI = App.Path & App.EXEName & "_info.ini"

   

    ' See if an ini has been created, if not, create the file and set the

    ' number of times this program has been loaded to 1

    If Len(Dir(programINI)) = 0 Then

        ' Create an ini to hold the number of times the program is opened

        Open programINI For Output As #1

        Print #1, "Times Loaded: 1"

        Close #1

        countNum = 1

    Else

        ' Open the ini and see how many times the program has been opened

        If FileLen(programINI) <> 0 Then

            Open programINI For Input As #1

            Line Input #1, countString

            Close #1

        End If

        ' make sure the file has the correct format

        If Len(countString) < 15 Then

            countNum = 1

        Else

            countNum = Val(Mid(countString, 14)) + 1

        End If

        Open programINI For Output As #1

        Print #1, "Times Loaded: " & countNum

        Close #1

    End If

   

    getLoadedCount = countNum

End Function

Example on how to use this function, put something like this in the form load event:

Dim numTimes As Double

numTimes = getLoadedCount()

MsgBox "This program has been loaded: " & numTimes & " time(s)"

---

Count the Words in a TextBox

This code lets you count the number of words that are in a textbox (note this is very different from the len function which counts the number of characters in a string). Put these two functions in your *.bas file:

' This function determines if a given block of text is a "word".

' Below we say anything that starts with an alphabet character

' is a word.

Function isWord(str As String) As Boolean

    Dim ret As Boolean

    If str = Null Then

        ret = False

    ElseIf Len(str) = 0 Then

        ret = False

    ElseIf Mid(str, 1, 1) >= "A" And Mid(str, 1, 1) <= "Z" Then

        ret = True

    ElseIf Mid(str, 1, 1) >= "a" And Mid(str, 1, 1) <= "z" Then

        ret = True

    Else

        ret = False

    End If

    isWord = ret

End Function

' This function counts the number of words in a string.

' It does this by spliting the text into an array based on

' the space character and then checking to see which elements

' in the array are "words".

Function countWords(str As String) As Long

    Dim words() As String, i As Long, numWords As Long

    words = Split(str, " ")

    For i = LBound(words) To UBound(words)

        If isWord(words(i)) Then

            numWords = numWords + 1

        End If

    Next

    countWords = numWords

End Function

Then put something like this in a button:

Dim numWords As Long

numWords = countWords(Text1.text)

MsgBox "Total number of words in text1.text: " + CStr(numWords), vbInformation, "Number of Words"

---

Cut, Copy, Paste, & Undo

Ever wanted to use the cut, copy, paste, & undo commands in your program? Now you can, check this out:

Cut: (put this in a button)

Clipboard.SetText Text1.SelText

Text1.SelText = ""

Copy: (put this in a button)

Clipboard.SetText Text1.SelText

Paste: (put this in a button)

Text1.SelText = Clipboard.GetText(1)

Undo: (put this in your bas)

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 Const WM_UNDO = &H304

Put this in a button:

Call SendMessage(Text1.hwnd, WM_UNDO, 0&, 0&)

---

Disable/Enable Ctrl+Alt+Del

The following code only works in Windows 95 and Windows 98. Put this in your *.bas file:

Public Declare Function SystemParametersInfo Lib "User32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As String, ByVal fuWinIni As Long) As Long

Then put this in a button to disable c+a+d:

Call SystemParametersInfo(97, True, 0&, 0)

Then put this in a button to enable c+a+d:

Call SystemParametersInfo(97, False, 0&, 0)

---

Encrypting/Decrypting a String

Below is an example of a substitution cipher. Substitution ciphers can be broken by a cryptanalyst who knows what they're doing, so this method of encryption shouldn't be used if you want your data to be 99% secure. However, substitution ciphers will keep common users from being able to see your data. For high levels of security look into public key encryption and AES. To continue on, copy and paste the function below into your *.bas file:

Public Function Encrypt(text As String) As String

    Dim charSet1 As String, charSet2 As String, i As Long

    Dim pos As Long, encryptedChar, encryptedText

    charSet1 = " ?!@#$%^&*()_+|0123456789abcdefghijklmnopqrstuvwxyz.,-~ABCDEFGHIJKLMNOPQRSTUVWXYZ¿¡²³ÀÁÂÃÄÅÒÓÔÕÖÙÛÜàáâãäåض§Ú¥"

    charSet2 = " ¿¡@#$%^&*()_+|01²³456789ÀbÁdÂÃghÄjklmÅÒÓqÔÕÖÙvwÛÜz.,-~AàáâãFGHäJKåMNضQR§TÚVWX¥Z?!23acefinoprstuxyBCDEILOPSUY"

    For i = 1 To Len(text)

        pos = InStr(charSet1, Mid(text, i, 1))

        If pos > 0 Then

            encryptedChar = Mid(charSet2, pos, 1)

            encryptedText = encryptedText + encryptedChar

        Else

            encryptedText = encryptedText + Mid(text, i, 1)

        End If

    Next

    Encrypt = encryptedText

End Function

How to use this function:

To encrypt a word just put something like this in a button:

Text1.Text = Encrypt(Text1)

And then to unencrypt the word just call the function again!

Text1.Text = Encrypt(Text1)

---

Flip a Picture

This code demonstrates a fast way to flip a picture in a picturebox horizontally or vertically. Put this in your *.bas file:

Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

Public Const SRCCOPY = &HCC0020

Then put something like this in a button:

Picture1.scalemode = 3 ' pixels

'flip horizontal

Call StretchBlt(Picture1.hdc, Picture1.ScaleWidth, 0, Picture1.ScaleWidth * -1, Picture1.ScaleHeight, Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, SRCCOPY)

'flip vertically

Call StretchBlt(Picture1.hdc, 0, Picture1.ScaleHeight, Picture1.ScaleWidth, Picture1.ScaleHeight * -1, Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, SRCCOPY)

---

Add a List of Fonts to a Listbox

This isn't the fastest way to add all the fonts on your computer to a listbox, but it's the easiest. Put something like this in a button:

Dim x as integer

For x = 0 To Screen.FontCount - 1

    List1.AddItem Screen.Fonts(x)

Next

---

Move a Form With a Label

Copy this code into your *.bas file:

Global leftX

Global topY

How to Use:

Put this code in the label's MouseDown event:

Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    leftX = X

    topY = Y

End Sub

Put this code in the label's MouseMove event:

Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    If Button And 1 Then

        Me.Left = Me.Left + X - leftX

        Me.Top = Me.Top + Y - topY

    End If

End Sub

---

Get the HTML Value of a Color

This is an example that shows you how to get the html color value (ie, the hex value) of a color. You will need to add the Microsoft Common Dialog control to your project for this to work. Put this code in a button:

On Error GoTo handleError

Dim theColor As Long, red As String, green As String, blue As String

CommonDialog1.CancelError = True

CommonDialog1.ShowColor

theColor = CommonDialog1.Color

red = Hex(theColor And 255)

green = Hex(theColor \ 256 And 255)

blue = Hex(theColor \ 65536 And 255)

If Len(red) < 2 Then red = "0" & red

If Len(green) < 2 Then green = "0" & green

If Len(blue) < 2 Then blue = "0" & blue

MsgBox "The HTML color value is: #" & red & green & blue

handleError: Exit Sub

---

Get Your Computer's Name

Did you ever want to know what your computer's name was? Not me, but anyway, if you do want to know try this... Put this code in your *.bas file:

Public Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Then put something like this in a button:

Dim computerName As String

computerName = String(50, Chr(0))

Call GetComputerName(computerName, 50)

MsgBox "Your computer is named: " & computerName, 32, "Name"

---

Some Hex Related Codes...

Ok, this example code will show you how to open up an exe, copy it, replace strings in the copy with strings of your choice, and then make a new program with the new strings in it.

For this to work you need to have two textboxes on a form (named: txtProgInput and txtProgOutput) and two lists (named lstOldStrings and lstNewStrings). txtProgInput contains the name of program you're editing (like:"C:\somefile.exe") and txtProgOutput contains the name of the program you're making from this program. lstOldStrings contains a list of strings your replacing and lstNewStrings contains the list of what you're replacing them with. IMPORTANT NOTE: The length of the string you're replacing must be the same as the length of the string you're replacing it with, otherwise you'll get an error. Put this code in a button:

Dim inputProg As String, outputProg As String, filedata As String

Dim i As Long, pos As Long

inputProg = txtProgInput.text ' Program to Edit

outputProg = txtProgOutput.text ' Program to Make

' Make sure this file you want to edit exists

If Len(Dir$(inputProg)) = 0 Then

    MsgBox Chr(34) + inputProg + Chr(34) + " does not exist!", vbCritical, "Error"

    Exit Sub

End If

' Open the file to make and the file your making this file with

Open outputProg For Output As #1

    Open inputProg For Binary As #2

   

        Do While Not EOF(2)

            ' Grab the next 8000 characters out of the file

            filedata = Input$(8000, #2)

   

            ' Loop through all the items in the replacement listbox and replace the old strings

            ' with the new strings

            For i = 0 To lstOldStrings.ListCount - 1

                Do

                    pos = InStr(pos + 1, LCase$(filedata), LCase$(lstOldStrings.List(i)))

                    If pos <> 0 Then

                        filedata = Mid(filedata, 1, pos - 1) + lstNewStrings.List(i) + Mid(filedata, pos + Len(lstNewStrings.List(i)))

                    End If

                Loop Until pos = 0

            Next

   

            ' Print the new characters into the file you're making

            Print #1, filedata;

        Loop

       

    Close #2

Close #1

MsgBox Chr(34) + outputProg + Chr(34) + " has been created.", vbInformation, "Complete"

---

HTML Color Fading Example

HTML color values are stored in a hexadecimal format. Each HTML color value is divided into 3 parts: the color's amount of red, green, & blue - #FF0000. The amount of red a color can have is in the range of 0 to 255 (same goes for green & blue). So if you have 255 for red and 20 for blue and green, your color will be sort of redish looking.

Anyway, the following is an example on how to fade one color into another. Put this function in your *.bas file:

Function getColorValue(startVal As Long, stepVal As Double, stepNum As Long)

    Dim hexStr As String

    hexStr = Hex(startVal + (stepVal * stepNum))

    If Len(hexStr) < 2 Then

        hexStr = "0" + hexStr

    End If

    getColorValue = hexStr

End Function

Then put something like this in a button:

Dim red1 As Long, green1 As Long, blue1 As Long

Dim red2 As Long, green2 As Long, blue2 As Long

Dim i As Long, inputText As String, fadedText As String

Dim redStep As Double, greenStep As Double, blueStep As Double

inputText = "The text I want to fade!"

red1 = 255      ' The amount of red in color1

green1 = 0      ' The amount of green in color1

blue1 = 0       ' The amount of blue in color1

red2 = 0        ' The amount of red in color2

green2 = 0      ' The amount of green in color2

blue2 = 255     ' The amount of blue in color2

redStep = (red2 - red1) / (Len(inputText) - 1)

greenStep = (green2 - green1) / (Len(inputText) - 1)

blueStep = (blue2 - blue1) / (Len(inputText) - 1)

For i = 0 To Len(inputText) - 1

    fadedText = fadedText + "<font color""#" + getColorValue(red1, redStep, i) + getColorValue(green1, greenStep, i) + getColorValue(blue1, blueStep, i) + """>" + Mid(inputText, i + 1, 1) + "</font>"

Next

MsgBox fadedText

---

HTML Color Fading Preview Example

This example shows you how to create a fade preview of color faded text inside of a picturebox. You will need to add a picturebox control named "Picture1" to your form for this to work. Put this code in a button:

Dim red1 As Long, green1 As Long, blue1 As Long

Dim red2 As Long, green2 As Long, blue2 As Long

Dim i As Long, inputText As String, fadedText As String

Dim redStep As Double, greenStep As Double, blueStep As Double

Dim doWave  As Boolean, wavPos As Long

inputText = "The text I want to fade!"

red1 = 255      ' The amount of red in color1

green1 = 0      ' The amount of green in color1

blue1 = 0       ' The amount of blue in color1

red2 = 0        ' The amount of red in color2

green2 = 0      ' The amount of green in color2

blue2 = 255     ' The amount of blue in color2

redStep = (red2 - red1) / (Len(inputText) - 1)

greenStep = (green2 - green1) / (Len(inputText) - 1)

blueStep = (blue2 - blue1) / (Len(inputText) - 1)

Picture1.Cls

Picture1.CurrentX = 0

Picture1.CurrentY = 0

doWave = False ' If this is true then your preview will also preview waved text

' Loop through the text on letter at a time

For i = 0 To Len(inputText) - 1

    If doWave = True Then

        wavPos = wavPos + 1

        If wavPos > 4 Then wavPos = 1

        Select Case wavPos

        Case 1: Picture1.CurrentY = Picture1.CurrentY - 15

        Case 2: Picture1.CurrentY = Picture1.CurrentY + 15

        Case 3: Picture1.CurrentY = Picture1.CurrentY + 15

        Case 4: Picture1.CurrentY = Picture1.CurrentY - 15

        End Select

    End If

   

    Picture1.ForeColor = RGB(red1 + redStep * i, green1 + greenStep * i, blue1 + blueStep * i)

    Picture1.Print Mid$(inputText, i + 1, 1);

Next

---

How to Generate the HTML Code for ^Wa_viⁿg text

Just like the title says. Put this code in a button:

Dim i As Long, tagIndex As Integer, strWave As String

Dim inputText As String

ReDim waveHTML(1 To 4) As String ' array that holds html tags

inputText = "This is my input text!"

waveHTML(1) = "<sup>"

waveHTML(2) = "</sup>"

waveHTML(3) = "<sub>"

waveHTML(4) = "</sub>"

' Loop though the text one letter at a time

For i = 1 To Len(inputText)

    tagIndex = tagIndex + 1

    If tagIndex > 4 Then tagIndex = 1

    strWave = strWave & waveHTML(tagIndex) & Mid$(inputText, i, 1)

Next

' Make sure a closing tag is added

If Len(inputText) Mod 2 = 1 Then

    strWave = strWave & waveHTML(tagIndex + 1)

End If

MsgBox strWave

---

How to Put an Icon in the System Tray

This code did not work when tested in Windows XP. It was written for Windows 95/98.

This shows you how to put an icon in the system tray. It uses an icon stored in Picture1.picture as the icon. Put this in your *.bas file:

Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Public Const WM_MOUSEMOVE = &H200

Public Const NIM_ADD = &H0

Public Const NIM_DELETE = &H2

Public Const NIF_ICON = &H2

Public Const NIF_MESSAGE = &H1

Public Const NIF_TIP = &H4

Type NOTIFYICONDATA

        cbSize As Long

        hwnd As Long

        uID As Long

        uFlags As Long

        uCallbackMessage As Long

        hIcon As Long

        szTip As String * 64

End Type

Then put something like this in a button to add the icon to the tray:

Dim IconInfo As NOTIFYICONDATA

IconInfo.cbSize = Len(IconInfo)

IconInfo.hwnd = Me.hwnd

IconInfo.hIcon = Picture1.Picture

IconInfo.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP

IconInfo.uCallbackMessage = WM_MOUSEMOVE

IconInfo.szTip = "Mouseover Text" + Chr$(0)

Call Shell_NotifyIcon(NIM_ADD, IconInfo)

Put something like this in a button to remove the icon:

Dim IconInfo As NOTIFYICONDATA

IconInfo.cbSize = Len(IconInfo)

IconInfo.hwnd = Me.hwnd

Call Shell_NotifyIcon(NIM_DELETE, IconInfo)

---

Kill the Duplicates in a Listbox

This code loops though a list (List1) checking each item with every other item, then when it finds a duplicate it removes it. Put this code in a button:

Dim i As Long, X As Long, Y As Long

For i = 0 To List1.ListCount - 1

    For X = 0 To List1.ListCount - 1

        If X <> i Then

            If List1.List(i) = List1.List(X) Then

                List1.RemoveItem X

                X = X - 1

            End If

        End If

    Next

Next

Here's another way to do it, this way is somewhat faster and uses some Windows API functions (sent in by Sopon). First put this in your *.bas file:

Public Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long

Public Const LB_FINDSTRINGEXACT = &H1A2

Then make this a function in your *.bas file:

Public Function LBDupe(lpBox As ListBox) As Integer

    Dim nCount As Integer, nPos1 As Integer, nPos2 As Integer, nDelete As Integer

    Dim sText As String

    If lpBox.ListCount < 3 Then

        LBDupe = 0

        Exit Function

    End If

    For nCount = 0 To lpBox.ListCount - 1

        Do

            DoEvents

            sText = lpBox.List(nCount)

            nPos1 = SendMessageByString(lpBox.hwnd, LB_FINDSTRINGEXACT, nCount, sText)

            nPos2 = SendMessageByString(lpBox.hwnd, LB_FINDSTRINGEXACT, nPos1 + 1, sText)

                If nPos2 = -1 Or nPos2 = nPos1 Then Exit Do

            lpBox.RemoveItem nPos2

            nDelete = nDelete + 1

        Loop

    Next nCount

    LBDupe = nDelete

End Function

Then put something like this in a button:

Call LBDupe(List1)

---

Opening a File to a Listbox

This code shows you how to open a file to a listbox. Make sure you have a CommonDialog control added to your form. Put something like this in a button:

On Error GoTo handleError

Dim fileName As String, listItem As String

CommonDialog1.CancelError = True

CommonDialog1.Filter = "Text Files (*.txt)|*.txt"

CommonDialog1.FilterIndex = 0

CommonDialog1.ShowOpen

fileName = CommonDialog1.fileName

List1.Clear

Open fileName For Input As #1

    Do While Not EOF(1)

        Line Input #1, listItem

        If Not (listItem = "") Then

            List1.AddItem listItem

        End If

    Loop

Close #1

handleError: Exit Sub

---

Saving the List Inside of a Listbox

This code shows you how to save the contents of a listbox. Make sure you have a CommonDialog control added to your form. Put something like this in a button:

On Error GoTo handleError

Dim fileName As String, msgResult As VbMsgBoxResult, i As Long

CommonDialog1.CancelError = True

CommonDialog1.Filter = "Text Files (*.txt)|*.txt"

CommonDialog1.FilterIndex = 0

CommonDialog1.ShowSave

fileName = CommonDialog1.fileName

If Len(Dir(fileName)) <> 0 Then

    msgResult = MsgBox("This file already exists: """ + fileName + """, do you wish replace it?", vbYesNo, "Error")

    If msgResult = vbNo Then Exit Sub

End If

Open fileName For Output As #1

    For i = 0 To List1.ListCount - 1

        Print #1, List1.List(i) + Chr(13)

    Next

Close #1

handleError: Exit Sub

---

Macro Font Draw

AOL Macro Fonts allowed you to type in large ASCII art text, like you see below.

|\¯¯¯-¯)::)¯¯,¯\_':|¯¯¯¯¯¯¯||
:\|__|¯|°:/__/'\__\:|¯¯|__|¯¯|
::|__|¯::|__:|/\|__|':¯¯|__|¯¯

This code example shows you how to create a macro font feature for a Macro Shop / ASCII Art Shop program. It makes it so you can select a (*.pmf) file load it into a 2D array, and then have the output display when the user types text in an input textbox. You will need the following for this example to work:

txtInput - An input textbox named "txtInput". This is where the user types their input.
txtOutput - An output textbox named "txtOutput". This is where the output is displayed. This textbox should have it's multiline property set to true and it's font type set to "Arial" and point size set to 10.
CommonDialog1 - A common dialog control should be added to the project.

Put something like this in your *.bas file:

Global macroFontName As String

Global fontAuthor As String

Global macroFontSize As Integer

Global macroFont(1 To 27, 1 To 20) As String

Put something like this in the load a font button:

On Error GoTo handleError

Dim textInput As String, i As Integer, i2 As Integer

CommonDialog1.CancelError = True

CommonDialog1.Filter = "Macro Fonts (*.pmf)|*.pmf"

CommonDialog1.ShowOpen

macroFontName = CommonDialog1.fileName

Open macroFontName For Input As #1

    Line Input #1, textInput

    macroFontSize = Val(Mid$(textInput, 19))

    If macroFontSize < 1 Then Exit Sub

    Line Input #1, textInput

    fontAuthor = Mid$(textInput, 21)

    For i = 1 To 26

        For i2 = 1 To macroFontSize

            Line Input #1, textInput

            macroFont(i, i2) = textInput

        Next

    Next

    For i = 1 To macroFontSize

        macroFont(27, i) = " " & " " & " " & " " & " "

    Next

Close #1

handleError: Exit Sub

And then put something like this in the Change event of txtInput:

Dim i As Integer, i2 As Integer

Dim alphabet As String, pos As Integer, outputText As String

alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "

For i2 = 1 To macroFontSize

    For i = 1 To Len(txtInput.text)

        pos = InStr(alphabet, UCase(Mid$(txtInput, i, 1)))

        If pos <> 0 Then

            outputText = outputText + macroFont(pos, i2)

        End If

    Next

    outputText = outputText + Chr(13) + Chr(10)

Next

txtOutput.text = outputText

---

Open Up a Default Browser

This shows you how to open your default browser. Put this function in your *.bas file:

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Then put something like this in a button:

Dim ret As Long, theWebSite As String

theWebSite = "http://teamerror.org/"

ret = ShellExecute(Me.hwnd, "open", theWebSite, vbNullString, vbNullString, 3)

If ret < 32 Then MsgBox "There was an error when trying to open a default browser", vbCritical, "Error"

---

Picturebox Fade

This code will fade one color into another color in a picturebox. It's a nice tid-bit to keep in mind if you want to make your own title bar for a form. Put this in a button:

Dim xPos As Double, xLength As Double, yLength As Integer, i As Integer

Dim red1 As Integer, green1 As Integer, blue1 As Integer

Dim red2 As Integer, green2 As Integer, blue2 As Integer

Dim step1 As Double, step2 As Double, step3 As Double

Dim redVal As Double, greenVal As Double, blueVal As Double

Dim fadeLength As Integer

fadeLength = 100

' find the length of the picturebox and cut it into 100 pieces

xLength = Picture1.ScaleWidth / fadeLength

yLength = Picture1.ScaleHeight

' setting how much red, green, and blue goes into each of the two colors

red1 = 255

green1 = 0

blue1 = 0

red2 = 0

green2 = 0

blue2 = 255

' cut the difference between the two colors into 100 pieces

step1 = (red2 - red1) / (fadeLength - 1)

step2 = (green2 - green1) / (fadeLength - 1)

step3 = (blue2 - blue1) / (fadeLength - 1)

' set the c variables at the starting colors

redVal = red1

greenVal = green1

blueVal = blue1

' draw 100 different lines on the picturebox

For i% = 1 To fadeLength

   

    Picture1.Line (xPos, 0)-(xPos + xLength, yLength), RGB(redVal, greenVal, blueVal), BF

    xPos = xPos + xLength ' draw the next line one step up from the old step

   

    ' make the color value variable equal to it's next step

    redVal = redVal + step1

    greenVal = greenVal + step2

    blueVal = blueVal + step3

Next

---

Play a Midi File

Copy this function into your *.bas file:

Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

The following code can go in buttons to play/stop/pause/etc:

' Open a midi file

' IMPORTANT NOTE: Before a file can be played, it must be opened via

' the "open" command

Dim ret As Long

ret = mciSendString("open C:\Dancing_Queen.Mid type sequencer", 0&, 0, 0)

' Play a midi file

Dim ret As Long

ret = mciSendString("play C:\Dancing_Queen.Mid", 0&, 0, 0)

' Stop a midi file

Dim ret As Long

ret = mciSendString("stop C:\Dancing_Queen.Mid", 0&, 0, 0)

' Pause a midi file

Dim ret As Long

ret = mciSendString("pause C:\Dancing_Queen.Mid", 0&, 0, 0)

' Resume playing a midi file

Dim ret As Long

ret = mciSendString("resume C:\Dancing_Queen.Mid", 0&, 0, 0)

' Seek to a certain position within the file

' "start" and "end" can be used as keywords for positions to seek to

Dim ret As Long

ret = mciSendString("seek C:\Dancing_Queen.Mid to 500", 0&, 0, 0)

ret = mciSendString("play C:\Dancing_Queen.Mid", 0&, 0, 0)

' Get the length of the file in milliseconds

Dim numMSecs As String * 128

Dim ret As Long

ret = mciSendString("set C:\Dancing_Queen.Mid time format ms", 0&, 0, 0)

ret = mciSendString("status C:\Dancing_Queen.Mid length", numMSecs, Len(numMSecs), 0)

MsgBox "There are " & str(numMSecs) & " milliseconds"

' Get the length of the file in bytes

' This can compliment the seek command

Dim numBytes As String * 128

Dim ret As Long

ret = mciSendString("set C:\Dancing_Queen.Mid time format bytes", 0&, 0, 0)

ret = mciSendString("status C:\Dancing_Queen.Mid length", numBytes, Len(numBytes), 0)

MsgBox "There are " & str(numBytes) & " bytes"

' Alias

' IMPORTANT: This can make your life so much easier. Creating an

' alias will allow you to not have to remember the file name when using commands other than "Open".

' Example:

Dim ret As Long

ret = mciSendString("open C:\Dancing_Queen.Mid type sequencer alias theFile", 0&, 0, 0)

ret = mciSendString("play theFile", 0&, 0, 0)

' Always remember to CLOSE your midi file after you're done using it!!

' Otherwise you could give Windows memory problems

Dim ret As Long

ret = mciSendString("close C:\Dancing_Queen.Mid", 0&, 0, 0)

' Side note: I'm not really that big a fan of Abba, they're decent though. I picked dancing queen

' as the sample song because it was the first midi I found when I did a google for midis.

---

Play a Wav

This code will be the same as described in playing a midi file with one key difference. When opening a file, use "waveaudio" as the type. Example:

Dim ret As Long

ret = mciSendString("open C:\parent-teachernite.wav type waveaudio alias theFile", 0&, 0, 0)

---

Random Number Generater

This code lets you generate a random integer within a given range. Copy this function and paste it in your *.bas file:

Public Function RandomNumber(startNum As Integer, endNum As Integer) As Integer

    Randomize

    RandomNumber = Int(((endNum - startNum + 1) * Rnd) + startNum)

End Function

Example on how to use:

Dim x As Integer

x = RandomNumber(10, 20)

MsgBox x

"x" will be equal to a random integer in the range: [10, 20] (ie, between 10 and 20, including 10 and 20)

---

Replacing Text in a String

This small example on how to use the "Replace" function in Visual Basic 6.0. Originally this code used the Mid and Instr string functions, but since VB 6.0 you can simply use "Replace".

Dim text As String

text = "text text text, all you write is text"

text = Replace(text, "text", "pizza")

MsgBox text

How to use (put in button):

 Text1.text = RemoveSpaces(Text1)

---

Resizing a Form (an easy way)

This code lets you resize your forms with a neat stretch effect. Copy and paste the code as directed by the comments:

'-----------------------------------------------------

' Put this code in the public area of your form (ie, the top most part)

'-----------------------------------------------------

Private Type ScaleStruct

    Top As Integer

    Left As Integer

    Width As Integer

    Height As Integer

    ParentHeight As Integer

    ParentWidth As Integer

    FontSize As Integer

End Type

Dim Ctrl() As ScaleStruct

Dim minWidth As Integer

Dim minHeight As Integer

Dim maxWidth As Integer

Dim maxHeight As Integer

'-----------------------------------------------------

' Put this code in the Form_Load event

'-----------------------------------------------------

On Error Resume Next

Dim i As Integer

ReDim Ctrl(0 To Me.Controls.Count - 1)

Me.ScaleMode = 3

For i = 0 To Me.Controls.Count - 1

    Ctrl(i).Top = Me.Controls(i).Top

    Ctrl(i).Left = Me.Controls(i).Left

    Ctrl(i).Width = Me.Controls(i).Width

    Ctrl(i).Height = Me.Controls(i).Height

    Ctrl(i).ParentHeight = Me.Controls(i).Parent.ScaleHeight

    Ctrl(i).ParentWidth = Me.Controls(i).Parent.ScaleWidth

    Ctrl(i).FontSize = Me.Controls(i).FontSize

Next

' THESE VALUES ARE ARBITRARY

' Change them to best suit your program

' One tip would be to have a min size, but not a real

' max size (ie, make the maxes larger than what the

' screen size will ever be

minWidth = 400

minHeight = 400

maxWidth = 800

maxHeight = 800

'-----------------------------------------------------

' Put this code in the Form_Resize event

'-----------------------------------------------------

On Error Resume Next

Dim i As Integer

Dim ParentSH As Integer, ParentSW As Integer

ParentSH = Me.Controls(i).Parent.ScaleHeight

ParentSW = Me.Controls(i).Parent.ScaleWidth

For i = 0 To Me.Controls.Count - 1

    If Me.ScaleHeight >= minHeight And Me.ScaleHeight <= maxHeight Then

        Me.Controls(i).Top = Ctrl(i).Top * (ParentSH / Ctrl(i).ParentHeight)

        Me.Controls(i).Height = Ctrl(i).Height * (ParentSH / Ctrl(i).ParentHeight)

        Me.Controls(i).FontSize = Ctrl(i).FontSize * (ParentSH / Ctrl(i).ParentHeight)

        If Me.Controls(i).FontSize < 8 Then Me.Controls(i).FontSize = 8

        If Me.Controls(i).FontSize > 12 Then Me.Controls(i).FontSize = 12

    End If

   

    If Me.ScaleWidth >= minWidth And Me.ScaleWidth <= maxWidth Then

        Me.Controls(i).Left = Ctrl(i).Left * (ParentSW / Ctrl(i).ParentWidth)

        Me.Controls(i).Width = Ctrl(i).Width * (ParentSW / Ctrl(i).ParentWidth)

    End If

Next

---

Scramble a Series of Words

Here are a neat series of functions that will allow you to scramble each word in a sentence. This code would word well for a scrambler program. Put these functions your *.bas file:

' generates a random number in a given range

Public Function RandomNumber(startNum As Integer, endNum As Integer) As Integer

    Randomize

    RandomNumber = Int(((endNum - startNum + 1) * Rnd) + startNum)

End Function

' swaps two characters in a string

Public Function swap(text As String, pos1 As Integer, pos2 As Integer)

    Dim temp As String

    temp = Mid(text, pos1, 1)

    text = Mid(text, 1, pos1 - 1) + Mid(text, pos2, 1) + Mid(text, pos1 + 1)

    text = Mid(text, 1, pos2 - 1) + temp + Mid(text, pos2 + 1)

    swap = text

End Function

' scrambles a word

Public Function scrambleWord(ByVal text As String)

    Dim scrambleStrength As Integer, pos1 As Integer, pos2 As Integer

    Dim i As Integer

   

    ' probably doesn't need to be higher than this

    scrambleStrength = (Len(text) - 1) * 2

  

    For i = 0 To scrambleStrength

        pos1 = RandomNumber(1, Len(text))

        pos2 = RandomNumber(1, Len(text))

        text = swap(text, pos1, pos2)

    Next

 

    scrambleWord = text

End Function

Public Function scrambleInput(text As String)

    Dim words() As String, i As Integer

    words = Split(text, " ") ' split is a VB function for breaking a string into an array of strings

    For i = 0 To UBound(words)

        ' scramble each word

        words(i) = scrambleWord(words(i))

    Next

   

    ' output a string of the scrambled text

    scrambleInput = Join(words, " ")

End Function

Example on how to use these functions to scramble the words in a sentence:

Text1 = scrambleInput(Text1)

---

Screen Saver Creation

Here's what you do to make a screen saver: Start a new project. Set the windowstate property of the form to "2 - Maximized", and the border style of the form to zero. In the "KeyDown" event of the form put the "End" statement. Then in the mouse move event of the form put something like this:

Static ScreenSaverVar As Integer

ScreenSaverVar = ScreenSaverVar + 1

If ScreenSaverVar > 2 Then End

Now select "Make some_project_name.exe" in the file menu. When it asks you what you want to name the exe, add a "*.scr" extension to the end of the name (example: Blah.src). Then select the directory "c:\windows\system\" as the place to make this program. And there you go, you've made a screensaver which you can use on your desktop (note: you'll probably want to jazz up the form a little bit first).

Additional Info: (Provided by Mike Clem)

Try adding "SCRNSAVE: " in front of the name of your screen saver when compiling if you cannot get Windows to recognize that your creation is a screen saver. Example: "SCRNSAVE: Blah.SCR"

Problem of Windows not recognizing the Screen Saver occured in WFW 3.11 using VB 3.0.

---

Score Keeper

This is a KeepScore function. It's for keeping score is games like Scrambler where points are usually kept in a listbox with people's names. Code written by deep arctic.

Public Sub ScramblerKeepScore(ByRef lstList As ListBox, strPerson As String, intPoints As Integer)

   ' Written by deep arctic

    Dim strLastScore As String, strPreviousPerson As String

    Dim intIndex As Integer, strCount As String

    Dim intCount As Integer

    For intCount = 0 To lstList.ListCount - 1

        strCount = lstList.List(intCount)

        strPreviousPerson = Left(strCount, InStr(strCount, "-") - 2)

        If LCase(strPreviousPerson) = LCase(strPerson) Then

            intIndex = intCount

            strLastScore = Right(strCount, Len(strCount) - InStr(strCount, "-") - 1)

            strLastScore = Val(strLastScore) + intPoints

            lstList.List(intIndex) = strPerson & " - " & strLastScore

            Exit Sub

        End If

    Next intCount

    lstList.AddItem (strPerson & " - " & intPoints)

End Sub

Here is an example on how you can try this function out:

' List1 = the list you are keeping scores in

' txtName = a textbox containing the name of the person whose score you want to update

' txtPoints = a textbox containing the number of points you want to award this person

Call ScramblerKeepScore(List1, txtName.text, CInt(txtPoints.text))

' An helpful tip: In the properties window, set your score keeping listbox's "Sorted" property to "true"

---

Select All the List Items

This is an example that shows you how to select all of the list items in a listbox. This should work for any listbox window. Just make sure the listbox's multiselect property is set to "1 - Simple" in the properties window. Put something like this in your *.bas file:

Public 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 Declare Function SendMessageLong& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)

Public Const LB_GETCOUNT = &H18B

Public Const LB_SETSEL = &H185

Then put something like this in a button:

Dim listItems As Long

listItems = SendMessage(List1.hwnd, LB_GETCOUNT, 0&, vbNullString) - 1

Call SendMessageLong(List1.hwnd, LB_SETSEL, listItems, True)

---

Set the Picture For You Windows Wall Paper

This code shows you how to set the wall paper for windows, put something like this in you *.bas file:

Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long

Public Const SPI_SETDESKWALLPAPER = 20

Public Const SPIF_UPDATEINIFILE = &H1

Then put something like this in a button or in the form_load:

' The final parameter "SPIF_UPDATEINIFILE" tells us to save the changes (so our new wallpaper is sill with us on restart).

' Setting this parameter to 0 will cause us not to update the registery and wont save the wallpaper.

Dim thePic As String

thePic = "C:\some_image.bmp"

Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, thePic, SPIF_UPDATEINIFILE)

---

Spell Checker

Ever wanted a spell checker feature in one of your programs? Check this out, it calls up the MSWord's spell checker so you are able to spell check your documents! You need MSWord95 or better for this code to work. This example spell checks the text in a textbox named "Text1". Put this in a button:

On Error Resume Next

Dim WordSC As Object, pos As Integer

Set WordSC = CreateObject("Word.Basic")

WordSC.AppMinimize

WordSC.FileNewDefault

WordSC.EditSelectAll

WordSC.EditCut

WordSC.Insert Text1.text

WordSC.StartOfDocument

WordSC.ToolsSpelling

WordSC.EditSelectAll

Text1.text = WordSC.Selection

WordSC.FileCloseAll 2

WordSC.AppClose

Set WordSC = Nothing

If Mid(Text1.text, Len(Text1.text), 1) = Chr(13) Then

    Text1.text = Mid(Text1.text, 1, Len(Text1.text) - 1)

End If

pos = InStr(Text1.text, Chr(13))

Do While pos <> 0

    If Mid(Text1.text, pos + 1, 1) <> Chr(10) Then

        Text1.text = Mid(Text1.text, 1, pos) + Chr(10) + Mid(Text1.text, pos + 1)

    End If

    pos = InStr(pos + 1, Text1.text, Chr(13))

Loop

MsgBox "Spell Check Complete", vbInformation, "Spell Check"

---

Stay on Top Code

This makes a form stay on top of all other applications running in Windows. Put this code in your *.bas file:

Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Public Const SWP_NOMOVE = 2

Public Const SWP_NOSIZE = 1

Public Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE

Public Const HWND_TOPMOST = -1

Public Const HWND_NOTOPMOST = -2

Public Sub stayOnTop(frm As Form)

    Call SetWindowPos(frm.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)

End Sub

Public Sub removeFromTop(frm As Form)

    Call SetWindowPos(frm.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)

End Sub

Example on how to use (put this in the form's load event):

stayOnTop Me

Example on how to remove a form from being the top most window:

removeFromTop Me

---

Tile a Picture in the Background

This example shows you how to tile a picture in the background of a form. Put something like this in the form's load event:

Dim i As Integer, j As Integer

Me.AutoRedraw = True

Picture1.AutoSize = True

Picture1.BorderStyle = 0

Picture1.Visible = False ' we probably don't want this visible, right?

On Error Resume Next

For i = 0 To Me.ScaleWidth Step Picture1.ScaleWidth

    For j = 0 To Me.ScaleHeight Step Picture1.ScaleHeight

        Me.PaintPicture Picture1.Picture, i, j

    Next

Next

---

Timeout Code

This sub lets up create a pause in your programming code for whatever amount of seconds you tell it to pause for: (copy & paste is sub in your *.bas file)

Public Sub Timeout(duration As Double)

        Dim starttime As Double, x As Integer

        starttime = Timer

        Do While Timer - starttime < duration

               x = DoEvents()

        Loop

End Sub

Example on how to use (pause for one second):

Call Timeout(1)

Here's another way to do it, this way uses the Windows API (sent in by Sopon). First put this in your *.bas file:

Public Declare Function GetTickCount Lib "kernel32" () As Long

Then make this a sub in your bas:

Sub Pause(hInterval As Long)

        Dim hCurrent As Long

        hInterval = hInterval * 1000

        hCurrent = GetTickCount

        Do While GetTickCount - hCurrent < Val(hInterval)

               DoEvents

        Loop

End Sub

Example on how to use (pause for one second):

Call Pause(1)

---

VB3 Interface for VB5 and VB6

Here's how to give VB5/6 the VB3 interface: Select "Tools">"Options" from the menu. Then when the "Options" form pops up select the "Advanced" tab. Make sure the "SDI Development Environment" checkbox is checked, and click "OK". When you restart VB5/6, you should have the same kind of interface that you had with VB3.