Wrox conferences

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 .
Now you can use this syntax 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 :

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 :
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 :
About the arguments that are passed to BitBlt :
  1. picBack.hdc is the target control where the operation will take place .This has to be either a form or a picture box.
  2. X and Y are the coordinates within the target control where the operation will take place , always measured in pixels.
  3. picSprite.ScaleWidth , picSprite.ScaleHeight are the width and height that the region will have when painted on the target control.
  4. picSprite.hdc is the source control , the picture box that contains the bitmap that will be painted on the target control.
  5. The last two numbers seperated by commas are the coordinates within the source control from where the region will be copied.
  6. 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 :

The SaveSetting method is used to write data to the registry and it takes 3 arguments:
  1. 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.
  2. 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 .
  3. A string as the key of the data. This is used to retrieve it with the GetSetting method.
  4. 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 :

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

  2. Write the information of the arrays to a new file:

      Open "PHONES.TMP" For Output As #1
      For I=1 To N
        Write #1,Nam(I),Pn(I)
      Next
      Close #1

  3. 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.
  1. Load the image you want to tile in the picture box and set it's Visible property to false.
  2. Set the form's WindowState property to 2-Maximized.
  3. 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:
  1. Create a Timer control.
  2. Make these settings through the Properties Window:

      Form1.WindowStart = 2
      Form1.BackColor = &H00000000& 'black
      Timer1.Interval = 1

  3. 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.
  1. 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.

  2. 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:
    CD - 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:
  1. To provide a place for the project's title
  2. To allow the user to drag it around the screen
  3. 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.

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

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


















[ Main | Projects | Source Code | Links | Guestbook | Custom Controls | Stats | About Me | Email ]

1