Animation-Part II

Animation using a DragDrop Procedure

Drag and drop is a common windows application where you can drag and drop an object such as a file into a folder or into a recycle bin. This capability can be easily programmed in visual basic. In the following example, I am creating a simulation of dragging the objects into a recycle bin, then drop a fire and burn them away.

In this program, I put 6 images on the form, one of them is a recycle bin, another is a burning recycle bin , one more is the fire, and three more images. In addition, set  the property dragmode of all the images( including the fire) that are to be dragged to  1(Automatic) so that dragging is enabled, and set the visible property of  burning recycle bin to false at start-up. Besides, label the tag of fire as fire in its properties windows. If you want to have better dragging effects, you need to load an appropriate icon under the dragIcon properties for those images to be dragged, preferably the icon should be the same as the image so that when you drag the image, it is like you are dragging the image along.

The essential event procedure  in this program is as follows:

Private Sub Image4_DragDrop(Source As Control, X As Single, Y As Single)

Source.Visible = False
If Source.Tag = "Fire" Then
Image4.Picture = Image5.Picture
End If

End Sub

Source refer to the image to be dragged. Using the code Source.Visible=False means it will disappear after being dragged into the recycle bin(Image4).If  the source is Fire, then the recycle bin will changed into a burning recycle bin , which is accomplished by using the code  Image4.Picture = Image5.Picture, where Image 5 is the burning recycle bin.

For details of this program, please refer to my game and fun programming page or click this link, Recycle Bin.

 

Animation for a complete motion

So far those examples of animation shown in lesson 23 only involve movement of static images. In this lesson, you will be able to create true animation where an action finish in a complete cycle, for example, a butterfly flapping its wings. In the following example, I used eight picture frames of a butterfly which display a butterfly flapping its wing at different stages.

You can actually copy the above images and use them in your program. You need to put all the above images overlapping one another,  make image1 visible while all other images invisible at start-up. Next, insert a command button and label it as Animate. Click on the command button and key in the statements that make the images appear and disappear successively by using the properties image.visible=true and image.visible=false. I use If..... Then and Elseif to control the program flow. When you run the program, you should be able to get the following animation.

The Interface

 

The Code

Private Sub Command1_Click()

If Image1.Visible = True Then
Image1.Visible = False
 Image2.Visible = True
ElseIf Image2.Visible = True Then
Image2.Visible = False
Image3.Visible = True
ElseIf Image3.Visible = True Then
Image3.Visible = False
Image4.Visible = True
ElseIf Image4.Visible = True Then
Image4.Visible = False
Image5.Visible = True
ElseIf Image5.Visible = True Then
Image5.Visible = False
Image6.Visible = True
ElseIf Image6.Visible = True Then
Image6.Visible = False
Image7.Visible = True
ElseIf Image7.Visible = True Then
Image7.Visible = False
Image8.Visible = True
ElseIf Image8.Visible = True Then
Image8.Visible = False
Image1.Visible = True
End If

End Sub

If you wish to create the effect of the butterfly flapping its wing and flying at the same time, then you could use the Left and Top properties of an object, such as the one used in the examples of lesson 23. Below is an example of a subroutine where the butterfly will flap its wing and move up at the same time. You can also write subroutines that move the butterfly to the left, to the right and to the bottom.

Sub move_up( )

If Image1.Visible = True Then
Image1.Visible = False
Image2.Visible = True
Image2.Top = Image2.Top - 100

ElseIf Image2.Visible = True Then
Image2.Visible = False
Image3.Visible = True
Image3.Top = Image3.Top - 100

ElseIf Image3.Visible = True Then
Image3.Visible = False
Image4.Visible = True
Image4.Top = Image4.Top - 100
ElseIf Image4.Visible = True Then
Image4.Visible = False
Image5.Visible = True
Image5.Top = Image5.Top - 100
ElseIf Image5.Visible = True Then
Image5.Visible = False
Image6.Visible = True
Image6.Top = Image6.Top - 100

ElseIf Image6.Visible = True Then
Image6.Visible = False
Image7.Visible = True
Image7.Top = Image7.Top - 100

ElseIf Image7.Visible = True Then
Image7.Visible = False
Image8.Visible = True
Image8.Top = Image8.Top - 100
ElseIf Image8.Visible = True Then
Image8.Visible = False
Image1.Visible = True
Image1.Top = Image1.Top - 100
End If

End Sub

Readmore...

Animation-Part III

Animation using Timer

All preceding examples of animation that you have learn in lesson 23 and lesson 24 only involve manual animation, which means you need to keep on clicking a certain command button or pressing a key to make an object animate. In order to make it move automatically, you need to use a timer. The first step in creating automatic animation is to drag the timer from the toolbox into the form and set its interval to a certain value other than 0. A value of 1 is 1 milliseconds which means a value of 1000 represents 1 second. The value of the timer interval will determine the speed on an animation.
In the following example, I use a very simple technique to show animation by using the properties Visible=False and Visible=true to show and hide two images alternately. When you click on the program, you should see the following animation.

The Code Private Sub Timer1_Timer() If Image1.Visible = True Then Image1.Visible = False Image2.Visible = True ElseIf Image2.Visible = True Then Image2.Visible = False Image1.Visible = True End If End Sub

Next example shows a complete cycle of a motion such as the butterfly flapping its wing. Previous examples show only manual animation while this example will display an automatic animation once you start the program or by clicking a command button. Similar to the example under lesson 24.2, you need to insert a group of eight images of a butterfly flapping its wings at different stages. Next, insert a timer into the form and set the interval to 10 or any value you like. Remember to make image1 visible while other images invisible at start-up. Finally, insert a command button, rename its caption  as Animate and key in the following statements by double clicking on this button. Bear in mind that you should enter the statements for hiding and showing the images under the timer1_timer subroutine otherwise the animation would work. Clicking on the animate button make timer start ticking and the event will run after every interval of 10 milliseconds or whatever interval you have set at design time. In future lesson, I will show you how to adjust the interval at runtime by using a slider bar or a scroll bar. When you run the program, you should see the following animation:

Private Sub Form_Load() Image1.Visible = True x = 0 End Sub Private Sub Command1_Click() Timer1.Enabled = True End Sub Private Sub Timer1_Timer() If Image1.Visible = True Then Image1.Visible = False Image2.Visible = True ElseIf Image2.Visible = True Then Image2.Visible = False Image3.Visible = True

ElseIf Image3.Visible = True Then Image3.Visible = False Image4.Visible = True ElseIf Image4.Visible = True Then Image4.Visible = False Image5.Visible = True ElseIf Image5.Visible = True Then Image5.Visible = False Image6.Visible = True ElseIf Image6.Visible = True Then Image6.Visible = False Image7.Visible = True ElseIf Image7.Visible = True Then Image7.Visible = False Image8.Visible = True ElseIf Image8.Visible = True Then Image8.Visible = False Image1.Visible = True End If End Sub

Readmore...

Animation-Part I

Animation is always an interesting and exciting part of programming. Although visual basic is not designed to handle advance animations, you can still create some interesting animated effects if you put  in some hard thinking. There are many ways to create animated effects in VB6, but for a start we will focus on some easy methods.

The simplest way to create animation is to set the VISIBLE property of a group of images or pictures or texts and labels to true or false by triggering a set of events such as clicking a button. Let's examine the following example:

