These are nothing fancy,but I think they can help a beginner to begin thinking as a programmer.
For any comments or questions or if you want to contribute to the list,
email me.Novice or pro,you're welcomed to submit your own code examples.
*These files come from the
Microsoft® Knowledge Base .
How to move the mouse programmatically
It's ok if you go "hmmmm,why would I want to move the mouse through code , why can't I just...um..move it!" , it's a very
natural reaction . Sometimes though ,a programmer may find this usefull ...I guess ... :))
Anyway,we need to use two API calls (SetCursorPos and ClientToScreen) , define a user data type and write the procedure that will move the mouse
in the specified coordinates within a control that has a scale system .
Public Type POINTAPI
End Type
Declare Function ClientToScreen Lib "user32" ( _
ByVal hwnd As Long, _
lpPoint As POINTAPI) As Long
Declare Function SetCursorPos Lib "user32" ( _
ByVal X As Long, _
ByVal Y As Long) As Long
Public Sub MoveMouse(ByRef X As Single, ByRef Y As Single)
Dim pt As POINTAPI
pt.X = X
pt.Y = Y
ClientToScreen picContainer.hwnd, pt
SetCursorPos pt.X, pt.Y
End Sub
Now you can use this syntax
MoveMouse DestinationX,DestinationY
to move the mouse at the coordinates DestinationX,DestinationY within the control picContainer that has a HWND handle (can either be a form or a picture box).
Notice that the coordinates passed to the MoveMouse procedure are supposed to be of a Single data type , so you may need to use the Csng function to convert them.
Check out an example-project
How to BitBlt a sprite on the background
A sprite is a small bitmap that is used in a game . Sprites shoot, move, kick,
bleed and do just about everything you see in computer games. They usually are animated
, meening they consist of a sequence of frames that painted rapidly one over the other
create an animation. The main issue in working with sprites is how to paint
them on a background without an ugly rectangle around them. Let's take it slow:
A sprite is really just a BMP file that includes two pictures, the actual
sprite and it's mask. The mask is a black & white instanse of the sprite, the
background of the rectangle region is white and the pixels withing the sprite
are black.The method most commonly used
for painting sprites is the BitBlt API function. It is true that the
PaintPicture method can perform bitwise comparisson ,but who wants
to go through Visual Basic's runtime libraries when there is a way to
use the OS functions directly? (some people have compared the two methods
and found out that PaintPicture takes roughly 10 times as long! ).
Like all API functions , BitBlt needs to be declared as a VB function before
it can be used in the VB enviroment :
Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020
Private Const SRCERASE = &H440328
Private Const SRCINVERT = &H660046
Private Const SRCPAINT = &HEE0086
Private Const SRCAND = &H8800C6
We have also defined a few constants that will be passed to BitBlt
as the dwRop argument . Here's what we need from the development enviroment :
- A form (offcourse!)
- A picture box picSprite that contains the sprite bitmap
- A picture box picBack that contains the background that the
sprite will be painted on
Use the properties window to load the sprite bitmap and the background
picture in the two picture boxes and also set both their ScaleMode
properties to Pixel . The picture box that contains the sprite bitmap
doesn't have to be visible since we will "copy" the region we need with
BitBlt, so set AutoRedraw = True , Visible =
False and also Autosize = True . Now you're ready to paint the sprite on
picBack with two calls of the BitBlt function :
BitBlt picBack.hDC, X, Y, picSprite.ScaleWidth, picSprite.ScaleHeight / 2, picSprite.hDC, 0, picSprite.ScaleHeight / 2, SRCAND
BitBlt picBack.hDC, X, Y, picSprite.ScaleWidth, picSprite.ScaleHeight / 2, picSprite.hDC, 0, 0, SRCPAINT
About the arguments that are passed to BitBlt :
- picBack.hdc is the target control where the operation will take place .This has to be either a form or a picture box.
- X and Y are the coordinates within the target control where the operation will take place , always measured in pixels.
- picSprite.ScaleWidth , picSprite.ScaleHeight are the width and height that the region will have when painted on the target control.
- picSprite.hdc is the source control , the picture box that contains the bitmap that will be painted on the target control.
- The last two numbers seperated by commas are the coordinates within the source control from where the region will be copied.
- Finally , the dwRop argument can take any of the values we defined in the Declerations section ,depending on the bitwise operation
we want.
The first call of BitBlt paints the mask of the sprite on the background by copying only
the black pixels in the lower half of picSprite on picBack . The second BitBlt paints the actual sprite on the mask by
copying the non-black pixels in the upper half of picSprite on the white pixels of picBack . This is called a bitwise operation and it makes sure that there is no
ugly rectangle painted on the background .
Check out an example-project
How to implement a save game/load game option using the Windows registry
Before the 32bit Windows 95 became the standard OS, applications used INI files to store data that shouldn't be
accesible to the user from outside the program it self . It was very common for a
trial version of a program to use an INI file to store the times it has been accessed and
stop to work at a certain number of times . A more simple scenario is for a program
to use INI files to store settings that the user doesn't want to make over and over again .
Nowdays INI files have been replaced by the windows registry , consider it a place that
contains settings for all the applications installed on your hard drive . Visual Basic allows
you to easily read and write data to the registry ,providing you with an easy way to
store settings,data,numbers,strings that are not to be initialised every time the program launches.
Here's the code that executes when you click SAVE GAME in the GAME menu of my VB5 Tetris :
Private Sub mnuSaveGame_Click()
SaveSetting App.Title, "SavedGame", "Lines", Lines
SaveSetting App.Title, "SavedGame", "Score", Score
SaveSetting App.Title, "SavedGame", "Level", Level
MsgBox "Game Saved"
End Sub
The SaveSetting method is used to write data to the registry and it takes 3 arguments:
- A string as the name of the application that the data will be saved under . The registry contains data that come
from many different app's ,therefore you need to define a title . You should always pass the App.Title property in this argument.
- A string as the section of the application . You may use the registry to store different kinds of data
such as interface settings or usernames/passwords etc ,so you can have a better control over your data by storing it
in different sections .
- A string as the key of the data. This is used to retrieve it with the GetSetting method.
- The actual data that is to be stored . This can be any variable that is assigned text or numbers or even an expression ,a math function etc.
Now the code of the LOAD GAME menu option :
Private Sub mnuLoadGame_Click()
Lines = GetSetting(App.Title, "SavedGame", "Lines")
Score = GetSetting(App.Title, "SavedGame", "Score")
Level = GetSetting(App.Title, "SavedGame", "Level")
MsgBox "Game Loaded"
End Sub
The GetSetting method inputs the title of an application that has written data on the registry
,the section and key of a certain piece of data and returns the actual data that was written there with the SaveSetting method.
How to erase a single item from a sequential access file
Suppose you have created a sequential access file by the name PHONES.DAT that contains 4 lines,each one with two items: a string representing a name and an integer as the phone number.When you open that file with a text editor,it looks like this:
"Tony",8025624
"Nick",2820231
"Elen",9334669
"Mary",2299330
Erasing all the contents of the file is easy (you just open it for output) and so is adding data (append attribute),but deleting a single item or a specific number of items is kinda tricky.Suppose you want to delete the second record (that means the name and the number of the second line).
- Add Dim Nam(4) As String and Dim Pn(4) As Integer in the declerations.
Open the file for input and store every record - except the one you want erased - in two arrays:
Open "PHONES.DAT" For Input As #1
N=0
Do
N=N+1
Input #1,A,B
If A<>"Nick" And B<>"2820231" Then Nam(N)=A:Pn(N)=B
Loop Until Eof(1)
Close #1
- Write the information of the arrays to a new file:
Open "PHONES.TMP" For Output As #1
For I=1 To N
Next
Close #1
Delete the old file and rename the new one:
Kill "PHONES.DAT"
Name "PHONES.TMP" As "PHONES.DAT"
For a working example,
check out the source code of record data base.
How to tile an image on a form
The PaintPicture method can be used to tile any image on a form's background
and create a wallpaper out of it,just like the <BODY BACKGROUND> tag in HTML does.
All you need is the form and a picture box.
- Load the image you want to tile in the picture box and set it's Visible property to false.
- Set the form's WindowState property to 2-Maximized.
- type this code in the Form_Paint event:
For X=1 to Form1.Width Step Picture1.Width
For Y=1 to Form1.Height Step Picture1.Height
PaintPicture Picture1.Picture,X,Y
Next
Next
Yep,it's that easy...
How to draw a moving starfield
This example shows how to design a moving star field ,the standard animated background used in most
space shoot'em up games.You know,the one that asteroids of all kinds of
sizes zip by with various speeds,creating a 3D effect.Here we go:
- Create a Timer control.
- Make these settings through the Properties Window:
Form1.WindowStart = 2
Form1.BackColor = &H00000000& 'black
Timer1.Interval = 1
- The algorithm is quite simple actually. We have four arrays of 50 elements each.
Each array holds the value of a specific characteristic of each on of the 50 stars that move on the
screen . These are the coordinates X and Y , the speed Velocity and their size Size . We could have declared a new data type Stars and make the seperate arrays into
properties of the Stars data type ( Stars.X , Stars.Y , Stars.Size etc ) but it's my belief
that arrays work just fine form small tasks like this.
Dim X(50), Y(50), Velocity(50), Size(50) As Integer
Private Sub Form_Activate()
Randomize
For I = 1 To 50
X(I) = Int(Form1.Width * Rnd)
Y(I) = Int(Form1.Height * Rnd)
Velocity(I) = Int(500 - (Int(Rnd * 499)))
Size(I) = 16 * Rnd
Next
End Sub
Private Sub Timer1_Timer()
For I = 1 To 50
Circle (X(I), Y(I)), Size(I), BackColor
Y(I) = Y(I) + Velocity(I)
If Y(I) >= Form1.Height Then
Y(I) = 0
X(I) = Int(Form1.Width * Rnd)
End If
Circle (X(I), Y(I)), size(I) , vbWhite
Next
End Sub
Download the project
How to load a text file on a text box
A simple procedure can allow you to retrieve any text file from the hard disk
that hosts your application and show it's contents in a text box.
Dim Txt,TxtBox,Location As String
Public Sub Opening(Location)
Open Location For Input As #1
While Not Eof(1)
Line Input #1,Txt
TxtBox=TxtBox & Txt
If Not Eof(1) Then TxtBox=TxtBox & VbCrLf
Wend
Close #1
txtTEXT.Text=TxtBox
End Sub
For this to work,the multiline property of the text box (txtTEXT) must have the value True.
Location is a variable that contains the path of the file and the full filename including the extention,and
it must be assigned a value before calling the Opening procedure.
The hard part is how to assign the right string.Depending on the purpose of your
application you might want to either always open a certain file with a standard filename (a highscores data file for example)
or open a file that the user defines,kinda like the Open menu option of the windows notepad.If it's case one,
use the Form_Load event to assign the path and filename of the file to the form-level variable Location.
Otherwise,you have to create an interface for the user to input the path and filename.A simple unlocked,enabled text box will do the trick
but it presupposes that the user already knows the exact location.The elegant way to do this is by creating
a drive/folder-browsing mechanism,like the windows explorer.
You need a DriveListBox (Drive1),a DirListBox (Dir1),a FileListBox (File1) and the code to "link" them.
When the user double clicks on a folder in the DirListBox,the FileListBox control will show the files in that folder,and
ofcourse when he clicks on the filename,the text box will show the text.
Private Sub Drive1_Change()
On Error Goto 100
Dir1.Path=Drive1.Drive
Exit Sub
100 Drive1.Drive="c:"
End Sub
Private Sub Dir1.Change()
File1.Path=Dir1.Path
File1.Refresh
End Sub
Private Sub File1_Click(b)
Location=File1.Path & File1.Filename
Select Case Mid(Location,3,2)
Case Is "\\"
Loc1=Left(Location,3)
Loc2=Mid(Location,5,Len(Location)-4)
Location=Loc1 & Loc2
End Select
Call Opening(Location)
End Sub
If you click on a drive that is not valid,the program will switch
to C: to prevent crushing.
A faster way to load the text file in one step rather than one line at a time,is to use this syntax:
Dim FileNum As Integer
FileNum = Freefile ' The function FreeFile returns the next available file number
Open "textfile.txt" For Input As FileNum
txtText.Text = Input(LOF(FileNum), FileNum)
How to encrypt text
Text encryption can be done using several different algorithms.Áfter some
experimenting, the use of ASCII character codes seems to be the fastest
one.That's because the loop that will repeat over
and over for each character in the text consists of only 2 lines of code.
- Here's the encryption function :
Public Function Encrypt(ByVal Plain As String)
For I=1 To Len(Plain)
Letter=Mid(Plain,I,1)
Mid(Plain,I,1)=Chr(Asc(Letter)+1)
Next
Encrypt = Plain
End Sub
These 3 lines of code are the actual encryption algorithm.The counter I
represents the position of the character being enrypted in every loop.
Each character is replaced with the next one in the ASCII character codes.
If you want to decrypt the text,you must apply a function that will
replace each character with the previous one in the ASCII character codes,
meaning the character that existed in that position of the original text.
- Add the decryption function:
Public Function Decrypt(ByVal Encrypted As String)
For I=1 to Len(Encrypted)
Letter=Mid(Encrypted,I,1)
Mid(Encrypted,I,1)=Chr(Asc(Letter)-1)
Next
Decrypt = Encrypted
End Sub
This function when passed the variable Encrypted that contains
the encrypted text ,it will return it decrypted .
Now,the encryption and decryption of any text can be done by simply
passing it to these two functions . For example:
Print Encrypt("This is just an example")
would print "Uijt!jt!kvtu!bo!fybnqmf" in the active form,and
Print Decrypt("Uijt!jt!kvtu!bo!fybnqmf")
would print "This is just an example".
Download the example project
How to make a demo of your game
When you have created a game and you're ready to distirbute it or post it on the web,
you might want to add a demo option.A good idea is to show a brief demo of the
action when the game loads,like most commercial games do (ie Quake2).The main
issue in creating a demo that fully resembles a user playing the game ,is to somehow
emulate the user interface events - be it keyboard,mouse or console events.The
most obvious way to do this is by storing a consequence of keywords in a text file
and then have the progam translate these keywords as commands
from the user.As a matter of fact you can create this text file by simply playing
the game: In the procedure that handles user interface events (ie the Form_KeyDown event
procedure) add code that will assign a specific keyword to every key that is pressed
and then add this keyword to the demo text file.That text file should look something like
this:
"right" (you pressed the Right cursor key)
"fire" (Space Bar)
"left" (Left cursor key)
"left" (Left cursor key)
"fire" (Space bar)
"exit" (Esc)
When Demo mode is on, the program should open this file,read each element,generate
the proper event and then wait a random period of time before moving on to the
next element.The majority of games (except maybe turn-based strategy games) responds
to the user's commands in real time and it is somewhat loittering to emulate the
actual delay between these commands.This however is not a problem when creating
a demo because adding a random delay in between furfiling each command the program
inputs from the demo text file should generate equaly realistic results.
Here's the demo of a simple shoot'em up game
created this way.
How to sort a list of numbers
Let's suppose that we want to sort n numbers from smaller to greater.
The array that holds these numbers is Numbers(i) (1<=i<=n).
The key to this problem is to determine how many of the other numbers
each number is greater than . After we write that value to the array
GreaterThan(i) then each number will be in position GreaterThan(i) + 1 , in the
sorted list . (e.g. if a number is greater than two others than it will
be 3rd in the sorted list) . We need an additional array Repeat(i) that
will hold the number of times each number repeats (if any) in the list.
Dim Number(1 To n) As Long
Dim GreaterThan(1 To n) As Integer
Dim SortedNumber(1 To n) As Long
Dim Repeat(1 To n) As Integer
Public Sub SortNumbers()
For I=1 To n
For II=1 to n
'Compare every number of the unsorted list with all the other n - 1 numbers
If I <> II And Number(I) > Number(II)
Then GreaterThan(I) = GreaterThan(I) + 1
Next
Next
For I = 1 To n
If SortedNumber(GreaterThan(I) + 1) <> 0 Then
Repeat(I) = Repeat(I) + 1
SortedNumber(GreaterThan(I) + Repeat(I) + 1) = Number(I)
'
'..if there's already a number in the place that
'the number represented by the loop's
'counter should be then add it immediately
'after that one.
'(This will happen if a number repeats in the
'unsorted list.Ofcourse it doesn't matter which
'one of the identical numbers will go first in
'the sorted list.Makes sense doesn't it... :)
'
Else
SortedNumber(GreaterThan(I) + 1) = Number(I)
End If
Next
After this,the sorted list of the numbers is carried in the array SortedNumber(i).
Download the example-project
How to upload/download files via FTP
The Shell Function and a script file can help you perform simple
FTP actions with great ease and flexibility.A typical FTP session begins
with the command
FTP scriptfile.SCP xxx.xx.xx.xxx
where scriptfile is the name of a file that contains (in ASCII format)
the FTP commands that perform the actual transfers, and xxx.xx.xx.xxx the IP adress (or hostname) of
the remote server you wish to interact with.The most commonly used
commands are:
- change directory on the local machine
RCD - change directory on the remote machine
GET - download a file to the current local directory
SEND - upload a file to the current remote directory
SHELL- execute a system command on the remote system
EXIT - end the FTP session
The first two commands on the script file are standard: Username and Password,without
those you can't access a remote system.After these first two lines
you type the FTP commands.ie If you want to download a file from the remote
directory /images to the local directory \website ,the script file should look
something like this:
yourusername
yourpassword
CD c:\website
RCD /images
GET imagefile.jpg
EXIT
After you have written the script file (say Script.SCP), you need to call
Visual Basic's Shell function to access the DOS prompt and
perform the FTP session:
Call Shell("ftp c:\pathtoscript\Script.SCP xxx.xx.xx.xxx",Flag)
'Flag is a constant that determines the behaviour of the
'DOS window that will (or won't) pop up
Possible values for the Flag parameter of the Shell function are:
0 - Window is hidden and focus is passed to the hidden window.
1 - Window has focus and is restored to its original size and position.
2 - Window is displayed as an icon with focus.
3 - Window is maximized with focus.
4 - Window is restored to its most recent size and position. The currently active window remains active.
6 - Window is displayed as an icon. The currently active window remains active.
The only disadvantage of this method is that the transfers can't be asynchronous with
the program execution.So if for example you try to download a file and then immediately open
it with Visual Basic's methods,you will get a File Not Found error due to the fact that
the compiler went on executing the code after the Shell Function before the FTP session was completed.
How to "customise" your user's Favorites folder
The 32bit Windows operating system is based on ASCII files.You may open
a file that contains Windows settings using Visual Basic's sequential access
and alter it's content in the same way it is altered through Windows,the compenent that uses it will never know the difference.
For every Favorite page of the Internet Explorer,there is an ASCII file with a URL extention in the
Windows\Favorites directory.It looks like this:
[InternetShortcut]
URL=http://www.hostname/folder/filename.htm...
and sometimes it may have an additional third line that changes when the link
is modified.The filename of the URL file determines the name of the favorites link in the Favorites dropdown list of IE.
Here's the Visual Basic code to "manually" add a favorite page to the
user's archive:
Open "C:\WINDOWS\FAVORITES\Theo's VB site.URL" For Output as #1
Print #1,"[InternetShortcut]"
Print #1,"URL=http://www.forthnet.gr/ionikh/home.htm"
Close #1
Tada! Your user just decided that your home page qualifies for his favorites
archive ;) You can add this little snippet to any program that you distirbute
or have posted on the web so that more and more people will come to agree
that you have an outstanding home page that they should visit daily...Ofcourse
I have no responsibility for anyone's actions ;)
How to launch the default browser with a specific URL
There's an API call for everything,so here's one that will launch the
user's defalt internet browser and load the URL you specify in the Call
statement.The function is declared with ...
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
Public Const SW_SHOWNORMAL = 1
and you can call it with...
lReturn = ShellExecute(hWnd, "open", "http://www.your.url", vbNull, vbNull, SW_SHOWNORMAL)
where http://www.your.url is ...well,your URL :) Ofcourse if you want to provide an email link you can just
replace the URL with mailto:your.email.adress
How to drag a form with no titlebar
The title bar of a Visual Basic form has three purposes:
- To provide a place for the project's title
- To allow the user to drag it around the screen
- To contain the control box with the Minimize,Maximize buttons
Some developers want to have a graphical title (a logo) for their program on the top of the form,so
they hide the title by assigning the value 0 - None to the Form.Borderstyle property.
This ofcourse means that the form can't be draged or minimized,not unless we write the the code to do so,ourselves.First
we need a clickable control that will be the form's drag-handle.This may be a label,an image or even the form itself.We'll also
need two form-level variables that will hold the coordinates of the spot we clicked within the drag-handle:
Dim StartDragX,StartDragY As integer
Now we must put the code that will move the form around,in the Mouse_Move event of the drag-handle,but first lets
"get" the coordinates of the spot the user clicked:
Private Sub lblDragHandle_MouseDown(Button As Integer, Shift As Integer,X As Single, Y As Single)
StartDragX=X
StartDragY=Y
End Sub
Private Sub lblDragHandle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 0 Then Exit Sub 'Drag the form only if the user holds down the mouse button
With Form1
.Left = .Left - (StartDragX - X)
.Top = .Top - (StartDragY - Y)
End With
End Sub
If the left coordinate of the mouse pointer if smaller than the X coordinate of the spot we clicked to move the form,it means that we want to move it to the left.
So the property Form1.Left must have it's value reduced by StartDragX - X which is the horizontal dinstance between the two spots (the spot we clicked it and the spot that the Mouse_Move event fired)
on the control that serves as a drag-handle. If X is greater than StartDragX then the above statement is equal to
Form1.Left = Form1.Left - (-(X - StartDragX))
which means that Form1.Left increases,so the form is moved to the right.The same mechanism works for the vertical dinstace between the two spots.
Here's an example project that includes the above code
How to create a scrollable picture box
In order for a control to be able to scroll,we must put it in a container
that's smaller.Then we can use the vertical and horizontal scrollbar controls
to provide the user with an easy way to move the control inside it's container.
We need a picture box PicPicture with the AutoResize property set to true ,
a container-picture box picContainer and two scrollbar controls HScroll1,VScroll1.
The scrollbars should show on the form only if the picture loaded on
picPicture is bigger than picContainer.If for example the
user browses his drives and selects the picture with an Open Common Dialog Control,we
should add in the procedure that invoked the ShowOpen method :
picPicture.Picture = LoadPicture(CommonDialog1.FileName)
If picPicture.Width > picContainter.Width Then
HScroll1.Visible = True
HScroll1.Max = picPicture.Width
End If
If picPicture.Height > picContainer.Height Then
VScroll1.Visible = True
VScroll1.Max = picPicture.Height
End If
Now the code that will scroll the picture box:
Private Sub HScroll1_Scroll()
picPicture.Left = - HScroll1.Value
End Sub
Private Sub VScroll1_Scroll()
picPicture.Top = -VScroll1.Value
End Sub
The property Hscroll1.Value gets a value inbetween zero and Hscroll1.Max and it
defines the dinstance of the scrollbar's scroll-handle from the left edge (or top edge if it's a vertical scrollbar).
So if you scroll the scroll-handle to the right (or click the left arrow of the scrollbar) ,you expect the picture within the
containter to move to the left so that you'll see more of it's right side.That's why picPicture1.Left=-Hscroll1.Value.
Download the sample project
How to implement a progress bar
When your source code is doing a lengthy process on the background ,it's
a good idea to implement a progress bar.A progress bar is a moving
graphical shape that will provide
the user with a visual oversight of the progress,there for it should
slide proportionately with the progress of the lengthy loop.
The easiest way to implement a progress bar is with a picture box.The
width of this picture box picProgressBar should be equal to the number of loops in the process.
Here's what the loop might look like:
Dim Progress As Integer
For I = 1 To number of loops
...
...'lengthy loop code
...
Progress = (picProgressBar.ScaleWidth * I) / number of loops ' Calculate the length of the progress bar according to the progress of the loop
picProgressBar.Line (0,0) - (Progress,picProgressBar.Height),vbRed,BF
Next
You should set the BorderStyle property of picProgressBar to
1 - Fixed Single and the Appearance propery to 0 - Flat
and also make sure that the color in the Line method is easy distinguishable from the background
color of picProgressBar.The rectangular shape painted within the picture box by the Line method
will represent the progress of the loop.
Here's a sample-project
How to play a midi file by Larry Allen (
VB Universe)
I am going to show you how to play a midi file in Visual Basic 5.
We will start by creating a '.BAS' module. Go ahead and name this module 'modPlayMidi'.
Once we have this module created we will go ahead and declare the API functions needed in order to play the midi files. We will do this in the General Declarations area of our new module. Go ahead and enter the General Declarations area and enter in these API functions.
Declare Function mciSendString lib "winmm.dll" _
Alias "mciSendStringA" _
(ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long
Declare Function mciGetErrorString Lib "winmm.dll" _
Alias "mciGetErrorStringA" _
(ByVal dwError As Long, _
ByVal lpstrBuffer As String,_
ByVal uLength As Long) As Long
Declare Function GetShortPathName Lib "kernel32" _
Alias "GetShortPathNameA" _
(ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, _
ByVal cchBuffer As Long) As Long
The mciSendString API we use for opening, playing and closing the midi file.
We use the mciGetErrorString when we encounter errors with the mciSendString command.
Since the mciSendString doesn't like long filenames with spaces in it I've included the GetShortPathName API to convert a long pathname to a short one.
Now that we have our API functions declared we can go ahead and begin creating the OpenMidi, PlayMidi and CloseMidi procedures.
Public Sub OpenMidi()
Dim sFile As String
Dim sShortFile As String * 67
Dim lResult As Long
Dim sError As String * 255
'Set the path and filename to open. I am using the
'mcitest.mid which I found in my VB5 directory in
'the sub folders samples\comptool\mci
'I just copied it to this projects folder.
sFile = App.Path & "\mcitest.mid"
'The mciSendString API call doesn't seem to like'
'long filenames that have spaces in them, so we
'will make another API call to get the short
'filename version.
lResult = GetShortPathName(sFile, sShortFile, _
Len(sShortFile))
sFile = Left(sShortFile, lResult)
'Make the call to open the midi file and assign
'it an alias
lResult = mciSendString("open " & sFile & _
" type sequencer alias mcitest", ByVal 0&, 0, 0)
'Check to see if there was an error
If lResult Then
lResult = mciGetErrorString(lResult, sError, 255)
Debug.Print "open: " & sError
End If
End Sub
Public Sub PlayMidi()
Dim lResult As Integer
Dim sError As String * 255
'Make the call to start playing the midi
lResult = mciSendString("play mcitest", ByVal 0&, 0, 0)
'Check to see if there were any errors
If lResult Then
lResult = mciGetErrorString(lResult, sError, 255)
Debug.Print "play: " & sError
End If
End Sub
Public Sub CloseMidi()
Dim lResult As Integer
Dim sError As String * 255
'Make the call to close the midi file
lResult= mciSendString("close mcitest", "", 0&, 0&)
'Check to see if there were any errors
If lResult Then
lResult = mciGetErrorString(lResult, sError, 255)
Debug.Print "stop: " & sError
End If
End Sub
Lets see what these procedures do. The first procedure we entered was the OpenMidi procedure. The first thing the OpenMidi function does is set up the filename of the midi file that we are opening. Since the mciSendString doesn't like long filenames with spaces in it I found the GetShortPathName function which converts a long filename to a short one.
Now that we have a filename that is compatible with the mciSendString API we can go ahead and open the midi file. The mciSendString take four parameters. The first parameter, lpstrCommand, is the command string. The second parameter, lpstrReturnString, is used by the mciSendString API to return a string to you. You will not need this unless you want to retrieve the status of the midi file. The third parameter, uReturnLength, tells the mciSendString how large the lpstrReturnString parameter is. The last parameter, hwndCallback, is used for receiving messages back from the mci device. We won't be using it here because it is a little beyond the scope of this sample.
The parameter we want to focus on here is the lpstrCommand parameter. Here we pass a Command String to tell the mci device what to do. In this case we are opening the midi file. This command string is structured like this:
open [filename] type sequencer alias [aliasname]
What we are doing here is opening the file. We are also letting it know that the type of this file is a midi sequencer. And lastly we are giving this device an alias, otherwise we will have to make all other calls with the filename. Using an alias is just easier to read as you can see in the PlayMidi and CloseMidi procedures.
Finaly the OpenMidi procedure checks the return status of the mciSendString call. If the return is greater than zero then an error has occured. When this happens I am just printing it to the debug window.
The next two procedures are pretty easy to understand. In the PlayMidi we are making another call to the mciSendString but this time the command string is telling it to play the midi device we opened earlier. The close midi closes the midi file.
Now to test these procedures will will place two command buttons on a form. I have called these buttons cmdPlay, and cmdStop. In the click event of these buttons we will call the midi procedures we just entered.
Private Sub cmdPlay_Click()
OpenMidi
PlayMidi
End Sub
Private Sub cmdStop_Click()
CloseMidi
End Sub
You might want to call the
CloseMidi procedure from the
QueryUnload event also,just
to make sure that the midi will stop playing when the user terminates the application one way or the other :)
Download a the sample application that demonstrates playing a midi file.
How to built a ping-pong virus
Back in the 80's when there was no internet and people exchanged software
with floppies , viruses were a lot more of a threat. Most of these
programs that attached them selves to running applications , would show
you a splash screen informing you that your system has been infected and
that you are really hopeless . There was however one virus that was nothing
like that and that at some point got really popular - as contradictory as that may sound .It was totally
harmless but really annoying, especially if you had no sense of humour :)
This virus would pop up a little ball that moved around your screen and
bounced on the edges . That was the only sife effect, it did not harm the
user's system in any way . To build such a program with Visual Basic we need:
- A very small form (84x84 pixels) and the code to move it around and bounce it
on the edges
- A way to make the form bounce on top of every other window
- A way to disable Alt + Cntrl + Del (so that the whole thing qualifies for a virus :)
The first of the three sections can be done with plain VB5 code , we'll just
play with the Left and Top properties of the form in a
Timer1_Timer event.The other
two are a job for the Windows API , those powerful functions that allow us to do in a VB project , almost anything
that is possible in the Windows operating system.
- We'll use a module for the declaration and the procedures of the API functions.
'Declare the API function that makes
'the form stay on top
Private 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
Global Const SWP_NOMOVE = 2
Global Const SWP_NOSIZE = 1
Global Const HWND_TOPMOST = -1
Global Const HWND_NOTOPMOST = -2
Global Const FLOAT = 1, SINK = 0
'Declare the API that desables Alt+Cntrl+Del
'by convincing windows that a screen saver
'is running
Public Declare Sub 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)
'The procedure that makes the form stay on top
Sub FloatWindow(X As Integer, action As Integer)
' When called by a form:
'
' If action <> 0 makes the form float (always on top)
' If action = 0 "unfloats" the window.
Dim wFlags As Integer, result As Integer
wFlags = SWP_NOMOVE Or SWP_NOSIZE
If action <> 0 Then ' Float
Call SetWindowPos(X, HWND_TOPMOST, 0, 0, 0, 0, wFlags)
Else ' Sink
Call SetWindowPos(X, HWND_NOTOPMOST, 0, 0, 0, 0, wFlags)
End If
End Sub
'The procedure that disables Alt+Cntrl+Del
Sub DisableCtrlAltDelete(bDisabled As Boolean)
Dim X As Long
X = SystemParametersInfo(97, bDisabled, CStr(1), 0)
End Sub
- Now , let's type the code to move the form around.We'll need a timer Timer1 with it's interval set to 1
'These values of the integer MoveTo represent
'a moving direction for the bouncing ball
'
'1 - up left
'2 - up right
'3 - down right
'4 - down left
'
Dim X, Y As Long 'the coordinates of the ball
Dim MoveTo As Integer 'the direction of the ball
Private Sub Form_Load()
'Call the procedure that
'disables Alt+Cntrl+Del
Call DisableCtrlAltDelete(True)
'Call the procedure that makes the
'form stay on top
Dim f As Integer
f = Me.hWnd
Call FloatWindow(f, FLOAT)
'Initialize the values of the coordinates
'and select a random starting direction
X = Screen.Width / 2
Y = Screen.Height / 2
Form1.Left = X
Form1.Top = Y
Randomize
MoveTo = Int((4) * Rnd + 1)
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, _
UnloadMode As Integer)
'Before the application is terminated ,
'enable Alt+Cntrl+Del
Call DisableCtrlAltDelete(False)
End Sub
Private Sub Timer1_Timer()
'Move the ball towards it's current direction
'and bounce it towards the opposite direction
'if it reaches one of the screen's borders
Select Case MoveTo
Case 1
If X < 0 Then MoveTo = 2: Exit Sub
If Y < 0 Then MoveTo = 4: Exit Sub
Y = Y - 320
X = X - 320
Case 2
If X > Screen.Width - Form1.Width Then MoveTo = 1: Exit Sub
If Y < 0 Then MoveTo = 3: Exit Sub
Y = Y - 320
X = X + 320
Case 3
If X > Screen.Width - Form1.Width Then MoveTo = 4: Exit Sub
If Y > Screen.Height - Form1.Height Then MoveTo = 2: Exit Sub
Y = Y + 320
X = X + 320
Case 4
If X < 0 Then MoveTo = 3: Exit Sub
If Y > Screen.Height - Form1.Height Then MoveTo = 1: Exit Sub
Y = Y + 320
X = X - 320
End Select
Form1.Move X, Y
End Sub
Download the project
How to generate a series of non-repeating random numbers
In order for the RND function to generate non-repeating random
numbers we need to have an array that will hold the numbers
already generated. Then in the loop that will repeat N times for
N different random numbers we should apply an IF..THEN structure
that will check if the number selected is in the array and if so,we
should send the compiler back to the line with the RND function .
Private Numbers() As Integer
Private Sub GenerateNumbers(ByVal LB As Integer, ByVal UP As Integer, _
ByVal N As Integer)
If LB < 1 Or UP < 1 Or N < 1 Or LB > UP Or N > (UP - LB) Then
MsgBox "Wrong or invalid parameters" & vbCrLf & "Lower Bound: " & LB & _
vbCrLf & "Upper Bound: " & UP & vbCrLf & "Numbers to generate: " & N
Exit Sub
End If
ReDim Numbers(1 To N) As Integer
For randomnumber = 1 To N
GENERATE:
Randomize
r = Int(Rnd * ((UP - LB) + 1)) + LB
'cycle through all the previously generated numbers and check if this
'one is unique or not.
For I = 1 To randomnumber - 1
If Numbers(I) = r Then GoTo GENERATE
Next I
Numbers(randomnumber) = r
Next randomnumber
End Sub
After the procedure returns control , the non-repeating random numbers
are stored in the array Numbers. For example , the call of the
procedure with this syntax:
Call GenerateNumbers(1000,0,100)
will result in a 100 element array Numbers() that will contain 100
non-repeating random numbers from 1 to 1000.
Download the example-project