digital saat (javada)

murat335

New member
digital saat (visual basic)

PHP:
Option Explicit 'Bütün değişkenler tanıtılmalıdır.

 

'Simgenin özellikleri tanımlanıyor.
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 

'Simgenin olayları tanımlanıyor.
Private Const NIM_ADD = &H0 'EKLE
Private Const NIM_MODIFY = &H1 'YENİLE
Private Const NIM_DELETE = &H2 'KALDIR
Private Const WM_MOUSEMOVE = &H200 'FARE ALGILA
Private Const NIF_MESSAGE = &H1 'tray-PENCERE MESAJI
Private Const NIF_ICON = &H2 'tray-PENCERE SİMGESİ
Private Const NIF_TIP = &H4 'tray-PENCERE İPUCU 

'Tray simgesi üzerine tıklanan tuşlar tanıtılıyor...
Private Const WM_LBUTTONDBLCLK = &H203 'Sol Çift Tıklama
Private Const WM_LBUTTONDOWN = &H201 'Sol Tuş Basma
Private Const WM_LBUTTONUP = &H202 'Sol Tuş Kaldırma
Private Const WM_RBUTTONDBLCLK = &H206 'Sağ Çift Tıklama
Private Const WM_RBUTTONDOWN = &H204 'Sağ Tuş Basma
Private Const WM_RBUTTONUP = &H205 'Sağ Tuş Kaldırma 

'API tanımlanıyor...
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Dim t As NOTIFYICONDATA 

'Formla beraber tray simgesi de yükleniyor...
Private Sub Form_Load()
t.cbSize = Len(t)
t.hWnd = image1.hWnd
t.uId = 1&
t.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
t.ucallbackMessage = WM_MOUSEMOVE
t.hIcon = Me.Icon
t.szTip = "VB#Emin ÖzCAn" & Chr$(0)
End Sub 

'Pencere kapanırken köşedeki simge de iptal oluyor...
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
t.cbSize = Len(t)
t.hWnd = image1.hWnd
t.uId = 1&
Shell_NotifyIcon NIM_DELETE, t
End Sub

 

'Düğmeye basılınca bir güzel köşeye iniliyor...
Private Sub Command1_Click()
Shell_NotifyIcon NIM_ADD, t
Me.Hide
App.TaskVisible = False
End Sub 

Private Sub image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static rec As Boolean, msg As Long
msg = X / Screen.TwipsPerPixelX
If rec = False Then
rec = True
Select Case msg
Case WM_LBUTTONDBLCLK:
MsgBox "Double click !"
Me.Show
Case WM_LBUTTONDOWN:
Case WM_LBUTTONUP:
Case WM_RBUTTONDBLCLK:
Case WM_RBUTTONDOWN:
Case WM_RBUTTONUP:
End Select
rec = False
End If
End Sub
 

HTML

Üst