This is a program that create the illusion of moving the jet plane in four directions, North, South ,East, West. In order to do this, insert five images of the same picture into the form. Set the visible property of the image in the center to be true while the rest set to false. On start-up, a user will only be able to see the image in the center. Next, insert four command buttons into the form and change the labels to Move North, Move East, Move West and Move South respectively. Double click on the move north button and key in the following procedure:

Sub Command1_click( )

Image1.Visible = False
Image3.Visible = True
Image2.Visible = False
Image4.Visible = False
Image5.Visible = False

End Sub

By clicking on the move north button, only image 3 is displayed. This will give an illusion that the jet plane has moved north. Key in similar procedures by double clicking other command buttons. You can also insert an addition command button and label it as Reset and key in the following codes:

Image1.Visible = True
Image3.Visible = False
Image2.Visible = False
Image4.Visible = False
Image5.Visible = False

Clicking on the reset button will make the image in the center visible again while other images become invisible, this will give the false impression that the jet plane has move back to the original position.

You can also issue the commands using a textbox, this idea actually came from my son Liew Xun (10 years old). His program is shown below: Private Sub Command1_Click() If Text1.Text = "n" Then Image1.Visible = False Image3.Visible = True Image2.Visible = False Image4.Visible = False Image5.Visible = False ElseIf Text1.Text = "e" Then Image1.Visible = False Image4.Visible = True Image2.Visible = False Image3.Visible = False Image5.Visible = False ElseIf Text1.Text = "w" Then Image1.Visible = False Image3.Visible = False Image2.Visible = False Image4.Visible = False Image5.Visible = True ElseIf Text1.Text = "s" Then Image1.Visible = False Image3.Visible = False Image2.Visible = True Image4.Visible = False Image5.Visible = False End If End Sub	Another simple way to simulate animation in VB6 is by using the Left and Top properties of an object. Image.Left give the distance of the image in twips from the left border of the screen, and Image.Top give the distance of the image in twips from the top border of the screen, where 1 twip is equivalent to 1/1440 inch. Using a statement such as Image.Left-100 will move the image 100 twips to the left, Image.Left+100 will move the image 100 twip away from the left(or 100 twips to the right), Image.Top-100 will move the image 100 twips to the top and Image.Top+100 will move the image 100 twips away from the top border (or 100 twips down).Below is a program that can move an object up, down. left, and right every time you click on a relevant command button.   The Code Private Sub Command1_Click() Image1.Top = Image1.Top + 100 End Sub Private Sub Command2_Click() Image1.Top = Image1.Top - 100 End Sub Private Sub Command3_Click() Image1.Left = Image1.Left + 100 End Sub Private Sub Command4_Click() Image1.Left = Image1.Left - 100 End Sub
The fourth example let user magnify and diminish an object by changing the height and width properties of an object. It is quite similar to the previous example. The statements  Image1.Height = Image1.Height + 100  and Image1.Width = Image1.Width + 100 will increase the height and the width of an object by 100 twips each time a user click on the relevant command button. On the other hand, The statements  Image1.Height = Image1.Height - 100  and Image1.Width = Image1.Width -100 will decrease the height and the width of an object by 100 twips each time a user click on the relevant command button	The Code Private Sub Command1_Click() Image1.Height = Image1.Height + 100 Image1.Width = Image1.Width + 100 End Sub Private Sub Command2_Click() Image1.Height = Image1.Height - 100 Image1.Width = Image1.Width - 100 End Sub You can try to combine both programs above and make an object move and increases or decreases in size each time a user click a command button.

Readmore...

Add 3D Line Under The Menu

'Add 1 Frame and 1 Menu to your Form.
'Insert the following code to your form:
Private Sub Form_Load()
Frame1.Caption = ""
Frame1.Height = 30
Frame1.Width = Screen.Width + 100
Frame1.Move -50, 0
End Sub

Readmore...

Disable Text Box Pop Up Menu

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 1 Text Box to your form.
'Insert this code to the module :
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_WNDPROC = -4
Public Const WM_RBUTTONUP = &H205
Public lpPrevWndProc As Long
Private lngHWnd As Long

Public Sub Hook(hWnd As Long)
lngHWnd = hWnd
lpPrevWndProc = SetWindowLong(lngHWnd, GWL_WNDPROC, _
AddressOf WindowProc)
End Sub

Public Sub UnHook()
Dim lngReturnValue As Long
lngReturnValue = SetWindowLong(lngHWnd, GWL_WNDPROC, lpPrevWndProc)
End Sub

Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam _
As Long, ByVal lParam As Long) As Long
Select Case uMsg
Case WM_RBUTTONUP
'You can put here your own popup menu.
Case Else
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Select
End Function

'Insert the following code to your form:
Private Sub Form_Load()
'Replace 'Text1' with the name of your Text Box
Call Hook(Text1.hWnd)
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call UnHook
End Sub

Readmore...

Add Pop Up Menu To Text Box

'Add 1 Text Box to your form. Add 1 Menu (Name it MyMenu) and at least 1 Sub Menu.
'Insert the following code to your form:
Private Const WM_RBUTTONDOWN = &H204
Private 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 Sub OpenContextMenu(FormName As Form, MenuName As Menu)
Call SendMessage(FormName.hwnd, WM_RBUTTONDOWN, 0, 0&)
FormName.PopupMenu MenuName
End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Replace 'MyMenu' with the menu you want to pop up.
If Button = vbRightButton Then Call OpenContextMenu(Me, Me.MyMenu)
End Sub

Readmore...

Align Menu To Right

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 1 Command Button and 1 Menu to your form.
'Insert this code to the module :
Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Public Const MIIM_TYPE = &H10
Public Const MFT_RIGHTJUSTIFY = &H4000
Public Const MFT_STRING = &H0&
Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" _
(ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, lpMenuItemInfo _
As MENUITEMINFO) As Long
Declare Function SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" _
(ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, _
lpcMenuItemInfo As MENUITEMINFO) As Long
Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type

'Insert this code to your form:
Private Sub Command1_Click()
Dim MnuInfo As MENUITEMINFO
mnuH& = GetMenu(Me.hwnd)
MnuInfo.cbSize = Len(MnuInfo)
MnuInfo.fMask = MIIM_TYPE
'If you want to align to right only few menus, and leave the rest in left side,
'Replace the '0' below and the '0' two lines above the 'End Sub' with the number
'of menus you want to leave in the left side.
myTemp& = GetMenuItemInfo(mnuH&, 0, True, MnuInfo)
MnuInfo.fType = MFT_RIGHTJUSTIFY Or MFT_STRING
'Replace all 'MenuCaption' below with the caption of the first menu from left.
MnuInfo.cch = Len("MenuCaption")
MnuInfo.dwTypeData = "MenuCaption"
MnuInfo.cbSize = Len(MnuInfo)
myTemp& = SetMenuItemInfo(mnuH&, 0, True, MnuInfo)
myTemp& = DrawMenuBar(Me.hwnd)
End Sub

Readmore...

