Ikon i tray'en til Windows 2000

smider lige 400 point mere i hvis der er nogle der kommer med den rigtige kode :) (Så ialt 500 point)

Jeg henviser til mit tidligere spørgsmål (http://www.eksperten.dk/spm.asp?id=16699). Det virker også i windows2000.

Mvh
TWM

Kig på http://www.mvps.org/vbnet og http://vbaccelerator.com

TWM>>>

Hvis du sender et modul og en fom hvor det virker i windows 2000 så er de 500 point dine !

Jeg har prøvet din løsning TWM og med det resualt at den ikke vil starte op !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

ups glemte at du da skal have en e-mail for at kunne sende det UPS

acp@codename.dk

Lav et Module og paste dette ind:
      Public 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 Const NIM_ADD = &H0
      Public Const NIM_MODIFY = &H1
      Public Const NIM_DELETE = &H2
      Public Const NIF_MESSAGE = &H1
      Public Const NIF_ICON = &H2
      Public Const NIF_TIP = &H4
      Public Const WM_MOUSEMOVE = &H200
      Public Const WM_LBUTTONDOWN = &H201    'Button down
      Public Const WM_LBUTTONUP = &H202      'Button up
      Public Const WM_LBUTTONDBLCLK = &H203  'Double-click
      Public Const WM_RBUTTONDOWN = &H204    'Button down
      Public Const WM_RBUTTONUP = &H205      'Button up
      Public Const WM_RBUTTONDBLCLK = &H206  'Double-click

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

      Public nid As NOTIFYICONDATA


Lav en form med 3 menuer og en knap
top menuen skal hedde mPopupSys og to underpunkter der hedder mPopRestore og mPopExit knappen skal hedde Command1, og paste denne kode ind på formen:

Private Sub Command1_Click()
Me.Hide
End Sub

Private Sub Form_Load()

      Me.Show
      Me.Refresh
      With nid
        .cbSize = Len(nid)
        .hwnd = Me.hwnd
        .uId = vbNull
        .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
        .uCallBackMessage = WM_MOUSEMOVE
        .hIcon = Me.Icon
        .szTip = "This application name is " & App.Title & vbNullChar
      End With
      Shell_NotifyIcon NIM_ADD, nid

      End Sub

      Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

      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_LBUTTONUP
        Me.WindowState = vbNormal
        Result = SetForegroundWindow(Me.hwnd)
        Me.Show
        Case WM_LBUTTONDBLCLK
        Me.WindowState = vbNormal
        Result = SetForegroundWindow(Me.hwnd)
        Me.Show
        Case WM_RBUTTONUP
        Result = SetForegroundWindow(Me.hwnd)
        Me.PopupMenu Me.mPopupSys
      End Select
      End Sub

      Private Sub Form_Resize()

      If Me.WindowState = vbMinimized Then Me.Hide
      End Sub

      Private Sub Form_Unload(Cancel As Integer)

      Shell_NotifyIcon NIM_DELETE, nid
      End Sub

      Private Sub mPopExit_Click()

      Unload Me
      End Sub

      Private Sub mPopRestore_Click()
      'called when the user clicks the popup menu Restore command
      Me.WindowState = vbNormal
      Result = SetForegroundWindow(Me.hwnd)
      Me.Show
      End Sub

Så kan man både bruge højre og venstre klik i systray.

Den kode skal jo for.... kun bruges til et program i ikon, den skal ikke andre ting

bare ligge i trayen og se glad ud, og der skal ikke være et ikon i start linien

Der er jo ingen der siger du skal bruge al koden, for at fjerne programmet fra startlinien sætter du bare formens property ShowInTaskbar til FALSE

der var ingen af delene der virkede så jeg lukker spm. jeg vil også gerne lige sige undskyld fordi det tog så lang tid med jeg i canada i en måneds tid så derfor.....

tak til alle der har vist interesse i dette spm....

Beltzer