VB6 - Draw your Form's Icon or System Tray Icon at runtime and make it dynamic.
This example will create icons on the fly.
These Icons will be numbers between 1 and 99, they will be added as the Form Icon, and as System Tray Icon, both things at runtime.
About the Form Icon: with transparent background and yellow forecolor.
About the Tray Icon: will have a ramdom colored background and Random Forecolor. This will also add a different tooltip to the tray icon each time.
You can download the project attached or add these 3 controls and paste the code below in your Form.
Add an Imagelist (empty if you want, This will use index 1)
Add a CommandButton
Add a PictureBox
Paste this code in your Form
Code:
Option Explicit
Private Type NotifyIconData
Size As Long
Handle As Long
ID As Long
Flags As Long
CallBackMessage As Long
Icon As Long
Tip As String * 64
End Type
Private Declare Function Shell_NotifyIcon _
Lib "shell32" Alias "Shell_NotifyIconA" ( _
ByVal Message As Long, Data As NotifyIconData) As Boolean
Private Const AddIcon = &H0
Private Const ModifyIcon = &H1
Private Const DeleteIcon = &H2
Private Const WM_MOUSEMOVE = &H200
Private Const MessageFlag = &H1
Private Const IconFlag = &H2
Private Const TipFlag = &H4
Private Data As NotifyIconData
Private mNumTray As Long 'Just to add a number
Private Sub Command1_Click()
subShowIcons ModifyIcon
End Sub
Private Sub AddIconToTray(pEvent As Long)
With Data
.Size = Len(Data)
.Handle = hWnd
.ID = vbNull
.Flags = IconFlag Or TipFlag Or MessageFlag
.CallBackMessage = WM_MOUSEMOVE
.Icon = ImageList1.ListImages(1).ExtractIcon
.Tip = "Dynamic Systray Icon " & CStr(mNumTray) & vbNullChar
End With
Call Shell_NotifyIcon(pEvent, Data)
End Sub
Private Sub subShowIcons(pEvent As Long)
'Modify Picture Transparent Backcolor (Mask) and Yellow Forecolor
PreparePictureForm
ImageList1.ListImages.Add 1, , Picture1.Image 'Add generated Icon to Imagelist
Me.Icon = ImageList1.ListImages(1).ExtractIcon ' Set as Form Icon
ImageList1.ListImages.Remove 1 'Remove Icon from imagelist
'-----------------------------------------------
PreparePictureTray 'Modify Picture, Random Backcolor and Forecolor
ImageList1.ListImages.Add 1, , Picture1.Image 'Add generated Icon to Imagelist
AddIconToTray (pEvent) 'Add Icon to Tray
ImageList1.ListImages.Remove 1 'Remove Icon from imagelist
mNumTray = mNumTray + 1 'New Number to add
If mNumTray = 100 Then mNumTray = 0
End Sub
Private Sub PreparePictureForm()
With Picture1
.Cls
.BackColor = ImageList1.MaskColor
.ForeColor = vbYellow
End With
Picture1.Print CStr(mNumTray)
End Sub
Private Sub PreparePictureTray()
With Picture1
.Cls
.BackColor = vbBlue * Rnd(10000)
.ForeColor = vbWhite * Rnd(10000)
End With
Picture1.Print CStr(mNumTray)
End Sub
Private Sub Form_Load()
mNumTray = 0
With Picture1
.ScaleMode = vbPixels
.AutoRedraw = True
.Width = 1000
.Height = 1000
.Font.Size = 40
.CurrentX = 10
.CurrentY = 1
End With
ImageList1.UseMaskColor = True 'Yes, We use this for the Form Icon
ImageList1.MaskColor = vbMagenta 'Set the Imagelist Maskcolor
subShowIcons AddIcon
End Sub
Private Sub Form_Terminate()
DeleteIconFromTray
End Sub
Private Sub DeleteIconFromTray()
Call Shell_NotifyIcon(DeleteIcon, Data)
End Sub
Last edited by jcis; Jun 6th, 2007 at 08:18 PM.
Reason: Added screenshot
Another example, Now I'll draw the icon inside a Timer event to make it dynamic
Just another example, but this time, instead of text, I'll draw some lines with a timer to create a dynamic Icon and set it as the Form's Icon.
Add this to your Form or download the attached project.
Controls to add
Timer
Picturebox
Imagelist
And this code..
Code:
Option Explicit
Private mMoveX As Long
Private mBlnDirection As Boolean
Private Sub Form_Load()
With Picture1
.AutoRedraw = True
.BackColor = vbYellow
.Height = 1000
.Width = 1000
End With
mMoveX = 0
Timer1.Interval = 1
Timer1.Enabled = True
mBlnDirection = True
End Sub
Private Sub Timer1_Timer()
DrawLines
ImageList1.ListImages.Add 1, , Picture1.Image
Me.Icon = ImageList1.ListImages(1).ExtractIcon
ImageList1.ListImages.Remove 1
End Sub
Private Sub DrawLines()
With Picture1
.Cls
.DrawWidth = 5
drawLine mMoveX, vbBlue
drawLine .Width - mMoveX, vbRed
If mBlnDirection Then
mMoveX = mMoveX + 30
Else
mMoveX = mMoveX - 30
End If
If mMoveX > .Width - 80 Then mBlnDirection = False
If mMoveX < 0 Then mBlnDirection = True
End With
End Sub
Private Sub drawLine(pMoveX As Long, pColor As Long)
With Picture1
.CurrentX = .Width / 2: .CurrentY = .Height
.Line 3, .CurrentX, CurrentY, pMoveX, 0, pColor
End With
End Sub