Put Bitmaps On Menu

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 1 Command Button And 2 Picture Boxes to your form.
'Set Picture Boxes AutoSize property to True. Add pictures to the Picture Boxes.
'When the menu will be enabled, the picture in Picture1 will be displayed near him.
'When the menu will be disabled, the picture in Picture2 will be displayed near him.
'The pictures should not be bigger than 13x13.
'Add menu to your form, Add 1 sub menu to the menu and name it MyMenu.
'When you run this program, press on the button to enable\disable menu.
'Insert this code to the module :
Declare Function GetMenu Lib "user32" (ByVal hWnd As Long) As Long
Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal _
nPos As Long) As Long
Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal _
nPos As Long) As Long
Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal _
nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal _
hBitmapChecked As Long) As Long
Public Const MF_BITMAP = &H4&

'Insert this code to your form:
Private Sub Command1_Click()
MyMenu.Enabled = Not MyMenu.Enabled
End Sub

Private Sub Form_Load()
'Replace 'Form1' with the name of your form
hMenu& = GetMenu(Form1.hWnd)
'Replace '0' with the menu position. '0' means the first menu from left.
'If it was the second from left, you should been place there '1'.
hSubMenu& = GetSubMenu(hMenu&, 0)
'Replace '0' with the sub menu position. '0' means the upper sub menu.
'If it was the second from top, you should been place there '1'.
hID& = GetMenuItemID(hSubMenu&, 0)
SetMenuItemBitmaps hMenu&, hID&, MF_BITMAP, Picture1.Picture, Picture2.Picture
End Sub

Readmore...

Add PopUp Menu To TreeView

'Add 1 TreeView to your form. Add few nodes to the treeview.
'Add 1 Menu (Named MyMenu) and few Sub Menus.
'When you will click on the right mouse button the menu will popup.
'Insert the following code to your form:

Private Sub TreeView1_Mousedown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim nod As Node
If Button = vbRightButton Then
Set nod = TreeView1.HitTest(x, y)
On Error GoTo EmptyNode
nod.Selected = True
On Error GoTo 0
Me.PopupMenu MyMenu
EmptyNode:
On Error GoTo 0
End If
End Sub

Readmore...

Convert Menu 'V' Checkmark To Circle

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add menu to your form. Add 2 Sub Menus to this menu. Name them both MySubMenu.
'Set the first sub menu index property to '0'. Set the second sub menu index property to '1'.
'After you run the program, press on one of the sub menus and you will see that he has
'circle checkmarks.
'Insert this code to the module :
Public Const MIIM_STATE = &H1
Public Const MIIM_ID = &H2
Public Const MIIM_SUBMENU = &H4
Public Const MIIM_CHECKMARKS = &H8
Public Const MIIM_TYPE = &H10
Public Const MIIM_DATA = &H20
Public Const MFT_RADIOCHECK = &H200&
Public Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type
Public Declare Function SetMenuItemInfo Lib "user32" Alias _
"SetMenuItemInfoA" (ByVal hMenu As Long, ByVal uItem As Long, ByVal _
fByPosition As Long, lpmii As MENUITEMINFO) As Long
Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetSubMenu Lib "user32" (ByVal _
hMenu As Long, ByVal nPos As Long) As Long

'Insert the following code to your form:

Private Sub SetRadioMenuChecks(Mnu As Menu, ByVal mnuItem As Long)
Dim hMenu As Long
Dim mInfo As MENUITEMINFO
'Replace the '0' below with the menu position. In this case put '0' because the menu that you
'want to change his checkmark is the first menu from the left. If the menu position was the 'second from the left, you've should been put there '1'.
hMenu& = GetSubMenu(GetMenu(Mnu.Parent.hwnd), 0)
With mInfo
.cbSize = Len(mInfo)
.fType = MFT_RADIOCHECK
.fMask = MIIM_TYPE
.dwTypeData = Mnu.Caption & Chr$(0)
End With
SetMenuItemInfo hMenu&, mnuItem&, 1, mInfo
End Sub

Private Sub Form_Load()
'Replace the 'MySubMenu(0)' below with the name of the sub menu that you want to change
'his checkmark. Replace the '0' below (that found after the comma) with the position
'of the sub menu that you want to change his checkmark. In this case we put '0' because
'the 'MySubMenu(0)' sub menu is the top sub menu. if the sub menu position was the
'second from top, you've should put there '1'.
SetRadioMenuChecks MySubMenu(0), 0
SetRadioMenuChecks MySubMenu(1), 1
End Sub

Private Sub MySubMenu_Click(Index As Integer)
Static prevSelection As Integer
MySubMenu(prevSelection).Checked = False
MySubMenu(Index).Checked = True
prevSelection = Index
End Sub

Readmore...

Put Split In Menu

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add menu to your form. Add 4 Sub Menus to this menu.
'Insert this code to the module :
Public Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type
Public Declare Function GetMenu Lib "user32" _
(ByVal hwnd As Long) As Long
Public Declare Function GetMenuItemCount Lib "user32" _
(ByVal hMenu As Long) As Long
Public Declare Function GetSubMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPos As Long) As Long
Public Declare Function GetMenuItemInfo Lib "user32" _
Alias "GetMenuItemInfoA" _
(ByVal hMenu As Long, ByVal un As Long, _
ByVal b As Boolean, lpmii As MENUITEMINFO) As Long
Public Declare Function SetMenuItemInfo Lib "user32" _
Alias "SetMenuItemInfoA" _
(ByVal hMenu As Long, ByVal uItem As Long, _
ByVal fByPosition As Long, lpmii As MENUITEMINFO) As Long
Public Const MIIM_STATE = &H1
Public Const MIIM_ID = &H2
Public Const MIIM_SUBMENU = &H4
Public Const MIIM_CHECKMARKS = &H8
Public Const MIIM_TYPE = &H10
Public Const MIIM_DATA = &H20
Public Const MFT_RADIOCHECK = &H200&
Public Const MFT_STRING = &H0&
Public Const RGB_STARTNEWCOLUMNWITHVERTBAR = &H20&
Public Const RGB_STARTNEWCOLUMN = &H40&
Public Const RGB_EMPTY = &H100&
Public Const RGB_VERTICALBARBREAK = &H160&
Public Const RGB_SEPARATOR = &H800&

'Insert the following code to your form:
Private Sub Form_Load()
Dim r As Long
Dim hSubMenu As Long
Dim mnuItemCount As Long
Dim mInfo As MENUITEMINFO
'Replace the '0' below with the menu position. In this case put 0 because the menu that you
'want to put split on it is the first menu from the left. If the menu position was the second from 'the left, you've should been put there '1'.
hSubMenu = GetSubMenu(GetMenu(Me.hwnd), 0)
mnuItemCount = GetMenuItemCount(hSubMenu)
mInfo.cbSize = Len(mInfo)
mInfo.fMask = MIIM_TYPE
mInfo.fType = MFT_STRING
mInfo.dwTypeData = Space$(256)
mInfo.cch = Len(mInfo.dwTypeData)
'Replace the '1' below with your desirable split position. Put '1' to enter the split after
'the first sub menu, put '1' to put it after the second sub menu and so on.
'If you want to put the split before the last sub menu, put there 'mnuItemCount - 1'.
'If you want to put it before 2 sub menus from the last, put there 'mnuItemCount - 1'.
'If you replace the '1' Don't forget to replace also the '1' in the line above the 'End Sub'
r = GetMenuItemInfo(hSubMenu,1, True, mInfo)
mInfo.fType = RGB_STARTNEWCOLUMNWITHVERTBAR
mInfo.fMask = MIIM_TYPE
'If you Replaced the '1' three lines above, replace the '1' below with the same number.
r = SetMenuItemInfo(hSubMenu,1, True, mInfo)
End Subm

