Saturday, February 13, 2010

Buat Form Berada di Sys-Tray

yang perlu disiapin..
1 Form dan 1 Timer..

oke..
copas script ini aJah.
.penjelasan dikit..
kalo formnya kita minimize..dia akan langsung berada di Sys-tray kita,,
kalo kita klik kiri di icon Sys-Tray kita..dia akan muncul lagi..



Option Explicit

Private Declare Function SetForegroundWindow _
Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function Shell_NotifyIcon Lib _
"shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, _
pnid As NOTIFYICONDATA) As Boolean

Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const NIF_TIP = &H4
Private Const WM_MOUSEMOVE = &H200
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_MBUTTONDBLCLK = &H209
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208

Private Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uflags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type

Public WithEvents FSys As Form
Public Event Click(ClickWhat As String)
Public Event TIcon(F As Form)

Private nid As NOTIFYICONDATA
Private LastWindowState As Integer
Dim strValue As String

Public Property Let Tooltip(Value As String)
On Error Resume Next
nid.szTip = Value & vbNullChar
End Property

Public Property Get Tooltip() As String
On Error Resume Next
Tooltip = nid.szTip
End Property

Public Property Let Interval(Value As Integer)
On Error Resume Next
TmrFlash.Interval = Value
UpdateIcon NIM_MODIFY
End Property

Public Property Get Interval() As Integer
On Error Resume Next
Interval = TmrFlash.Interval
End Property

Public Property Let TrayIcon(Value)
TmrFlash.Enabled = False
On Error Resume Next
' Value can be a picturebox, image, form or string
Select Case TypeName(Value)
Case "PictureBox", "Image"
Me.Icon = Value.Picture
TmrFlash.Enabled = False
RaiseEvent TIcon(Me)
Case "String"
If (UCase(Value) = "DEFAULT") Then
TmrFlash.Enabled = True
Me.Icon = Flash(1).Picture
RaiseEvent TIcon(Me)
Else
' Sting is filename; load icon from picture file.
TmrFlash.Enabled = True
Me.Icon = LoadPicture(Value)
RaiseEvent TIcon(Me)
End If
Case Else
' It's a form ?
Me.Icon = Value.Icon
RaiseEvent TIcon(Me)
End Select
If Err.Number <> 0 Then TmrFlash.Enabled = True
UpdateIcon NIM_MODIFY
End Property

Sub SetTrayIcon()
On Error Resume Next

RaiseEvent TIcon(Me)
UpdateIcon NIM_MODIFY

Tooltip = strValue
End Sub

Private Sub UpdateIcon(Value As Long)
On Error Resume Next
' Used to add, modify and delete icon.
With nid
.cbSize = Len(nid)
.hWnd = Me.hWnd
.uID = vbNull
.uflags = NIM_DELETE Or NIF_TIP Or NIM_MODIFY
.uCallbackMessage = WM_MOUSEMOVE
.hIcon = Me.Icon
End With
Shell_NotifyIcon Value, nid
End Sub
Private Sub Form_MouseMove(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Dim Result As Long
Dim msg As Long

If Me.ScaleMode = vbPixels Then
msg = X
Else
msg = X / Screen.TwipsPerPixelX
End If

Select Case msg
Case WM_RBUTTONDOWN
RaiseEvent Click("RBUTTONDOWN")
Me.WindowState = 0
Me.Show
Case WM_LBUTTONDBLCLK
RaiseEvent Click("LBUTTONDBLCLK")
Me.WindowState = 0
Me.Show
Case Else
RaiseEvent Click("OTHER....: " & Format$(msg))
End Select
End Sub
Private Sub Form_Resize()
If Me.WindowState = vbMinimized Then
'Ini agar TrayIcon ditampilkan
UpdateIcon NIM_ADD
Me.Hide
Else
'Ini agar TrayIcon dihapus
UpdateIcon NIM_DELETE
End If
End Sub
Private Sub Form_Load()
Me.Timer1.Interval = 1000

RaiseEvent TIcon(Me)

Tooltip = "Sleep Timer by TeRRen.Jr"

UpdateIcon NIM_ADD

End Sub

Private Sub Timer1_Timer()
SetTrayIcon
End Sub


sumber:
esc