Visual Basic 6 - Tray Icon con icona personalizzata

Okay..!

ragazzi a me non funziona, le dichiarazioni vanno in un modulo o nel form?? io ho messole dichiarazioni e la windows procedure in un modulo e il resto del codice nel form e mi da un errore qui:

Private Sub Form_Load()
AddButton Me, True, Me.fakebutton
.hWnd , "Show Description", 100, False
End Sub

mi dice argument non optional.. Grazie!!

LoL
già mi ero dimenticato di sto post...ora rileggerlo tutto riga per riga in questo momento non mi va molto....avevo allegato ad uno dei miei post il progetto fià fatto.

si, lo ho scaricato ma è un pò diverso e più complesso... cmq c'è un utente che dice che funziona. io voglio solamente sapere se mettere tutti quei codici in un modulo e o nel form... Grazie!!

Si, devi mettere tutto in un modulo tranne:

'il pulsante fittizzio: name= fakebutton
AddButton Me, True, Me.fakebutton
.hWnd, "Show Description", 100, False

che devi mettere nel fakebutton

ma scusa questo codice non va nella form load e poi nel fake button metto il codice per minimizzare in trayicon??
EDIT:
Ho messo questo codice nella form_load():

'il pulsante fittizzio: name= fakebutton
AddButton Me, True, Me.fakebutton
.hWnd, "Show Description", 100, False

e tutto il resto in un modulo ma l'errore è sempre lo stesso...

Si scusa nella form_load devi mettere il codice...
Non va perchè non c'è l'accapo è una sola riga:

il pulsante fittizzio: name= fakebutton
AddButton Me, True, Me.fakebutton.hWnd, "Show Description", 100, False

ragà scusate se rompo ancora ma non riesco a far funzionare il codice.. ve lo posto:
modulo1:

      'constants required by Shell_NotifyIcon API call:
      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

modulo2:

' ************************************************************************
' Developer:  Robert E. Phelps
' Feel free To use this code As you wish, but please give credit To the
' author.  Do Not sell this code; If you Do, I want a piece of it :) !!!
' ************************************************************************


Public Const HWND_PROP_lpPrevWndProc = "lpPrevWndProc"
Public Const HWND_PROP_hWndMainForm = "hWndMainForm"
Public Const HWND_PROP_hWndTitleBarButton = "hWndTitleBarButton"
Public Const HWND_PROP_hWndTitleBarFakeButton = "hWndTitleBarFakeButton"
Public Const HWND_PROP_TitleBarButtonWidth = "TitleBarButtonWidth"

' Rectangle coordinates
Public Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

' Windows messages
Public Const WM_SIZE = &H5
Public Const WM_LBUTTONUP = &H202           ' Used For command button
Public Const WM_WINDOWPOSCHANGED = &H47
Public Const WM_SETFONT = &H30

' Button messages
Public Const BM_SETCHECK = &HF1             ' Used For toggle button
Public Const BM_CLICK = &HF5                ' Used For command button

' GetWindowLong
Public Const GWL_STYLE = (-16)
Public Const GWL_EXSTYLE = (-20)

' Window styles
Public Const WS_CAPTION = &HC00000
Public Const WS_CHILD = &H40000000
Public Const WS_EX_TOOLWINDOW = &H80
Public Const WS_THICKFRAME = &H40000
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_MINIMIZEBOX = &H20000

' Button styles
Public Const BS_PUSHBUTTON = &H0&           ' Used For command button
Public Const BS_AUTOCHECKBOX = &H3&         ' Used For toggle button
Public Const BS_PUSHLIKE = &H1000           ' Used For toggle button

' WindProc
Public Const GWL_WNDPROC As Long = -4&

' SetWindowPos
Public Const SWP_FRAMECHANGED = &H20
Public Const SWP_NOACTIVATE = &H10

' ShowWindow
Public Const SW_SHOWNOACTIVATE = 4

' SystemMetrics
Public Const SM_CXFIXEDFRAME = 7
Public Const SM_CXSIZEFRAME = 32
Public Const SM_CXSIZE = 30
Public Const SM_CXSMSIZE = 52
Public Const SM_CYCAPTION = 4
Public Const SM_CYSMCAPTION = 51

' Window position
Public Type WINDOWPOS
        hWnd As Long
        hWndInsertAfter As Long
        X As Long
        Y As Long
        cx As Long
        cy As Long
        flags As Long
End Type

' Logical font
Public Const LF_FACESIZE = 32
Public Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName(1 To LF_FACESIZE) As Byte
End Type