Readmore...

Add New Menu Item To The Form's Sytem Menu

The system menu is the default pop up menu (with Restore, Move, Minimize, Maximize, etc.) that pops up when you right clicking on the title bar, or when you right clicking on the task bar.

Note: to perform this task, the code below uses subclassing. that's mean that if you won't close your program properly, it may cause your Visual Basic Environment to crash.
You can close your program by pressing Alt +F4, clicking the form X button, or any other way, but don't close the program by pressing the Visual Basic Stop button.

Module Code

Option Explicit Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" _
(ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As _
Long, ByVal lpNewItem As String) As Long

Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As _
Long, ByVal bRevert As Long) As Long

Public Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal _
dwNewLong As Long) As Long

Public Declare Function CallWindowProc Lib "user32" Alias _
"CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, _
ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(pDest As Any, pSource As Any, ByVal ByteLen As Long)

Public Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Public Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As _
Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const SC_NEWMENU = 2
Public Const SC_MINIMIZE = &HF020
Public Const WM_SYSCOMMAND = &H112
Public Const WM_INITMENUPOPUP = &H117
Public Const BITMASK = &HFFFF0000
Public Const MF_STRING = &H0&
Public Const MF_SEPARATOR = &H800&
Public Const MF_GREYED = &H1&

Public Function FrmProc(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
   
    'this allows each form to have its own window proc
    'and hence to be able to access its own properties in the Win Proc
    FrmProc = FrmFromHwnd(hwnd).WindowProc(hwnd, Msg, wParam, lParam)
   
End Function
Private Function FrmFromHwnd(hwnd As Long) As Object
   
    Dim lo_Form As Object
    Dim ll_Pointer As Long
   
    'make function point to our subclassed form
    ll_Pointer = GetWindowLong(hwnd, GWL_USERDATA)
    CopyMemory lo_Form, ll_Pointer, 4
    Set FrmFromHwnd = lo_Form
   
    'don't forget to clean up afterwards!
    CopyMemory lo_Form, 0&, 4
   
End Function

Form Code

Option Explicit
Private ml_OldWinProc As Long Private Sub Form_Load()
   
    AddAboutMenu
    SubClass
       
End Sub
Private Sub Form_Unload(Cancel As Integer)
    UnSubClass
   
End Sub
Public Function WindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim ll_SysMenu As Long
    Select Case Msg
   
        Case WM_SYSCOMMAND
     
            'the user clicked on the new menu item
            If wParam = SC_NEWMENU Then
            ' you can put here whatever you want to run when the menu is clicked
                MsgBox "You've clicked the new item"
            End If
           
        Case WM_INITMENUPOPUP
       
            'disable the menu option if the form is minimized. If you want
            'that it will be enabled, remove the lines below from "If lParam ..."
            'till "End If" that found 1 line above the "End Select"
            If lParam And BITMASK Then
                ll_SysMenu = GetSystemMenu(hwnd, 0)
                If wParam = ll_SysMenu Then
                    EnableMenuItem ll_SysMenu, SC_NEWMENU, ByVal _
                       IIf(WindowState = vbMinimized, MF_GREYED, 0)
                End If
            End If
    End Select
   
    WindowProc = CallWindowProc(ml_OldWinProc, hwnd, Msg, wParam, lParam)
   
End Function
Private Sub SubClass()
    'store object refernce so we can check its properties later
    SetWindowLong Me.hwnd, GWL_USERDATA, ObjPtr(Me)   
    ml_OldWinProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf FrmProc)
End Sub
Private Sub UnSubClass()
    If ml_OldWinProc Then
        Call SetWindowLong(Me.hwnd, GWL_WNDPROC, ml_OldWinProc)
    End If
End Sub
Private Sub AddAboutMenu()
    Dim ll_OwnerWindowHandle As Long
    Dim ll_MenuHandle As Long
   
    ll_OwnerWindowHandle = Me.hwnd
    'Get system menu
    ll_MenuHandle = GetSystemMenu(ll_OwnerWindowHandle, False)
    'Add new menu item
    Call AppendMenu(ll_MenuHandle, MF_SEPARATOR, 0&, 0&)
    'replace the "New Item" below with the text you want to appear on the new
    'menu item
    Call AppendMenu(ll_MenuHandle, MF_STRING, SC_NEWMENU, "&New Item")
   
End Sub

Readmore...

Copy The Content Of One Tree View To Another

'Add 2 Tree View Controls to your form, and 1 Command Button.
'Insert the following code to your form:
Private Sub Command1_Click()
'The Command below will copy the content of TreeView1 to Treeview2
CopyTreeview TreeView1, TreeView2
End Sub

Private Sub CopyTreeview(objTVSrc As TreeView, objTVDest As TreeView)
Dim nodeRoot As Node
objTVDest.Nodes.Clear
For Each nodeRoot In objTVSrc.Nodes
If (nodeRoot.Parent Is Nothing) Then
Call CopyTVParentNode(nodeRoot, objTVDest.Nodes)
End If
Next
End Sub

Private Sub CopyTVParentNode(nodeParent As Node, nodesDest As Nodes)
Dim nodeDummy As Node
Dim nodeChild As Node
Set nodeDummy = CopyNode(nodeParent, nodesDest)
Set nodeChild = nodeParent.Child
Do While Not (nodeChild Is Nothing)
If nodeChild.Children Then
Call CopyTVParentNode(nodeChild, nodesDest)
Else
Set nodeDummy = CopyNode(nodeChild, nodesDest)
End If
Set nodeChild = nodeChild.Next
Loop
End Sub

Private Function CopyNode(nodeSrc As Node, nodesDest As Nodes) As Node
With nodeSrc
If (.Parent Is Nothing) Then
Set CopyNode = nodesDest.Add(, , .Key, .Text, .Image, .SelectedImage)
CopyNode.Expanded = True
Else
Set CopyNode = nodesDest.Add(.Parent.Index, _
tvwChild, .Key, .Text, .Image, .SelectedImage)
CopyNode.Expanded = True
End If
End With
End Function

Private Sub Form_Load()
TreeView1.Nodes.Add , , "Sample", "Primary"
TreeView1.Nodes.Add , , "Sample2", "Primary2"
TreeView1.Nodes.Add "Sample", tvwChild, "Sample3", "Child"
End Sub

Readmore...

Implement Drag and Drop in TreeView Control

Drag and drop one node to another. This sample code will pop up message box with the name of the node that been dragged.
This implemention don't let the user drag a parent node.

Preparations

Add 1 TreeView Control.
Set the TreeView's OLEDragMode property to 1 - ccOLEDragAutomation,
OLEDropMode property to 1 - ccOLEDropManual, LineStyle property to 1 -tvwRootLines.

Form Code

Option Explicit
Public dragNode As Node, hilitNode As Node


Private Sub Form_Load()
'the following code lines will populate the TreeView control   TreeView1.Nodes.Add , , "First", "First"
   TreeView1.Nodes.Add , , "Second", "Second"
   TreeView1.Nodes.Add "First", tvwChild, "Child", "Child"
   TreeView1.Nodes.Add "Child", tvwChild, "Child2", "Child2"
