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
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
Posting Komentar untuk "Buat Form Berada di Sys-Tray"
Jika tidak jelas silakan komentar ya
Terima kasih atas kunjungan Anda.