' SystemParametersInfo
Public Const SPI_GETNONCLIENTMETRICS = 41
Public Type NONCLIENTMETRICS
    cbSize As Long
    iBorderWidth As Long
    iScrollWidth As Long
    iScrollHeight As Long
    iCaptionWidth As Long
    iCaptionHeight As Long
    lfCaptionFont As LOGFONT
    iSMCaptionWidth As Long
    iSMCaptionHeight As Long
    lfSMCaptionFont As LOGFONT
    iMenuWidth As Long
    iMenuHeight As Long
    lfMenuFont As LOGFONT
    lfStatusFont As LOGFONT
    lfMessageFont As LOGFONT
End Type

' API declarations
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Public Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Public Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function GetFocus Lib "user32" () As Long
Public Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Public Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hWnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal wNewWord As Long) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long

Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, _
                           ByVal wParam As Long, ByVal lParam As Long) As Long

    Dim udtRECT As RECT
    Dim udtWPOS As WINDOWPOS
    Dim X As Long
    Dim Y As Long
    Dim lCapBtnWid As Long
    Dim lBrdWid As Long
    Dim lBtnTop As Long
    Dim lBtnLeft As Long
    Dim lBtnWidth As Long
    Dim lBtnHeight As Long

    Dim hWndMain As Long
    Dim hWndButton As Long
    Dim hWndFakeButton As Long
    Dim lpWndProc As Long


    lpWndProc = GetProp(hWnd, HWND_PROP_lpPrevWndProc)
    hWndMain = GetProp(hWnd, HWND_PROP_hWndMainForm)
    hWndButton = GetProp(hWnd, HWND_PROP_hWndTitleBarButton)

    Select Case hWnd
    Case hWndButton
        WindowProc = CallWindowProc(lpWndProc, hWnd, uMsg, wParam, lParam)
        Select Case uMsg
        Case WM_LBUTTONUP
            If BS_AUTOCHECKBOX <> (GetWindowLong(hWnd, GWL_STYLE) And BS_AUTOCHECKBOX) Then
                ' Command button
                GetHILOWORD lParam, X, Y
                Call GetWindowRect(hWndButton, udtRECT)
                If X >= 0 And X <= udtRECT.Right - udtRECT.Left And _
                   Y >= 0 And Y <= udtRECT.Bottom - udtRECT.Top Then
                    ' Get the handle To control On form that currently has the focus
                    Call SetFocus(hWndMain)
                    hWndButton = GetFocus()

                    ' Send click message To fake button On form
                    hWndFakeButton = GetProp(hWnd, HWND_PROP_hWndTitleBarFakeButton)
                    Call SendMessage(hWndFakeButton, BM_CLICK, 0, 0)

                    ' Return focus To control On form that had the focus originally
                    Call SetFocus(hWndButton)
                End If
            End If
        Case BM_SETCHECK
            ' Toggle button
            hWndFakeButton = GetProp(hWnd, HWND_PROP_hWndTitleBarFakeButton)
            Call SendMessage(hWndFakeButton, BM_SETCHECK, wParam, 0)
            Call SetFocus(hWndMain)
        End Select
    Case hWndMain
        Select Case uMsg
        Case WM_WINDOWPOSCHANGED, WM_SIZE
            If uMsg = WM_WINDOWPOSCHANGED Then
                ' Get Main form RECT from WINDOWPOS passed In lParam
                CopyMemory udtWPOS, ByVal lParam, Len(udtWPOS)
                udtRECT.Left = udtWPOS.X
                udtRECT.Right = udtWPOS.X + udtWPOS.cx
                udtRECT.Top = udtWPOS.Y
                udtRECT.Bottom = udtWPOS.Y + udtWPOS.cy
            Else
                ' WM_SIZE, so Get Main form RECT
                Call GetWindowRect(hWndMain, udtRECT)
            End If
            If WS_EX_TOOLWINDOW <> (GetWindowLong(hWnd, GWL_EXSTYLE) And WS_EX_TOOLWINDOW) Then
                If WS_THICKFRAME <> (GetWindowLong(hWnd, GWL_STYLE) And WS_THICKFRAME) Then
                    ' Fixed-Single And Fixed-Dialog
                    lBrdWid = GetSystemMetrics(SM_CXFIXEDFRAME)
                    lCapBtnWid = GetSystemMetrics(SM_CXSIZE)
                    lBtnHeight = GetSystemMetrics(SM_CYCAPTION) - 5
                Else
                    ' Sizable
                    lBrdWid = GetSystemMetrics(SM_CXSIZEFRAME)
                    lCapBtnWid = GetSystemMetrics(SM_CXSIZE)
                    lBtnHeight = GetSystemMetrics(SM_CYCAPTION) - 5
                End If
            Else
                If WS_THICKFRAME <> (GetWindowLong(hWnd, GWL_STYLE) And WS_THICKFRAME) Then
                    ' Fixed ToolWindow
                    lBrdWid = GetSystemMetrics(SM_CXFIXEDFRAME)
                    lCapBtnWid = GetSystemMetrics(SM_CXSMSIZE)
                    lBtnHeight = GetSystemMetrics(SM_CYSMCAPTION) - 5
                Else
                    ' Sizable ToolWindow
                    lBrdWid = GetSystemMetrics(SM_CXSIZEFRAME)
                    lCapBtnWid = GetSystemMetrics(SM_CXSMSIZE)
                    lBtnHeight = GetSystemMetrics(SM_CYSMCAPTION) - 5
                End If
            End If

            ' Button pos
            lBtnTop = udtRECT.Top + lBrdWid + 2
            lBtnWidth = GetProp(hWndButton, HWND_PROP_TitleBarButtonWidth)
            If lBtnWidth = 0 Then
                ' Use default caption button width
                lBtnWidth = lCapBtnWid - 2
            End If
            If (WS_MINIMIZEBOX = (GetWindowLong(hWnd, GWL_STYLE) And WS_MINIMIZEBOX) Or _
               WS_MAXIMIZEBOX = (GetWindowLong(hWnd, GWL_STYLE) And WS_MAXIMIZEBOX)) And _
               WS_EX_TOOLWINDOW <> (GetWindowLong(hWnd, GWL_EXSTYLE) And WS_EX_TOOLWINDOW) Then
                ' Calculate left pos of Min button
                lBtnLeft = udtRECT.Right - lBrdWid - lCapBtnWid - lCapBtnWid - lCapBtnWid + 2
                ' Calculate left pos of Titlebar button
                lBtnLeft = lBtnLeft - lBtnWidth - 2
            Else
                ' Calculate left pos of X button
                lBtnLeft = udtRECT.Right - lBrdWid - lCapBtnWid
                ' Calculate left pos of Titlebar button
                lBtnLeft = lBtnLeft - lBtnWidth - 2
            End If

            ' Position the button over the Titlebar of the form; remember, no parent (0)
            Call SetWindowPos(hWndButton, 0, lBtnLeft, lBtnTop, lBtnWidth, lBtnHeight, SWP_FRAMECHANGED + SWP_NOACTIVATE)
        End Select
        WindowProc = CallWindowProc(lpWndProc, hWnd, uMsg, wParam, lParam)
    End Select