End Sub Private Sub TreeView1_MouseDown(Button As Integer, Shift As Integer, _
     x As Single, y As Single)
   Set dragNode = TreeView1.HitTest(x, y)
End Sub
Private Sub TreeView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
   If Not dragNode Is Nothing Then MsgBox (dragNode.Text)
End Sub
Private Sub TreeView1_OLEStartDrag(Data As MSComctlLib.DataObject, _
     AllowedEffects As Long)
'If you want to allow parent node dragging, delete the line below    If dragNode.Parent Is Nothing Then Set dragNode = Nothing
End Sub
Private Sub TreeView1_OLEDragOver(Data As MSComctlLib.DataObject, _
     Effect As Long, Button As Integer, Shift As Integer, _
     x As Single, y As Single, State As Integer)
    If Not dragNode Is Nothing Then
        TreeView1.DropHighlight = TreeView1.HitTest(x, y)
    End If
End Sub

Readmore...

Make A CD Player

'Add Class Module to your project (In the menu choose Project -> Add Class Module,
'Then click Open). Change the Class Module name to CDAudio (In the Project
'Explorer press on Class1 and press F4).

'Add 14 Command Buttons and 2 Text Boxes to your form.
'Insert into Text1 the track number to play. Insert into Text2 the Rewind\FastForward
'speed.
'Insert the following code to your Class Module :

Private Declare Function mciGetErrorString Lib "winmm.dll" Alias _
"mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, _
ByVal uLength As Long) As Long
Private 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

Function StartPlay()
mciSendString "play cd", 0, 0, 0
End Function

Function SetTrack(Track%)
mciSendString "seek cd to " & Str(Track), 0, 0, 0
End Function

Function StopPlay()
mciSendString "stop cd wait", 0, 0, 0
End Function

Function PausePlay()
mciSendString "pause cd", 0, 0, 0
End Function

Function EjectCD()
mciSendString "set cd door open", 0, 0, 0
End Function

Function CloseCD()
mciSendString "set cd door closed", 0, 0, 0
End Function

Function UnloadAll()
mciSendString "close all", 0, 0, 0
End Function

Function SetCDPlayerReady()
mciSendString "open cdaudio alias cd wait shareable", 0, 0, 0
End Function
Function SetFormat_tmsf()
mciSendString "set cd time format tmsf wait", 0, 0, 0
End Function

Function SetFormat_milliseconds()
mciSendString "set cd time format milliseconds", 0, 0, 0
End Function

Function CheckCD$()
Dim s As String * 30
mciSendString "status cd media present", s, Len(s), 0
CheckCD = s
End Function

Function GetNumTracks%()
Dim s As String * 30
mciSendString "status cd number of tracks wait", s, Len(s), 0
GetNumTracks = CInt(Mid$(s, 1, 2))
End Function

Function GetCDLength$()
Dim s As String * 30
mciSendString "status cd length wait", s, Len(s), 0
GetCDLength = s
End Function

Function GetTrackLength$(TrackNum%)
Dim s As String * 30
mciSendString "status cd length track " & TrackNum, s, Len(s), 0
GetTrackLength = s
End Function

Function GetCDPosition$()
Dim s As String * 30
mciSendString "status cd position", s, Len(s), 0
GetCDPosition = s
End Function

Function CheckIfPlaying%()
CheckIfPlaying = 0
Dim s As String * 30
mciSendString "status cd mode", s, Len(s), 0
If Mid$(s, 1, 7) = "playing" Then CheckIfPlaying = 1
End Function

Function SeekCDtoX(Track%)
StopPlay
SetTrack Track
StartPlay
End Function

Function ReadyDevice()
UnloadAll
SetCDPlayerReady
SetFormat_tmsf
End Function

Function FastForward(Spd%)
Dim s As String * 40
SetFormat_milliseconds
mciSendString "status cd position wait", s, Len(s), 0
CheckIfPlaying%
If CheckIfPlaying = 1 Then
mciSendString "play cd from " & CStr(CLng(s) + Spd), 0, 0, 0
Else
mciSendString "seek cd to " & CStr(CLng(s) + Spd), 0, 0, 0
End If
SetFormat_tmsf
End Function

Function ReWind(Spd%)
Dim s As String * 40
SetFormat_milliseconds
mciSendString "status cd position wait", s, Len(s), 0
CheckIfPlaying%
If CheckIfPlaying = 1 Then
mciSendString "play cd from " & CStr(CLng(s) - Spd), 0, 0, 0
Else
mciSendString "seek cd to " & CStr(CLng(s) - Spd), 0, 0, 0
End If
SetFormat_tmsf
End Function

'Insert the following code to your form:
Dim Snd As CDAudio
Private Sub Command1_Click()
Snd.SeekCDtoX Val(Text1)
End Sub

Private Sub Command10_Click()
MsgBox Snd.CheckIfPlaying
End Sub

Private Sub Command11_Click()
s = Snd.GetCDPosition
MsgBox "Track: " & CInt(Mid$(s, 1, 2)) & " Min: " & _
CInt(Mid$(s, 4, 2)) & " Sec: " & CInt(Mid$(s, 7, 2))
Track = CInt(Mid$(s, 1, 2))
Min = CInt(Mid$(s, 4, 2))
Sec = CInt(Mid$(s, 7, 2))
End Sub

Private Sub Command12_Click()
s = Snd.GetCDPosition
MsgBox Snd.GetTrackLength(CInt(Mid$(s, 1, 2)))
End Sub

Private Sub Command13_Click()
Snd.PausePlay
End Sub

Private Sub Command14_Click()
Snd.StartPlay
End Sub

Private Sub Command2_Click()
s$ = Snd.GetCDLength
MsgBox "Total length of CD: " & s, , "CD len"
End Sub

Private Sub Command3_Click()
Snd.CloseCD
End Sub

Private Sub Command4_Click()
Snd.EjectCD
End Sub

Private Sub Command5_Click()
Snd.StopPlay
End Sub

Private Sub Command6_Click()
Snd.ReWind Val(Text2) * 1000
End Sub

Private Sub Command7_Click()
Snd.FastForward Val(Text2) * 1000
End Sub

Private Sub Command8_Click()
MsgBox Snd.CheckCD
End Sub

Private Sub Command9_Click()
MsgBox Snd.GetNumTracks
End Sub

Private Sub Form_Load()
Set Snd = New CDAudio
Snd.ReadyDevice
Command1.Caption = "Play track"
Command2.Caption = "Get CD Length"
Command3.Caption = "Close CD"
Command4.Caption = "Eject CD"
Command5.Caption = "Stop"
Command6.Caption = "Rewind"
Command7.Caption = "Fast Forward"
Command8.Caption = "Check if CD in drive"
Command9.Caption = "Get numbre of tracks"
Command10.Caption = "Check If Playing"
Command11.Caption = "Get CD Position"
Command12.Caption = "Get current track Length"
Command13.Caption = "Pause"
Command14.Caption = "Resume"
Text1.Text = "1"
Text2.Text = "5"
End Sub

Private Sub Form_Unload(Cancel As Integer)
Snd.StopPlay
Snd.UnloadAll
End Sub

Readmore...

Play MIDI Files

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 2 CommandButtons to your form (named Command1 and Command2).

