Programming Forums
User Name Password Register
 

RSS Feed
FORUM INDEX | TODAY'S POSTS | UNANSWERED THREADS | ADVANCED SEARCH

Reply
 
Thread Tools Display Modes
Old Feb 16th, 2005, 10:23 AM   #1
Cipher
Hobbyist Programmer
 
Cipher's Avatar
 
Join Date: Feb 2005
Location: /home/cipher
Posts: 123
Rep Power: 4 Cipher is on a distinguished road
Send a message via AIM to Cipher Send a message via MSN to Cipher
GOTO Sys. Tray Src. (code Snippet)

I have had a lot of people asking me about to minmize their form to the sys. Tray so I formatted this code that I found.

cheers.

'form code:
Option Explicit

Private Sub Form_Load()
  Init
End Sub

Private Sub Form_Unload(Cancel As Integer)
  RemoveIcon
  Terminate
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim msg As Long

  msg = x / Screen.TwipsPerPixelX
  Select Case msg
    'Case WM_LBUTTONDOWN

    'Case WM_LBUTTONUP

    Case WM_LBUTTONDBLCLK
      Me.Visible = True
      Me.WindowState = 0
    'Case WM_RBUTTONDOWN
            
    'Case WM_RBUTTONUP

    'Case WM_RBUTTONDBLCLK
  
  End Select

End Sub

Public Sub ButtonPressed()
  AddIcon Me, "test"
End Sub

'module code:
Option Explicit

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
  (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
  lpRect As Rect) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, _
  ByVal hWndNewParent As Long) As Long
Private 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
Private Declare Function SetWindowsHookEx Lib "user32" Alias _
  "SetWindowsHookExA" (ByVal idHook&, ByVal lpfn&, ByVal hmod&, ByVal _
  dwThreadId&) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" _
  (ByVal hHook&) As Long
Private 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
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _
  ByVal nCmdShow As Long) As Long

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


Private Type Rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type CWPSTRUCT
    lParam As Long
    wParam As Long
    Message As Long
    hwnd As Long
End Type

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

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

Public Const WM_LBUTTONDBLCLK = &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

Private NID As NOTIFYICONDATA

Const WM_MOVE = &H3
Const WM_SETCURSOR = &H20
Const WM_NCPAINT = &H85
Const WM_COMMAND = &H111

Const SWP_FRAMECHANGED = &H20
Const GWL_EXSTYLE = -20

Private WHook&
Private ButtonHwnd As Long

Public Sub Init()
    'Create the button that is going to be placed in the Titlebar
    ButtonHwnd& = CreateWindowEx(0&, "Button", "-", &H40000000, 50, 50, 14, 14, frmMain.hwnd, 0&, App.hInstance, 0&)
    'Show the button cause itīs invisible
    Call ShowWindow(ButtonHwnd&, 1)
    'Initialize the window hooking for the button
    WHook = SetWindowsHookEx(4, AddressOf HookProc, 0, App.ThreadID)
    Call SetWindowLong(ButtonHwnd&, GWL_EXSTYLE, &H80)
    Call SetParent(ButtonHwnd&, GetParent(frmMain.hwnd))
End Sub

Public Sub Terminate()
    'Terminate the window hooking
    Call UnhookWindowsHookEx(WHook)
    Call SetParent(ButtonHwnd&, frmMain.hwnd)
End Sub

Public Function HookProc&(ByVal nCode&, ByVal wParam&, Inf As CWPSTRUCT)
    Dim FormRect As Rect
    Static LastParam&
    If Inf.hwnd = GetParent(ButtonHwnd&) Then
        If Inf.Message = WM_COMMAND Then
            Select Case LastParam
                'If the LastParam is cmdInTitlebar call the Click-Procedure
                'of the button
                Case ButtonHwnd&: frmMain.ButtonPressed
            End Select
        ElseIf Inf.Message = WM_SETCURSOR Then
            LastParam = Inf.wParam
        End If
        ElseIf Inf.hwnd = frmMain.hwnd Then
        If Inf.Message = WM_NCPAINT Or Inf.Message = WM_MOVE Then
            'Get the size of the Form
            Call GetWindowRect(frmMain.hwnd, FormRect)
            'Place the button int the Titlebar
            Call SetWindowPos(ButtonHwnd&, 0, FormRect.Right - 75, FormRect.Top + 6, 17, 14, SWP_FRAMECHANGED)
        End If
    End If
End Function

Public Sub AddIcon(TheForm As Form, strT As String)
    NID.cbSize = Len(NID)
    NID.hwnd = TheForm.hwnd
    NID.uid = vbNull
    NID.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    NID.uCallBackMessage = WM_MOUSEMOVE
    NID.hIcon = TheForm.Icon
    NID.szTip = strT & vbNullChar
    Shell_NotifyIcon NIM_ADD, NID
    
    TheForm.WindowState = vbMinimized
    TheForm.Hide
End Sub

Public Sub RemoveIcon()
  Shell_NotifyIcon NIM_DELETE, NID
End Sub

Uses the API calls so good luck.
__________________
And there was much rejoicing... Yay....
Cipher is offline   Reply With Quote
Old Oct 17th, 2006, 1:38 PM   #2
Pizentios
Programming Guru
 
Pizentios's Avatar
 
Join Date: May 2004
Location: Brandon, Manitoba, Canada
Posts: 2,023
Rep Power: 7 Pizentios is on a distinguished road
Send a message via ICQ to Pizentios Send a message via MSN to Pizentios
Thread moved to finished projects, as this isn't really a tutorial.
__________________
Profanity is the one language that all programmers understand.

Check out my Blog <---updated Nov 30 2007!
Pizentios is offline   Reply With Quote
Reply

Bookmarks

« Previous Thread in Forum | Next Thread in Forum »

Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
PIC16F84 & KEYPAD hbe02 Assembly 1 Apr 17th, 2006 7:00 PM
How to post a question nnxion C++ 0 Jun 3rd, 2005 8:55 AM
How to post a question nnxion C 0 Jun 3rd, 2005 8:55 AM
Help in QBASIC (I think it's similar to VB) phoenix987 Visual Basic 3 May 9th, 2005 12:33 PM
Help with a QBASIC program phoenix987 Other Programming Languages 4 May 5th, 2005 12:27 PM




DaniWeb IT Discussion Community
All times are GMT -5. The time now is 12:12 PM.

Powered by vBulletin® Version 3.7.0, Copyright ©2000 - 2008, Jelsoft Enterprises Ltd.
Copyright ©2007 DaniWeb® LLC