End Function

Public Sub GetHILOWORD(lParam As Long, LOWORD As Long, HIWORD As Long)

    ' LOWORD of the lParam
    LOWORD = lParam And &HFFFF&
    ' LOWORD now equals 65,535 Or &HFFFF

    ' HIWORD of the lParam
    HIWORD = lParam \ &H10000 And &HFFFF&
    ' HIWORD now equals 30,583 Or &H7777

End Sub

class1:

' ************************************************************************
' Developer:  Robert E. Phelps
' Feel free To use this code As you wish, but please give credit To the
' author.  Do Not sell this code; If you Do, I want a piece of it :) !!!
' ************************************************************************


Private hWndButton As Long
Private hWndMain As Long

Public Sub AddButton(ByRef frm As Form, ByVal bToggleButton As Boolean, _
                     ByVal hWndFakeButton As Long, ByVal sText As String, _
                     ByVal lWidthInPixels As Long, ByVal bCaptionButtonStyle As Boolean)

    Dim udtNCM As NONCLIENTMETRICS
    Dim udtLogFontCap As LOGFONT
    Dim hFont As Long
    Dim hWndParent As Long
    Dim lpWndProc As Long


    ' Validation
    If frm.BorderStyle = 0 Then Exit Sub
    If hWndFakeButton = 0 Then Exit Sub
    If bCaptionButtonStyle Then
        ' Use default caption button width
        lWidthInPixels = 0
    Else
        If lWidthInPixels <= 0 Then Exit Sub
    End If

    ' The button will be a free-floating window that has no parent (0)
    hWndMain = frm.hWnd
    hWndParent = 0

    ' Create button, remove window border, And Set parent To none
    If Not bToggleButton Then
        ' Command button
        hWndButton = CreateWindowEx(0, "Button", sText, BS_PUSHBUTTON, 20, 20, 20, 20, hWndMain, 0, App.hInstance, 0)
    Else
        ' Toggle button
        hWndButton = CreateWindowEx(0, "Button", sText, BS_PUSHLIKE + BS_AUTOCHECKBOX, 20, 20, 20, 20, hWndMain, 0, App.hInstance, 0)
    End If
    Call SetWindowLong(hWndButton, GWL_STYLE, GetWindowLong(hWndButton, GWL_STYLE) - WS_CAPTION)
    Call SetParent(hWndButton, hWndParent)

    ' Get Non-Client Metrics
    udtNCM.cbSize = Len(udtNCM)
    Call SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, udtNCM, 0)

    ' Select caption font For BorderStyle
    Select Case frm.BorderStyle
        Case 1, 2, 3: udtLogFontCap = udtNCM.lfCaptionFont
        Case 4, 5: udtLogFontCap = udtNCM.lfSMCaptionFont
    End Select

    ' Use absolute value For font height
    udtLogFontCap.lfHeight = Abs(udtLogFontCap.lfHeight)
    If WS_EX_TOOLWINDOW = (GetWindowLong(hWndMain, GWL_EXSTYLE) And WS_EX_TOOLWINDOW) Then
        ' Reduce font size For ToolWindow
        udtLogFontCap.lfHeight = udtLogFontCap.lfHeight - 1
    End If

    ' Get handle To retrieved caption font And Set font To button
    hFont = CreateFontIndirect(udtLogFontCap)
    Call SendMessage(hWndButton, WM_SETFONT, hFont, ByVal True)

    ' Sub-class Main form And Set window properties For callback Function
    lpWndProc = SetWindowLong(hWndMain, GWL_WNDPROC, AddressOf WindowProc)
    Call SetProp(hWndMain, HWND_PROP_lpPrevWndProc, lpWndProc)
    Call SetProp(hWndMain, HWND_PROP_hWndMainForm, hWndMain)
    Call SetProp(hWndMain, HWND_PROP_hWndTitleBarButton, hWndButton)

    ' Sub-class Titlebar button And Set window properties For callback Function
    lpWndProc = SetWindowLong(hWndButton, GWL_WNDPROC, AddressOf WindowProc)
    Call SetProp(hWndButton, HWND_PROP_lpPrevWndProc, lpWndProc)
    Call SetProp(hWndButton, HWND_PROP_hWndMainForm, hWndMain)
    Call SetProp(hWndButton, HWND_PROP_hWndTitleBarButton, hWndButton)
    Call SetProp(hWndButton, HWND_PROP_TitleBarButtonWidth, lWidthInPixels)
    Call SetProp(hWndButton, HWND_PROP_hWndTitleBarFakeButton, hWndFakeButton)

    ' Set the Fake TitleBar toggle button To Unchecked by default
    If bToggleButton Then Call SendMessage(hWndFakeButton, BM_SETCHECK, 0, 0)

    ' Set button pos before showing, must be called twice
    Call PostMessage(hWndMain, WM_SIZE, 0, 0)
    Call PostMessage(hWndMain, WM_SIZE, 0, 0)
    Call ShowWindow(hWndButton, SW_SHOWNOACTIVATE)

    ' Return focus To Main form
    Call SetFocus(hWndMain)