'When you press the first button the Midi File will start playing.
'When you press the second button the Midi File will stop playing.
'Insert this code to the module :
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

'Insert the following code to your form:
Public Sub StopMIDI(MidiFileName As String)
Call mciSendString("stop " + MidiFileName, 0&, 0, 0)
Call mciSendString("close " + MidiFileName, 0&, 0, 0)
End Sub

Function PlayMIDI(MidiFileName As String)
On Error Resume Next
Call mciSendString("open " + MidiFileName + " type sequencer", 0&, 0, 0)
If mciSendString("play " + MidiFileName + Flags, 0&, 0, 0) = 0 Then
PlayMIDI = 0
Else
PlayMIDI = 1
End If
End Function
Private Sub Command1_Click()
'Replace c:\mydir\song1.mid with the Midi file name you want to play
PlayMIDI ("c:\mydir\song1.mid")
End Sub

Private Sub Command2_Click()
'Replace c:\mydir\song1.mid with the Midi file name you want to stop
StopMIDI ("c:\mydir\song1.mid")
End Sub

Readmore...

Play Avi File In Picture Box

Play an avi file inside a picture box. The AVI file will be resized to the size of the picture box.

Preparations

Add 1 Command Button (named Command1), and 1 Picture Box (named Picture1) to your form.

Module Code

Declare Function mciSendString Lib "winmm" 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" 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
Public Const WS_CHILD = &H40000000

Form Code

Sub PlayAVIPictureBox(FileName As String, ByVal Window As PictureBox)
Dim RetVal As Long
Dim CommandString As String
Dim ShortFileName As String * 260
Dim deviceIsOpen As Boolean
'Retrieve short file name format
RetVal = GetShortPathName(FileName, ShortFileName, Len(ShortFileName))
FileName = Left$(ShortFileName, RetVal)
'Open the device
CommandString = "Open " & FileName & " type AVIVideo alias AVIFile parent " _
& CStr(Window.hWnd) & " style " & CStr(WS_CHILD)
RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
If RetVal Then GoTo error
'remember that the device is now opendeviceIsOpen = True
'Resize the movie to PictureBox size
CommandString = "put AVIFile window at 0 0 " & CStr(Window.ScaleWidth / _
Screen.TwipsPerPixelX) & " " & CStr(Window.ScaleHeight / _
Screen.TwipsPerPixelY)
RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
If RetVal <> 0 Then GoTo error
'Play the file
CommandString = "Play AVIFile wait"
RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
If RetVal <> 0 Then GoTo error
'Close the deviceCommandString = "Close AVIFile"
RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
If RetVal <> 0 Then GoTo error
Exit Sub
error:
'An error occurred.
'Get the error description
Dim ErrorString As String
ErrorString = Space$(256)
mciGetErrorString RetVal, ErrorString, Len(ErrorString)
ErrorString = Left$(ErrorString, InStr(ErrorString, vbNullChar) - 1)
'close the device if necessary
If deviceIsOpen Then
CommandString = "Close AVIFile"
mciSendString CommandString, vbNullString, 0, 0&
End If
'raise a custom error, with the proper description
Err.Raise 999, , ErrorString
End Sub
Private Sub Command1_Click()
'replace 'c:\myfile.avi' with the name of the AVI file you want to play
    PlayAVIPictureBox "c:\myfile.avi", Picture1
End Sub

Readmore...

Play AVI File

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 2 CommandButtons to your form (named Command1 and Command2).

'When you press the first button the AVI movie will start to play.
'Even after the AVI Finish playing, it is still takes memory.
'To remove it from the memory press the second button.
'Insert this code to the module :
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

'Insert the following code to your form:
Private Sub Command1_Click()
Dim returnstring As String
Dim FileName As String
returnstring = Space(127)
'Replace c:\MyMovie.avi with the AVI file you want to play
FileName = "c:\MyMovie.avi"
erg = mciSendString("open " & Chr$(34) & FileName & _
Chr$(34) & " type avivideo alias video", returnstring, 127, 0)
erg = mciSendString("set video time format ms", returnstring, 127, 0)
erg = mciSendString("play video from 0", returnstring, 127, 0)
End Sub

Private Sub Command2_Click()
erg = mciSendString("close video", returnstring, 127, 0)
End Sub

Readmore...

Play WAV File

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Insert this code to the module :
Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

'Insert this code to your form:
Private Sub Form_Load()
'replace c:\music\myfile.wav with the WAV file you want to play
sndPlaySound "c:\music\myfile.wav", 1
'the '1' following the file means that the program should not stop to play the file.
'The sound will play and other events can be happening.
'If you want the whole program to stop while the sound is playing, just change the '1' to '0'.
End Sub

Readmore...

Play MP3 Files Using Windows Media Player

You can use Microsoft Windows Media Player in your VB application to play MP3 files.
To do that you must have Windows Media Player installed on your computer.

Preparations

Add Windows Media Player to your form:
From VB menu choose Project->Components... then mark the Windows Media Player check box and press OK. Now drag the Windows Media Player Control to your form.

If you want that Windows Media Player will be invisible, set its Visible property to False.

Add 3 Command Buttons to your form.
Press the first to play the MP3 file, press the second to stop it, and press the third to Pause/Resume.

Form Code

Private Sub Command1_Click()
' replace the "D:\MP3\MyFile.mp3" below with the Mp3 file
' you want to play
    MediaPlayer1.Open "D:\MP3\MyFile.mp3"
End Sub
Private Sub Command2_Click()
    MediaPlayer1.Stop
End Sub
Private Sub Command3_Click()
' if PlayState is 2: the file is currently playing.
' if PlayState is 1: the file is in pause mode.
    If MediaPlayer1.PlayState = 2 Then
        MediaPlayer1.Pause
    Else
        MediaPlayer1.Play
    End If
End Sub

Readmore...

Detect If Sound Card Can Play Sound Files

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Insert this code to the module :
Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long

'Insert this code to your form:
Private Sub Form_Load()
Dim I As Integer
I = waveOutGetNumDevs()
If  I > 0 Then
MsgBox "Your system can play sound files."
Else
MsgBox "Your system can not play sound files."
End If
End Sub

Readmore...

Retrieve The Length Of WAV, AVI And MIDI Files

Know how much time run any WAV, AVI and MIDI file.

Module Code

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

 

Form Code

Function GetMediaLength(FileName As String)
    Dim MediaLength As Long
    Dim RetString As String * 256
    Dim CommandString As String
    'open the media file
    CommandString = "Open " & FileName & " alias MediaFile"
    mciSendString CommandString, vbNullString, 0, 0&
    'get the media file length
    CommandString = "Set MediaFile time format milliseconds"
    mciSendString CommandString, vbNullString, 0, 0&
    CommandString = "Status MediaFile length"
    mciSendString CommandString, RetString, Len(RetString), 0&
    GetMediaLength = CLng(RetString)
    'close the media file    CommandString = "Close MediaFile"
    mciSendString CommandString, vbNullString, 0, 0&
End Function

Private Sub Form_Load()
    Dim Seconds, Minutes As Integer
    Dim MilliSeconds As Long
    ' replace "c:\my_media_file.wav" with the path to your media file    MilliSeconds = GetMediaLength("c:\my_media_file.wav")
    ' the function GetMediaLength return the media length in milliseconds,
    ' so we will calculate the total minutes and seconds
    Seconds = Int(MilliSeconds / 1000) Mod 60
    Minutes = Int(MilliSeconds / 60000)
    MilliSeconds = MilliSeconds Mod 1000
    TotalTime = Minutes & ":" & Seconds & ":" & MilliSeconds
    MsgBox (TotalTime)
   
