Create Balloon Tips in SysTray

You may wondering how to create balloon tips in Visual Basic put in systray.

Allright then, this is how!

Option Explicit
Private Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 128
dwState As Long
dwStateMask As Long
szInfo As String * 256
uTimeout As Long
szInfoTitle As String * 64
dwInfoFlags As Long
End TypePrivate sysTray As NOTIFYICONDATA

'Constants
Private Const NOTIFYICON_VERSION = 3
Private Const NOTIFYICON_OLDVERSION = 0

Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2

Private Const NIM_SETFOCUS = &H3
Private Const NIM_SETVERSION = &H4

Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4

Private Const NIF_STATE = &H8
Private Const NIF_INFO = &H10

Private Const NIS_HIDDEN = &H1
Private Const NIS_SHAREDICON = &H2

Private Const NIIF_NONE = &H0
Private Const NIIF_WARNING = &H2
Private Const NIIF_ERROR = &H3
Private Const NIIF_INFO = &H1
Private Const NIIF_GUID = &H4

Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206

' API Declaration
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" _
(ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean

Private Sub Command1_Click()

With sysTray
.cbSize = Len(sysTray)
.hWnd = Me.Picture1.hWnd
.uID = vbNull
.uFlags = NIF_ICON Or NIF_INFO Or NIF_MESSAGE Or NIF_TIP
.uCallbackMessage = WM_MOUSEMOVE
.hIcon = Me.Picture1.Picture
.szTip = " Here placing toolTip " & vbNullChar
.dwState = 0
.dwStateMask = 0
End With

Shell_NotifyIcon NIM_ADD, sysTray

End Sub

Private Sub Command2_Click()
With sysTray
.cbSize = Len(sysTray)
.hWnd = Picture1.hWnd
.uID = vbNull
.uFlags = NIF_ICON Or NIF_INFO Or NIF_MESSAGE Or NIF_TIP
.uCallbackMessage = WM_MOUSEMOVE
.hIcon = Me.Picture1
.szTip = " Here placing toolTip " & vbNullChar
.dwState = 0
.dwStateMask = 0
.szInfo = Text2 & Chr(0)
.szInfoTitle = Text1 & Chr(0)
.dwInfoFlags = NIIF_INFO
.uTimeout = 100
End With

Shell_NotifyIcon NIM_MODIFY, sysTray
End Sub

Private Sub Command3_Click()
Shell_NotifyIcon NIM_DELETE, sysTray
End Sub

Private Sub Form_Load()
Command1.Caption = " Report on Systray "
Command2.Caption = " Show Balloon dialogue "
Command3.Caption = " Remove from systray "
Text1 = App.EXEName
Text2 = " Welcome to STMIK Banjarbaru zone! "
End Sub

Extract Icon From A File

Ever wanted to get the icon that a file uses? This simple Extract_Icon function shows you how…

Private Const SHGFI_DISPLAYNAME = &H200
Private Const SHGFI_ICON = &H100
Private Const SHGFI_SYSICONINDEX = &H4000 ' get system icon index
Private Const SHGFI_LARGEICON = &H0 ' get large icon
Private Const SHGFI_SMALLICON = &H1 ' get small icon
Private Const ILD_TRANSPARENT = &H1
Public Const MAX_PATH = 260
Private Type SHFILEINFO 'Structure used by SHGetFileInfo
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type
Private Declare Function ImageList_Draw Lib "comctl32.dll" (ByVal himl&, ByVal i&, ByVal hDCDest&, ByVal x&, ByVal y&, ByVal flags&) As Long
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long

Public Function ExtractIcon(picImage As PictureBox, sFile As String)
Dim himl As Long
Dim lpzxExeName As String
Dim lRet As Long
Dim sWinPath As String
Dim shinfo As SHFILEINFO

lpzxExeName = sFile
himl = SHGetFileInfo(lpzxExeName, 0&, shinfo, Len(shinfo), SHGFI_SYSICONINDEX Or SHGFI_SMALLICON)
If himl <> 0 Then
picImage.AutoRedraw = True
lRet = ImageList_Draw(himl, shinfo.iIcon, picImage.hDC, 0, 0, ILD_TRANSPARENT)
picImage.Refresh
ExtractIcon = True
End If
End Function

Change System Date

This code will change your system date to certain date you wanted to.

Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type

Private Declare Function SetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME) As Long

Private Sub Form_Load()

Dim lpSystemTime As SYSTEMTIME

lpSystemTime.wYear = 2003
lpSystemTime.wMonth = 10
lpSystemTime.wDayOfWeek = -1
lpSystemTime.wDay = 10
lpSystemTime.wHour = 0
lpSystemTime.wMinute = 0
lpSystemTime.wSecond = 0
lpSystemTime.wMilliseconds = 0

'set the new time
SetSystemTime lpSystemTime
End Sub

Command Button with Gradient Filter (ActiveX Control)

'**************************************
' Windows API/Global Declarations for
' Command Button with gradient filter
' (ActiveX Control)
'**************************************
GetDeviceCaps, SetPixel, GetDIBits, CreateCompatibleDC, DeleteDC, SelectObject, DeleteObject, GetObject, SetDIBits, GetSysColor, CreatePen, GetClientRect, GetPixel, GetTickCount, LineTo, LockWindowUpdate, MoveToEx, Polygon

' Structures (types):
BITMAP, BITMAPINFOHEADER, RGBQUAD, BITMAPINFO, PointAPI,

' Constants:
BLACKNESS, DSTINVERT, MERGECOPY, MERGEPAINT, NOTSRCCOPY, NOTSRCERASE, PATCOPY, PATINVERT, PATPAINT, SRCCOPY, SRCPAINT,
SRCINVERT, SRCERASE, SRCAND, WHITENESS, COLOR_ACTIVEBORDER, COLOR_ACTIVECAPTION, COLOR_ADJ_MAX, COLOR_ADJ_MIN, COLOR_APPWORKSPACE, COLOR_BACKGROUND, COLOR_BTNFACE, COLOR_BTNHIGHLIGHT, COLOR_BTNSHADOW, COLOR_BTNTEXT, COLOR_CAPTIONTEXT, COLOR_GRAYTEXT, COLOR_HIGHLIGHT, COLOR_HIGHLIGHTTEXT, COLOR_INACTIVEBORDER, COLOR_INACTIVECAPTION, COLOR_INACTIVECAPTIONTEXT, COLOR_MENU, COLOR_MENUTEXT, COLOR_SCROLLBAR, COLOR_WINDOW, COLOR_WINDOWFRAME, COLOR_WINDOWTEXT, BITSPIXEL, PS_SOLID

How Can I Find Out If a File Exists On a Disk?

To find out if a file exists on a disk you can use the Visual Basic Dir() function. It has the following syntax:

Dir[(pathname[, attributes])]

In this context, pathname would be the name of the file that you are trying to find. The Attributes can be one or more of the following values (separated by the OR operator).

Attribute	Description
vbNormal	Default Attribute
vbReadOnly	Use if file pathname is read-only
vbHidden	Use if the file pathname is hidden
vbSystem	Use if the file pathname is a system file
vbArchive	Use if the file pathname is an Archive file
vbDirectory	Use if pathname is a directory

Example:

If Dir(myfilename, vbNormal or vbReadOnly or vbHidden or vbSystem or vbArchive) = "" then
Call Msgbox ("This file does not exist")
Else
Call msgbox ("This file does exist")
End If