19. november 2002 - 18:41
#1
Du putter følgende kode ind i din form kode:
'Kode for at fortælle hvornår programmet er
'minimeret
Private Sub Form_Resize()
If Me.ScaleHeight = 0 Then
Me.Visible = False
End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lMsg As Long
lMsg = X / Screen.TwipsPerPixelX
Debug.Print lMsg
Select Case lMsg
Case WM_LBUTTONDBLCLICK
'Kode til venstre dobbelt-klik
Me.WindowState = 0
Me.Show
Case WM_LBUTTONDOWN
'kode når venstre knap holdes nede
Case WM_LBUTTONUP
'Kode for at slippe venstre knap
Case WM_RBUTTONDBLCLK
'kode for højre dobbelt-klik
Case WM_RBUTTONDOWN
'kode når højre knap holdes nede
Case WM_RBUTTONUP
'Kode for at slippe venstre knap
'Typisk til en menu men minimer, osv.
'me.PopupMenu Indstillinger
End Select
End Sub
Derefter laver du et modul (en .bas fil) med følgende:
Option Explicit
'Declarations and constants for at tilføje Ikoner til
'System Tray
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
Private TrayIcon As NOTIFYICONDATA
Public Const WM_LBUTTONDBLCLICK = &H203
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_MOUSEMOVE = &H200
Const NIM_ADD = &H0
Const NIM_MODIFY = &H1
Const NIM_DELETE = &H2
Const NIF_MESSAGE = &H1
Const NIF_ICON = &H2
Const NIF_TIP = &H4
'API declaration der er nødvendig for at tilføje
'Ikon til System Tray
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias _
"Shell_NotifyIconA" (ByVal dwMessage As Long, _
pnid As NOTIFYICONDATA) As Boolean
Public Sub AddIcon(frm As Form, Optional sTip As String)
'Sub til at tilføje Ikonet til
'System Tray når programmet minimeres
With TrayIcon
.cbSize = Len(TrayIcon)
.hwnd = frm.hwnd
.uId = vbNull
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.ucallbackMessage = WM_MOUSEMOVE
.hIcon = frm.Icon
'Teksten der kommer når musen er over Ikonet
If sTip = "" Then
.szTip = frm.Caption & vbNullChar
Else
.szTip = sTip & vbNullChar
End If
End With
'Tilføjer Ikonet
Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
'Skjuler formen
'frm.Hide
End Sub
Public Sub RemoveIcon(frm As Form)
'Sub til at fjerne Ikonet fra
'System Tray når programmet lukkes
With TrayIcon
.cbSize = Len(TrayIcon)
.hwnd = frm.hwnd
.uId = vbNull
End With
'Fjerne Ikonet
Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
End Sub
Og så er der 2 kald:
Call AddIcon 'for at tilføje ikonet nede i hjørnet
Call RemoveIcon 'for at fjerne det igen
/Tubber