End Sub

Readmore...

Make Your First ActiveX Control 5

Adding more events
Event KeyDown(KeyCode As Integer, Shift As Integer)
Event KeyUp(KeyCode As Integer, Shift As Integer)
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

Private Sub Command1_KeyDown(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub Command1_KeyUp(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyUp(KeyCode, Shift)
End Sub
Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub
Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

Control's special events
Private Sub UserControl_Initialize()End Sub
The code that you will insert to this sub, will run when
the user first place the control on the form on design time,
and on runtime, when the form with the control on it is loaded.
Private Sub UserControl_Show()
End Sub
This event occur instantly after the Initialize event occur.
The initialize event occur After the control is loaded and before
the Control is visible (to the programmer or the user that run the program)
and the Show event occur right after the Control is visible to the programmer/user.
You can browse for other event: At the control's code window,
choose UserControl from the left ComboBox under the title bar,
and choose event with the right ComboBox.

Setting Control's propertiesAs you probably saw, when you inserted the control to your project,
the control had a default icon on the ToolBox.
To set your own Icon, Add your icon to the control ToolBoxBitmap property.

Some of the controls are invisible at runtime (Like Timer and ImageList).
To set your control to be invisible at runtime,
Set the control InvisibleAtRuntime property to True.

Make an About box
Make an About property, that when the user will
press on the About property cell on the control Properties window,
A message box will show up with your details.
Add the following code to your form:

Public Sub AboutBox()
    MsgBox "This is my message", , "This is my title"
End Sub

Now from the menu choose Tools->Procedure Attributes.

From the 'Name' combo box choose AboutBox,
Click on the Advanced button, and from the 'Procedure ID'
choose AboutBox, and press OK.

Now a New property has just been added to your control - the About Property.

Readmore...

Make Your First ActiveX Control 4

Adding more properties to the control
Now we want that the control will have all the Command Button properties.
lets add the BackColor property. Enter the following code to your form:
Public Property Get BackColor() As OLE_COLOR
    BackColor = Command1.BackColor
End Property
Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    Command1.BackColor() = New_BackColor
    PropertyChanged "BackColor"
End Property
Enter the following line to the UserControl_ReadProperties function:
Command1.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
Enter the following line to the UserControl_WriteProperties function:
Call PropBag.WriteProperty("BackColor", Command1.BackColor, &H8000000F)

The OLE_COLOR is the type of the BackColor property variable,
the same as the Boolean is the type of the Enabled property variable,
and the Integer is the type of the Height property variable.


What we did now is almost the same as we did with the Text property.
The difference is that in the text property we used
a variable (TextVariable) to store the property information.
Here we not using a variable, we read and write the information
directly to the Command1.BackColor property.

The Command1.BackColor property is here our variable that store
the information. Why is that?
Because when the user set the Control BackColor property,
we actually want to set the Command1 BackColor property.
Suppose the user set the Control BackColor to Black.
In that case, We want to set the Command1 BackColor to Black.
So actually, the Control BackColor property is the
Command1 BackColor property.
So instead of reading and writing to variable,
we read and write directly to the Command1 BackColor property.
It's exactly the same thing with all of the other properties.

Adding the rest of the properties
Public Property Get Enabled() As Boolean
    Enabled = Command1.Enabled
End Property
Public Property Let Enabled(ByVal New_Enabled As Boolean)
    Command1.Enabled() = New_Enabled
    PropertyChanged "Enabled"
End Property
Public Property Get Font() As Font
    Set Font = Command1.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
    Set Command1.Font = New_Font
    PropertyChanged "Font"
End Property

Public Property Get Picture() As Picture
     Set Picture = Command1.Picture
End Property

Public Property Set Picture(ByVal New_Picture As Picture)
Set Command1.Picture = New_Picture
    PropertyChanged "Picture"
End Property

Public Property Get DisabledPicture() As Picture
     Set DisabledPicture = Command1.DisabledPicture
End Property

Public Property Set DisabledPicture(ByVal New_DisabledPicture As Picture)
    Set Command1.DisabledPicture = New_DisabledPicture
    PropertyChanged "DisabledPicture"
End Property

Public Property Get MousePointer() As MousePointerConstants
    MousePointer = Command1.MousePointer
End Property

Public Property Let MousePointer(ByVal New_MousePointer As MousePointerConstants)
    Command1.MousePointer() = New_MousePointer
    PropertyChanged "MousePointer"
End Property

Public Property Get MouseIcon() As Picture
    Set MouseIcon = Command1.MouseIcon
End Property
Public Property Set MouseIcon(ByVal New_MouseIcon As Picture)
    Set Command1.MouseIcon() = New_MouseIcon
    PropertyChanged "MouseIcon"
End Property

Public Property Get Caption() As String
    Caption = Command1.Caption
End Property
Public Property Let Caption(ByVal New_Caption As String)
    Command1.Caption() = New_Caption
    PropertyChanged "Caption"
End Property

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    Command1.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
    Command1.Enabled = PropBag.ReadProperty("Enabled", True)
    Set Font = PropBag.ReadProperty("Font", Ambient.Font)
    Set Picture = PropBag.ReadProperty("Picture", "")
    Set DisabledPicture = PropBag.ReadProperty("DisabledPicture", "")
    Command1.MousePointer = PropBag.ReadProperty("MousePointer", 0)
    Set MouseIcon = PropBag.ReadProperty("MouseIcon", "")
    Command1.Caption = PropBag.ReadProperty("Caption", "Button")
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("BackColor", Command1.BackColor, &H8000000F)
    Call PropBag.WriteProperty("Enabled", Command1.Enabled, True)
    Call PropBag.WriteProperty("Font", Font, Ambient.Font)
    Call PropBag.WriteProperty("Picture", Picture, "")
    Call PropBag.WriteProperty("DisabledPicture", DisabledPicture, "")
    Call PropBag.WriteProperty("MousePointer", Command1.MousePointer, 0)
    Call PropBag.WriteProperty("MouseIcon", Command1.MouseIcon, "")
    Call PropBag.WriteProperty("Caption", Command1.Caption, "Button")
End Sub

The difference between SET and GETAs you see, in some of the properties, we use SET instead of GET.
When you want to change the Command Button Picture property,
you press on the Button with the 3 dots on him that
found in the "Picture" cell and then browse for your picture.

When we want to set property that uses the browse button, we use SET instead of GET.

Readmore...

Make Your First ActiveX Control 3

Implementing events
We know what the user wants to pop up when he
clicks the button - the Text in TextVariable.
Now we need to pop up the message box when the user click the button.
We want 2 events: KeyPress and Click.
First we need to declare them.
enter the following code to your form:

Event Click()
Event KeyPress(KeyAscii As Integer)
How do we know that the Click event not getting parameters,
and the KeyPress event get the KeyAscii parameter?
Double Click on the command button.
2 new lines have been inserted to your code:
Private Sub Command1_Click()
End Sub
as you see, the Click event gets no parameters.
Now go to the button KeyPress event,
via the right ComboBox under the title bar,
which now showing the current event - Click
After you choose KeyPress from the combobox,
2 new lines were inserted to your code:

Private Sub Command1_KeyPress(KeyAscii As Integer)
End Sub


As you can see, the button KeyPress event get the KeyAscii parameter.

Implementing The KeyPress EventWe don't want to change the KeyPress Event. We want that the code the user will insert to the
KeyPress Event  will be launched as usual,  without any changes.

So we will enter the following lines to our form:

Private Sub Command1_KeyPress(KeyAscii As Integer)
    RaiseEvent KeyPress(KeyAscii)
End Sub

Code Explanation: when the user press on the Command1 Button,
simply launch the Control (MyControl) KeyPress event.
The 'RaiseEvent' function launch an event.
It launch the event with the KeyAscii parameter that has been
received from the Command1 KeyPress event.

Implementing The Click EventWe want to pop up the message box when the
Click event occur, and then run the code that
the user entered in the MyControl1 - Click event.

Enter the following code to your form:
Private Sub Command1_Click()
    MsgBox (TextVariable)
    RaiseEvent Click
End Sub
When the user Click on Command1, pop up a message box
with the TextVariable string.
Then run the code that the user inserted to the control Click event.
What will happen if you omit the 'RaiseEvent Click' line?
When the user will click the button, the message box will pop up,
and the code that the user entered to the MyControl1 Click
event will not be apply.
So actually the user will not be able to program the click event.

By now, your code should look like this:
Dim TextVariable As String

Event Click()
Event KeyPress(KeyAscii As Integer)
Private Sub Command1_Click()
    MsgBox (TextVariable)
    RaiseEvent Click
End Sub
Private Sub Command1_KeyPress(KeyAscii As Integer)
    RaiseEvent KeyPress(KeyAscii)
End Sub
Private Sub UserControl_Resize()
    Command1.Width = UserControl.Width
    Command1.Height = UserControl.Height
End Sub
Public Property Get Text() As String
    Text = TextVariable
End Property
Public Property Let Text(ByVal New_Text As String)
    TextVariable = New_Text
    PropertyChanged "Text"
End Property

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    TextVariable = PropBag.ReadProperty("Text", "There is no message")
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Text", TextVariable, "There is no message) 
End Sub

Compiling and running the control
Now lets see how the control is working by now.
Save the project (File->Save Project).

lets compile the project to OCX Control.
From the menu, choose   File->Make MyFirstOCX.ocx   and press OK.

Now your OCX Control has been created, AND registered with your system.

Start a new project and enter your control to the project
(From the menu choose Project->Components, mark the MyFirstOCX checkBox and press OK)
 Now you see the new control at the ToolBox.

Insert it to your form, resize it to your preferred size, and insert "hello" to the control Text property.Run the program and click the button. A "hello" message box is popping.

Readmore...

Make Your First ActiveX Control 2

Starting the programming
Add 1 Command Button to your form (named Command1).

This is how your control will look like.
Your control is the form and everything on it.
We don't want that the control will be a form with a button on it,
we want that the control will be a button only,
without the form around him.
So resize the form to be at the size of the button exactly,
so you won't see the form.

So now the Control look like a button.
But it's not a button, it's a form with button on it.
But what if the user will resize the control at design time
(like you do to Command Button, after you enter it to your form)?

Suppose you have a regular form with a button on it,
and the form is resized to the button size (like in your current control).
When the user will resize the form, he will see the form
that was before 'under' the button.
The same thing will happen in our case.

To solve this problem, when the user resize the form (i.e the control),
we need to resize the button to fit the form and the form will be
again at the size of the button.
When the user resize the control, he actually try to resize the button.
Enter the following code to let the user resize the button
instead of resizing the form:

Private Sub UserControl_Resize()
   Command1.Width = UserControl.Width
   Command1.Height = UserControl.Height
End Sub
UserControl is the name of the Form/Control.
thus, UserControl.Width is the Form/Control width,
UserControl.Height is the Form/Control Height and UserControl_Resize()
is the event that occur when the user resize the control.

Implementing Control's PropertiesEvery control has few properties as default: Name, Left, Index, Tag, and more.
Our control will inherit those properties as default.
But we want that our control will have some properties that
he doesn't get as default, like Text - the text of the message box
that will pop when the user press the button.
Implementing Text PropertyWe have 2 occasions: when reading the Text property and
when changing the Text property.
The reading occasion occur when we want to
read the porperty that the user set.
For example if the user set the control Text property to "hello",
the reading result will return "hello".
Lets implement first the reading occasion.

Enter the following code to your form:
Dim TextVariable As String
The TextVariable will be the variable that holds for us the value of the Text property, therefore the String that will be inserted into the message box.

Enter the following code to your form:
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    TextVariable = PropBag.ReadProperty("Text", "There is no message")
End Sub

The function above says: read the control's "Text" property.
If the reading yield nothing, set as default the Text property
to be "There is no message".
We called to read the Text property,
now we have to implement the reading method:
Public Property Get Text() As String
    Text = TextVariable
End Property
The TextVariable will hold the Text property value,
so we simply need to return the value of TextVariable.
TextVariable is a string, and the calling for reading the
Text property value will return string, therefore the 'As String' above.

Implementing The Writing MethodThe write occasion occur when the user change the Text property.
In that case, we need to update the variable that
holds for us the propery value (TextVariable).
Enter the Following code to your form:
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Text", TextVariable, "There is no message")
End Sub

The function above says:
Write the new property value to TextVariable,
and update the Text Property.
If the writing to the TextVariable return nothing,
Set the Text property value to be "There is no message".

Now we have to implement the writing method,
where the new property value will be entered into the TextVariable.
Enter the following code to your form:
Public Property Let Text(ByVal New_Text As String)
    TextVariable = New_Text
    PropertyChanged "Text"
End Property

The new Text property value is passed with the New_Text parameter.
Of course this parameter have to be String, because the Text property holds String.
We set the TextVariable variable to hold the new Text property value.
Then we announce that the "Text" property has been changed.

Readmore...

Make Your First ActiveX Control 1

First of all, what is ActiveX Control?ActiveX control is control like all visual basic common controls: Command Button, Label, etc.
You can make your own ActiveX control, for example  hover button control, and use it in every VB program you make without addition of code. Instead of writing the same code every time you want to use the hover button, make once hover button  ActiveX control, and drag it to your form every time you want to use it, like it was the usual Command Button.

How can you make your own ActiveX control?In this tutorial we will make a button control, that will pop a message box when the user will click on it.
I know that it's not very useful, and for this purpose you don't have to make an ActiveX control, but this example  will teach you how to make an ActiveX control.

Getting startedChoose from the menu (in VB 6.0) File->New Project
Select ActiveX Control and press OK.

A new form without a title bar has been opened
Choose from the menu Project->Project1 Properties.
 in the 'Project Name' Text Box is written by default 'Project1'

 Change the 'Project Name' to myFirstOCX.

This is what you will see, after you complete the control,
In the Project->Components menu - where the user choose
which OCX controls to add to his project

Right click on the form, and choose properties from the menu.
The form's name property by default is UserControl1. Change it to MyControl.
 This will be default name of the control when the user will
insert it to his form: MyControl1, MyControl2, and so on.

Readmore...