Programınızın Simgesi SysTray'de Gözüksün(V.B)

Son güncelleme: 09.04.2008 12:54
  • Program için yalnız 1 adet picturebox gerekli.




    Option Explicit
    Private Type NOTIFYICONDATA
    cbsize As Long
    hWnd As Long
    uld As Long
    uFlags As Long
    ucallbackmessage As Long
    hIcon As Long
    sztip As String * 64
    End Type
    Private Const NIM_ADD = &H0
    Private Const NIM_MODIFY = &H1
    Private Const NIM_DELETE = &H2
    Private Const WM_MOUSEMOVE = &H200
    Private Const NIF_MESSAGE = &H1
    Private Const NIF_ICON = &H2
    Private Const NIF_TIP = &H4

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

    Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
    Dim t As NOTIFYICONDATA
    Dim a As Long

    Private Sub mnucikis_Click()
    Shell_NotifyIcon NIM_DELETE, t
    End
    End Sub

    Private Sub Form_Load()
    t.cbsize = Len(t)
    t.hWnd = Picture1.hWnd
    t.uld = 1&
    t.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    t.ucallbackmessage = WM_MOUSEMOVE
    t.hIcon = Me.Icon
    t.sztip = "(: Tray Icon Uygulamasi :)" & Chr$(0)
    Shell_NotifyIcon NIM_ADD, t
    Me.Hide
    App.TaskVisible = False
    End Sub

    Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Shell_NotifyIcon NIM_DELETE, t
    End Sub

    Private Sub mnueposta_Click()
    'a = Shell("start mailto:mehmetpalaz42@msn.com", vbHide)
    End Sub

    Private Sub mnuteknik_Click()
    a = Shell("explorer Http://www.vbornek.com", vbHide)
    End Sub

    Private Sub picture1_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")
    Case WM_LBUTTONDOWN:
    'Mouse basılı
    Case WM_LBUTTONUP:
    'mouse bırakıldı
    Case WM_RBUTTONDBLCLK:
    'sag tus çift tıklama
    Case WM_RBUTTONDOWN:
    'sag tus basılı
    Case WM_RBUTTONUP:
    'sag tus bırakıldı
    Me.PopupMenu deneme
    End Select
    rec = False
    End If
    End Sub
#06.02.2007 15:23 0 0 0
  • güzel kaynak olmuş...
#20.02.2008 09:11 0 0 0
  • saol :)
#09.04.2008 12:54 0 0 0