Put Together By Affan Lubizst

This is a collection of highly requested 32 bit Visual Basic code that I put together back in 1998 and 1999.
Almost all of these samples will work on fine on Visual Basic 5.0 and for Microsoft Excel and Microsoft Access Programming (when done with VBA),
however, I've only made sure that they
work in VB6. Back in the day I used to answer a lot of questions and I frequented a lot of VB message boards.
I noticed that the same questions kept getting asked over and over again, so I started saving code that seemed
to be important.
95% of the code you'll find on this page was written by me, the other samples were either edited or submitted.
This guide does not claim to have the best answers, just answers that will get the job done. I hope you find
this guide helpful.
If you aren't able to find what you need here, you can check out the main programming section
for additional VB 6.0 code and tutorials.

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

Click Here to Return to the Programming Section

---

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&)

Back to the top of the page.

---

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

Back to the top of the page.

---

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

Back to the top of the page.

---

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).

Back to the top of the page.

---

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"

Back to the top of the page.

---

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)"

Back to the top of the page.

---

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"

Back to the top of the page.

---

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&)

Back to the top of the page.

---

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)

Back to the top of the page.

---

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)

Back to the top of the page.

---

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)

Back to the top of the page.

---

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

Back to the top of the page.

---

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

Back to the top of the page.

---

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

Back to the top of the page.

---

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"

Back to the top of the page.

---

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"

Back to the top of the page.

---

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

Back to the top of the page.

---

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

Back to the top of the page.

---

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

Back to the top of the page.

---

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)

Back to the top of the page.

---

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)

Back to the top of the page.

---

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

Back to the top of the page.

---

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

Back to the top of the page.

---

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 (a sample pmf file can be downloaded
here), 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

Back to the top of the page.

---

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://affan-hack.blogspot.com/"
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"

Back to the top of the page.

---

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

Back to the top of the page.

---

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.

Back to the top of the page.

---

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)

Back to the top of the page.

---

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)


Back to the top of the page.

---

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)

Back to the top of the page.

---

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

Back to the top of the page.

---

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)

Back to the top of the page.

---

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.

Back to the top of the page.

---

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"

Back to the top of the page.

---

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)

Back to the top of the page.

---

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)

Back to the top of the page.

---

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"

Back to the top of the page.

---

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

Back to the top of the page.

---

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

Back to the top of the page.

---

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)

Back to the top of the page.

---

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.

Back to the top of the page.