End Sub

form1:

Private Sub fakebutton_Click()
'the form must be fully visible before calling Shell_NotifyIcon
       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 = "Your ToolTip" & vbNullChar
       End With
       Shell_NotifyIcon NIM_ADD, nid
Me.Hide
End Sub

Private Sub Form_Load()
Class1.AddButton Me, True, Form1.fakebutton.hWnd, ".", 100, False
End Sub

     Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
      'this procedure receives the callbacks from the System Tray icon.
      Dim Result As Long
      Dim msg As Long
       'the value of X will vary depending upon the scalemode setting
       If Me.ScaleMode = vbPixels Then
        msg = X
       Else
        msg = X / Screen.TwipsPerPixelX
       End If
       Select Case msg
        Case Module1.WM_LBUTTONUP        '514 restore form window
         Me.WindowState = vbNormal
         Result = SetForegroundWindow(Me.hWnd)
         Me.Show
        Case WM_LBUTTONDBLCLK    '515 restore form window
         Me.WindowState = vbNormal
         Result = SetForegroundWindow(Me.hWnd)
         Me.Show
        Case WM_RBUTTONUP        '517 display popup menu
         Result = SetForegroundWindow(Me.hWnd)
         Me.PopupMenu Me.mPopupSys
       End Select
      End Sub

      Private Sub Form_Resize()
       'this is necessary to assure that the minimized window is hidden
       If Me.WindowState = vbMinimized Then Me.Hide
      End Sub

      Private Sub Form_Unload(Cancel As Integer)
       'this removes the icon from the system tray
       Shell_NotifyIcon NIM_DELETE, nid
      End Sub

      Private Sub mPopExit_Click()
       'called when user clicks the popup menu Exit command
       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

L'errore che mi da appena faccio partire il programma è object required... Grazie!!