Zu diesem Zweck habe ich den nachfolgenden Code geschrieben.

Das Funktions-Prinzip:

Wir versehen unsere Anwendung mit einem Icon im TaskTray und fangen den Original-Befehl des "Minimieren"-Buttons ab, der zum sogenannten "Non Client"-Bereich gehört. Dann ersetzen wir dessen Befehl mit unserem eigenen, nämlich mit dem "Fließeffekt". Das ist schon alles

Schreiten wir zur Tat:
Wir starten Visual Basic und erstellen ein neues Standard-EXE-Projekt. Wir geben dem Projekt den Namen "FormFliesstZumTrayIcon".

Zu unserem standardmäßig vorhandenen Formular* "Form1" das wir zum TaskTray fließen lassen wollen, (*es können auch mehrere sein) fügen wir unserem Projekt noch 2 weitere Elemente hinzu:

• 1 Formular, Name: "frmTrayIcon" und
• 1 Bas-Modul, Name: "basFormFliesstZumTrayIcon"

Als erstes kümmern wir uns darum, unserer Anwendung ein TrayIcon zu verschaffen. Dazu bedienen wir uns des Tipps  Anzeigen der Anwendung im System Tray vom Autor Mephisto. Dadurch haben wir unter anderem den Vorteil, dass wir keine extra PictureBox mit einem Symbol brauchen.

Wir wissen aber nicht, was in dem jeweiligen zukünftigen Projekt an Forms auf uns zukommt. Eine Form oder mehrere, oder auch rahmenlose Forms. Na denn, bereiten wir uns auf alles vor und spendieren unserem Code eine eigene Form:

Die Form "frmTrayIcon"

Diese wird später unsichtbar bleiben und vollkommen unabhängig sein.

Wir erstellen ein Menü mit folgenden Einträgen:

Unser oberstes Menü:

Dann 3 Unterpunkte (einmal Pfeil nach rechts)

Name: mnuPopUp (bei allen)

Dann fügen wir im Formular den folgenden Code ein:

' Anfang Code "frmTrayIcon" ---------------------------------------------------
 
Option Explicit
 
' Benötigte Deklarationen:
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 nid As NOTIFYICONDATA
 
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
 
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
 
Private Const WM_MOUSEMOVE = &H200
 
' Konstanten für linke Maustaste
Private Const WM_LBUTTONDBLCLK = &H203   ' Doppelklick
Private Const WM_LBUTTONDOWN = &H201     ' Maus gedrückt
Private Const WM_LBUTTONUP = &H202       ' Maus losgelassen
' Konstanten für rechte Maustaste
Private Const WM_RBUTTONDBLCLK = &H206   ' Doppelklick
Private Const WM_RBUTTONDOWN = &H204     ' Maus gedrückt
Private Const WM_RBUTTONUP = &H205       ' Maus losgelassen
 
Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_LWIN = &H5B
 
Private Declare Sub keybd_event Lib "user32" ( _
  ByVal bVk As Byte, _
  ByVal bScan As Byte, _
  ByVal dwFlags As Long, _
  ByVal dwExtraInfo As Long)
 
Private Declare Function Shell_NotifyIcon Lib "shell32" _
  Alias "Shell_NotifyIconA" ( _
  ByVal dwMessage As Long, _
  pnid As NOTIFYICONDATA) As Boolean

' Und nun unsere Prozeduren
Private Sub Form_Load()   
  ' Formular unsichtbar machen
  Me.Visible = False
 
  ' "frmTrayIcon" wurde unsichtbar geladen
  Call IconInSysTray(frmTrayIcon)  ' Form im Systray anzeigen
 
  ' Variablen zu "NonClientButton ein/ausschalten"
  m_blnMin = True
  m_blnMax = True
  m_blnClose = True    
End Sub

' Wenn das TrayIcon angezeigt wird, werden alle Maus-Ereignisse an
' "frmTrayIcon" weitergeleitet und können im "Form_MouseMove"
' -Ereignis abgefragt werden. Das MouseMove Ereignis wird ausgelöst,
' wenn die Maus über das Symbol im Systray geführt wird.
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
  x As Single, y As Single)
 
  Dim lMsg As Long
 
  lMsg = x / Screen.TwipsPerPixelX  
  Select Case lMsg     
    ' Linke Maustaste ---------------------------------
    Case WM_LBUTTONDOWN  ' linke Maustaste wird gedrückt
 
    Case WM_LBUTTONUP  ' linke Maustaste wird losgelassen
      ' Die AktuelleForm zum/aus TrayIcon fließen lassen
      Call FormFliesstZumTray(AktuelleForm)
 
    Case WM_LBUTTONDBLCLK  ' linke Maustaste - Doppelklick
 
 
    ' Rechte Maustaste --------------------------------
    Case WM_RBUTTONDOWN   ' rechte Maustaste wird gedrückt
 
    Case WM_RBUTTONUP  ' rechte Maustaste wird losgelassen
      PopupMenu MenuPopUp  ' (Popup-Menü öffnen)
 
    Case WM_RBUTTONDBLCLK  ' rechte Maustaste - Doppelklick
 
  End Select
End Sub

' Beim Klicken auf einen Menü-Eintrag im PopUp-Menü den entsprechende
' Code ausführen. Das Menü kann nach eigenem Ermessen gekürzt oder
' erweitert werden, wie jedes "ganz normale" Menü.
Private Sub mnuPopUp_Click(Index As Integer)
  Select Case Index
    Case 0
      ' Verstecken/Wiederherstellen des aktuellen Fensters
      ' Die AktuelleForm zum/aus TrayIcon fließen lassen
      Call FormFliesstZumTray(AktuelleForm)
 
    Case 1
      ' Abbrechen
      ' Dient dazu, das PopUp-Menü ohne Aktion wieder zu schliessen
 
    Case 2
      ' Beenden
      Unload Me
      End
  End Select
End Sub

Private Sub IconInSysTray(FormName As Form)
  ' Symbol der Anwendung zum SysTray hinzufügen
  With nid
    .cbSize = Len(nid)
    .hWnd = FormName.hWnd
    .uId = vbNull
    .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    .uCallBackMessage = WM_MOUSEMOVE
    .hIcon = FormName.Icon
    .szTip = FormName.Caption & vbNullChar
  End With
 
  Shell_NotifyIcon NIM_ADD, nid
End Sub

Private Sub Form_Unload(Cancel As Integer)
  ' Symbol aus dem Systray entfernen, wenn das Programm beendet wird
  Call Shell_NotifyIcon(NIM_DELETE, nid)
 
  ' Rückgängigmachen der "NonClientAreaClick ermitteln"-Funktion
  SetWindowLong AktuelleForm.hWnd, GWL_WNDPROC, OldWindowProc
 
  ' Alle Forms entladen
  Dim oForm As Form
  For Each oForm In Forms
    Unload oForm
  Next
End Sub
 
  ' Ende Code "frmTrayIcon" --------------------------------------------------- 

Außer dem Code für das TrayIcon erscheinen auch schon Befehle, die zu anderen Code-Bereichen gehören. Darauf gehen wir später ein.

Unser Form-Modul "frmTrayIcon" ist somit schon fertig. (Das war doch einfach )

Modul "basFormFliesstZumTrayIcon"

Jetzt wird's schwieriger: wir nehmen das Bas-Modul "basFormFliesstZumTrayIcon" in Angriff.

Um den Überblick zu behalten, teilen wir dieses Modul in 3 Bereiche ein und zeigen das auch mit optischen Abgrenzungen:

' 1) Der Deklarations-Bereich (ganz nach oben)
' ====================================================================
'                       Deklarationen (Anfang)
' ====================================================================
	Hier hinein setzen wir alle benötigten Deklarationen, 
  sowohl für API-Funktionen als auch für benutzerdefinierte Datentypen
' ====================================================================
'                        Deklarationen (Ende)
' ====================================================================

' 2) Der Bereich für eigene Aktionen (in der Mitte unseres Bas-Moduls)
' ====================================================================
' ===================== Eigene Aktionen (Anfang) =====================
' ====================================================================
	Hier stehen die 3 eigenen Aktionen: 
  für den Minimize-, Maximize- und Close-Button
' ====================================================================
' ====================== Eigene Aktionen (Ende) ======================
' ====================================================================

' 3) Der Code-Bereich (unten im Bas-Modul)
' ====================================================================
'                  Prozeduren & Funktionen (Anfang)                
' ====================================================================
	Dieser Code-Bereich ist der größte Bereich. 
  Hier hinein schreiben wir alle übrigen Funktionen und Prozeduren
' ====================================================================
'                   Prozeduren & Funktionen (Ende)
' ====================================================================

Das waren die Vorbereitungen. Jetzt wollen wir programmieren.

Als Nächstes kümmern wir uns um den "Fließeffekt".

Um einen Effekt zu erzeugen, bei dem es so aussieht, als ob ein Formular zum TaskTray fließt, lassen wir das jeweilige Formular stückchenweise schrumpfen und bewegen es dabei in Richtung TaskTray (bei der Uhr).

Im Deklarations-Bereich fügen wir ein:

' Zu "Form zum TaskTray fließen lassen"
'   Autor: Guido Eisenbeis
'
Public AktuelleForm As Form     ' Übergabe des jeweiligen Fensters
Public ResizeFactor As Long     ' Geschwindigkeit einstellen
Public ResizeEffect As Long     ' Effekt wählen
Public OldLeft As Long, OldTop As Long
Public OldWidth As Long, OldHeight As Long
Public MindestBreite As Long, MindestHöhe As Long
Public StückWeite As Long, StückHöhe As Long
Public StückRüber As Long, StückHoch As Long
Public Rechts As Long, Unten As Long
 
' Anmerkungen:
' "Rechts" ist die Position, die optisch ungefähr ein kleines Stück
' links neben der Systemuhr liegt (10% der Desktop-Weite). Dadurch
' sieht es so aus, als würde die Form in den SystemTray fließen.

Im Code-Bereich fügen wir unseren "Fließeffekt" ein:

' Form zum TaskTray fließen lassen
' Gudio Eisenbeis Software (GES), guidoeisenbeis@web.de, 2003-09-02
'
' Hinweis: ShowInTaskbar der Form zur Entwicklungszeit ausgeschalten.
'
Public Sub FormFliesstZumTray(ZuMinimierendeForm As Form)
  Rechts = DesktopWeite * 0.9 ' 90% der Desktop-Weite
  Unten = DesktopHöhe
 
  With ZuMinimierendeForm
    If .Top < Unten Then  ' Form in SysTray fließen lassen
 
      If AktuelleForm.WindowState = vbMaximized Then _
        AktuelleForm.WindowState = vbNormal
 
      ' Falls "ShowInTaskbar" zur Entwicklungszeit nicht auf 'False'
      ' gestellt wurde, resultiert daraus ein Laufzeitfehler, wenn das
      ' Formular über die Taskleiste minimiert und über das TrayIcon
      ' wiederhergestellt wird.
      ' Deshalb hier darauf hinweisen und abbrechen.
      If .WindowState = vbMinimized Then
        MsgBox "'ShowInTaskbar' zur Entwicklungszeit auf 'False' stellen."
        Unload frmTrayIcon
        Exit Sub
      End If
 
      .ScaleMode = vbTwips  ' auf Twips setzen
 
      ' Form zurückholen, falls zu weit über den rechten Desktop-Rand
      If .Left > Rechts Then .Left = Rechts - 400
 
      ' Position und Maße der Form speichern
      OldLeft = .Left
      OldTop = .Top
      OldWidth = .Width
      OldHeight = .Height
 
      ' (Hier ruhig mal Effekte auspobieren. Max-Wert: 400)
      ' z.B. ResizeFactor = 80  ' ändert die Geschwindigkeit
 
      If ResizeFactor = 0 Then ResizeFactor = 40  ' Grundeinstellung
      If ResizeEffect = 0 Then ResizeEffect = 2   ' Grundeinstellung
 
      ' Wert um den die (siehe *) vermindert oder vergrößert wird.
      StückWeite = .Width / ResizeFactor            ' (* Weite)
      StückHöhe = .Height / ResizeFactor            ' (* Höhe)
      StückRüber = (Rechts - .Left) / ResizeFactor  ' (* Left-Position)
      StückHoch = (Unten - .Top) / ResizeFactor     ' (* Top-Position)
      MindestBreite = .Width - .ScaleWidth
      MindestHöhe = .Height - .ScaleHeight
      If MindestBreite < 1000 Then MindestBreite = 1000
      If MindestHöhe < 400 Then MindestHöhe = 400
 
      ' Form zum SysTray bewegen und dabei verkleinern
      Do Until .Top > Unten
        .Move .Left + StückRüber, .Top + StückHoch
        If .Width > MindestBreite Then .Width = .Width - StückWeite
        If ResizeEffect = 2 Then
          If .Height > MindestHöhe Then .Height = .Height - StückHöhe
        Else
          .Height = MindestHöhe
        End If
        DoEvents
      Loop  ' Abbrechen wenn Form-Position außerhalb vom Desktop
 
      .Hide  ' Form wird aus der Taskleiste entfernt
 
    Else  ' Form aus SysTray fließen lassen
      .Show
 
      ' Form mit Mindestmaßen an der ungefähren Position
      ' eines SysTray-Icons einblenden
      .Move Rechts, Unten, MindestBreite, MindestHöhe
 
      ' Form zur Ausgangs-Position bewegen und dabei vergrößern
      Do
        .Move .Left - StückRüber, .Top - StückHoch
        If .Width < OldWidth Then .Width = .Width + StückWeite
        If ResizeEffect = 2 And .Height < OldHeight Then _
                                .Height = .Height + StückHöhe
        DoEvents
      Loop Until .Left < OldLeft + StückRüber * 2 And .Top < OldTop + StückHoch * 2
      ' ^ Abbrechen, wenn Ausgangs-Position fast erreicht ist ^
 
      ' Genaue Ausgangs-Position und -Größe wiederherstellen
      .Move OldLeft, OldTop, OldWidth, OldHeight
 
      If m_blnMin = False Then
        ' "Minimieren"-Button wieder sichtbar machen
        m_blnMin = Not m_blnMin
        Call EnableMinButton(AktuelleForm.hWnd, m_blnMin)
      End If
 
      If m_blnClose = False Then
        ' "Schließen"-Button wieder sichtbar machen
        m_blnClose = Not m_blnClose
        Call EnableCloseButton(AktuelleForm.hWnd, m_blnClose)
      End If
    End If
  End With
End Sub

Somit ist unser "Fließeffekt" einsatzbereit und kann z.B. mit Hilfe des TrayIcons benutzt werden (siehe im Code von "frmTrayIcon").

Klicken wir jedoch den normalen "Minimize"-Button an, so wird z.B. unsere Form1 einfach ganz normal minimiert. Um das zu ändern und mit unserem "Fließeffekt" auszustatten, kommt nun der Löwenanteil unserer Programmieraufgabe:

Das Abfangen der NonClientArea-Buttons.

Uns würde der Minimize-Button eigentlich genügen, aber wenn wir schon dabei sind, nehmen wir den Maximize- und den Close-Button auch mit hinein, um z.B. unsere jeweilige Anwendung beim Klick auf den "Schliessen"-Button nicht zu schliessen, sondern zu minimieren.

Das Abfangen der NonClientArea-Buttons besteht aus 2 Teilen:
Zum Einen wird ermittelt, ob ein solcher Button geklickt wird (im Abschnitt "NonClientAreaClick ermitteln"), zum Anderen wird dann in dem Moment dieser Button abgeschaltet (disabled) (im Abschnitt "NonClientButton ein/ausschalten"), wodurch er auch gleichzeitig ausgeblendet wird. (Weil das natürlich blöd aussehen würde, blenden wir ihn wieder ein. Dazu muss der Befehl lediglich an geeigneter Stelle wiederholt werden, nachdem unsere eigene Aktion ausgeführt wurde.) Danach kann unser eigener Befehl eingesetzt werden, der den "Fließ"-Effekt (zum oder aus dem TrayIcon) aufruft.

Ich habe mich für nachfolgenden Code entschlossen ...

Es gäbe auch noch die Möglichkeit, das Abfangen der NonClientArea-Buttons mit Hilfe der "PeekMessage"-Funktion zu bewerkstelligen. Dies hatte jedoch in einigen Tests recht unliebsame Wechselwirkungen mit anderem Programm-Code, bis hin zum kompletten Programm-Absturz, der auch die IDE mit runter riss.

Wie gesagt: Ich habe mich für nachfolgenden Code entschlossen.

Er ist absolut stabil (dafür "ein wenig" länger .
Er ist in der Lage, den jeweiligen Button so abzufangen, dass es vom Anwender optisch nicht wahrgenommen wird, z.B. dass der Button "ausgegraut" wird. Aber vor allem werden die Klicks auf die Buttons so abgefangen, dass sie auch aus der anstehenden Befehls-Warteschlange entfernt sind. Das bedeutet, wir bekommen keine Schwierigkeiten mit einem Prozessor der in einer Schleife hochläuft.

Wir programmieren wieder.

Im Deklarations-Bereich fügen wir ein:

' Zu "NonClientAreaClick ermitteln"
' Autor: (unbekannt)
 
Private 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 SetWindowLong Lib "user32" _
  Alias "SetWindowLongA" ( _
  ByVal hWnd As Long, _
  ByVal nIndex As Long, _
  ByVal dwNewLong As Long) As Long
 
Private Const WM_NCRBUTTONDOWN = &HA4
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTBORDER = 18
Private Const HTBOTTOM = 15
Private Const HTBOTTOMLEFT = 16
Private Const HTBOTTOMRIGHT = 17
Private Const HTCAPTION = 2
Private Const HTCLOSE = 20
Private Const HTGROWBOX = 4
Private Const HTLEFT = 10
Private Const HTMAXBUTTON = 9
Private Const HTMINBUTTON = 8
Private Const HTRIGHT = 11
Private Const HTSYSMENU = 3
Private Const HTTOP = 12
Private Const HTTOPLEFT = 13
Private Const HTTOPRIGHT = 14
 
Public Const GWL_WNDPROC = (-4)
Public Const WM_USER = &H400
Public OldWindowProc As Long
 
' Um einen Doppelklick auf das Systemmenü zu verhindern
Private Declare Function GetCursorPos Lib "user32" _
  (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" _
  (ByVal x As Long, ByVal y As Long) As Long
 
Private Type POINTAPI
  x As Long
  y As Long
End Type

' Zu "NonClientButton ein/ausschalten"
' Autor: (unbekannt)
 
Private Declare Function GetSystemMenu Lib "user32" ( _
  ByVal hWnd As Long, _
  ByVal bRevert As Long) As Long
 
Private Declare Function GetMenuItemInfo Lib "user32" _
  Alias "GetMenuItemInfoA" ( _
  ByVal hMenu As Long, _
  ByVal un As Long, _
  ByVal b As Boolean, _
  lpMenuItemInfo As MENUITEMINFO) As Long
 
Private Declare Function SetMenuItemInfo Lib "user32" _
  Alias "SetMenuItemInfoA" ( _
  ByVal hMenu As Long, _
 
  ByVal un As Long, _
  ByVal bool As Boolean, _
  lpcMenuItemInfo As MENUITEMINFO) As Long
 
Private Declare Function SendMessage Lib "user32" _
  Alias "SendMessageA" ( _
  ByVal hWnd As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  lParam As Any) As Long
 
Private Declare Function IsWindow Lib "user32" _
  (ByVal hWnd As Long) As Long
 
Private Declare Function GetWindowLong Lib "user32" _
  Alias "GetWindowLongA" ( _
  ByVal hWnd As Long, _
  ByVal nIndex As Long) As Long
 
' 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 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 Const SC_CLOSE As Long = &HF060&
Private Const SC_MAXIMIZE As Long = &HF030&
Private Const SC_MINIMIZE As Long = &HF020&
 
Private Const xSC_CLOSE As Long = -10&
Private Const xSC_MAXIMIZE As Long = -11&
Private Const xSC_MINIMIZE As Long = -12&
 
Private Const GWL_STYLE = (-16)
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
 
Private Const hWnd_NOTOPMOST = -2
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_FRAMECHANGED = &H20
 
Private Const MIIM_STATE As Long = &H1&
Private Const MIIM_ID As Long = &H2&
Private Const MFS_GRAYED As Long = &H3&
Private Const WM_NCACTIVATE As Long = &H86
 
Private Type MENUITEMINFO
  cbSize As Long
  fMask As Long
  fType As Long
  fState As Long
  wID As Long
  hSubMenu As Long
  hbmpChecked As Long
  hbmpUnchecked As Long
  dwItemData As Long
  dwTypeData As String
  cch As Long
End Type
 
Public m_blnClose As Boolean
Public m_blnMin As Boolean
Public m_blnMax As Boolean

Non-Client-Buttons mit eigenen Aktionen ausstatten

Im Code-Bereich fügen wir ein:

' *********************************************************************
'                 Abfangen des NonClientButton-Klicks                 *
'                  und mit eigenen Aktionen ersetzen                  *
' *********************************************************************
'                                                                     '
 
' Prozedur zum Übergeben der NonClientButton-Steuerung
 
Public Sub NonClientAreaSteuerung(ZuInitialisierendeForm As Form, _
  AusblendEffekt As Long, ReduzierFaktor As Long)
 
  ResizeEffect = AusblendEffekt
  ResizeFactor = ReduzierFaktor
 
  ' Rückgängigmachen der "NonClientAreaClick ermitteln"-Funktion
  SetWindowLong AktuelleForm.hWnd, GWL_WNDPROC, OldWindowProc
 
  ' Das nächste gewünschte Formular als aktuelles Formular setzen
  Set AktuelleForm = ZuInitialisierendeForm
 
  ' Initialisieren der "NonClientAreaClick ermitteln"-Funktion
  OldWindowProc = SetWindowLong(AktuelleForm.hWnd, _
    GWL_WNDPROC, AddressOf NewWindowProc)
End Sub

' *********************************************************************************
' Abfangen der NonClientAreaButtons
' ***********************(Anfang)**************************************************
'
' Autor: ? (Idee und Kombination der Funktionen):
' Guido Eisenbeis, guidoeisenbeis@web.de, 2003-09-02
'
' Das Abfangen der NonClientButtons besteht aus 2 Teilen:
' Zum Einen wird ermittelt, ob ein NonClientButton geklickt wird
' (in "NonClientAreaClick ermitteln"), zum Anderen wird dann in dem
' Moment dieser NonClientButton abgeschaltet (disable)
' (in "NonClientButton ein/ausschalten"), wodurch er auch
' gleichzeitig ausgeblendet wird. Damit er wieder eingeblendet wird,
' muss der Befehl, je nachdem welche eigene Aktion ausgeführt wird,
' an geeigneter Stelle wiederholt werden.
'
'
' NonClientAreaClick ermitteln -------------------------------------- v
' Autor: (unbekannt)
 
' Display messages for non-client border and button events.
 
Public Function NewWindowProc(ByVal hWnd As Long, ByVal MSG As Long, _
  ByVal wParam As Long, ByVal lParam As Long) As Long
 
  Static num As Long
 
  ' Linke Maustaste wird gedrückt
  If MSG = WM_NCLBUTTONDOWN Then
    Select Case wParam
      ' "Minimieren"-Button
      Case HTMINBUTTON
        Call EigeneMinButtonAktion
 
      ' "Maximieren"-Button
      Case HTMAXBUTTON
        Call EigeneMaxButtonAktion
 
      ' "Schliessen"-Button
      Case HTCLOSE
        Call EigeneCloseButtonAktion
 
      ' "Systemmenü" (ausschalten)
      Case HTSYSMENU
        Dim MausPosition As POINTAPI
 
        ' Maus ein Stück nach rechts setzen, damit kein
        ' Doppelklick auf das Systemmenü ausgeführt werden kann.
        ' Denn auch ohne Systemmenü würde ein Doppelklick das
        ' Programm beenden.
        GetCursorPos MausPosition
        SetCursorPos MausPosition.x + 40, MausPosition.y
        NewWindowProc = 0
        Exit Function
    End Select
   End If
 
    ' Rechte Maustaste wird gedrückt
   If MSG = WM_NCRBUTTONDOWN Then  ' Systemmenü ausschalten
     Exit Function
   End If
 
  ' Call the original WindowProc.
  NewWindowProc = CallWindowProc(OldWindowProc, hWnd, MSG, wParam, lParam)
End Function

' NonClientButton ein/ausschalten -----------------------------------
' Autor: (unbekannt)
'
'*******************************************************************************
' Enables / Disables the close button on the titlebar and in the system menu
' of the form window passed.
'-------------------------------------------------------------------------------
'
'-------------------------------------------------------------------------------
' Parameters:
'
'   hWnd    The window handle of the form whose close button is to be enabled/
'           disabled / greyed out.
'
'   Enable  True if the close button is to be enabled, or False if it is to
'           be disabled / greyed out.
'
' Return Values:
'
'    0  Close button state changed succesfully / nothing to do.
'   -1  Invalid Window Handle (hWnd argument) Passed to the function
'   -2  Failed to switch command ID of Close menu item in system menu
'   -3  Failed to switch enabled state of Close menu item in system menu
'
Public Function EnableCloseButton(ByVal hWnd As Long, Enable As Boolean) As Integer
  EnableSystemMenuItem hWnd, SC_CLOSE, xSC_CLOSE, Enable, "EnableCloseButton"
End Function

' *******************************************************************************
' Enable / Disable Minimise Button
'-------------------------------------------------------------------------------
Public Sub EnableMinButton(ByVal hWnd As Long, Enable As Boolean)
  ' Enable / Disable System Menu Item
 
  EnableSystemMenuItem hWnd, SC_MINIMIZE, xSC_MINIMIZE, Enable, _
    "EnableMinButton"
 
  ' Enable / Disable TitleBar button
 
  Dim lngFormStyle As Long
  lngFormStyle = GetWindowLong(hWnd, GWL_STYLE)
  If Enable Then
    lngFormStyle = lngFormStyle Or WS_MINIMIZEBOX
  Else
    lngFormStyle = lngFormStyle And Not WS_MINIMIZEBOX
  End If
  SetWindowLong hWnd, GWL_STYLE, lngFormStyle
 
  ' Dirty, slimy, devious hack to ensure that the changes to the
  ' window's style take immediate effect before the form is shown
 
  SetParent hWnd, GetParent(hWnd)
  SetWindowPos hWnd, hWnd_NOTOPMOST, 0, 0, 0, 0, _
    SWP_NOZORDER Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_FRAMECHANGED
End Sub

' *******************************************************************************
' Enable / Disable Maximise Button
'-------------------------------------------------------------------------------
Public Sub EnableMaxButton(ByVal hWnd As Long, Enable As Boolean)
  ' Enable / Disable System Menu Item
 
  EnableSystemMenuItem hWnd, SC_MAXIMIZE, xSC_MAXIMIZE, Enable, _
    "EnableMaxButton"
 
  ' Enable / Disable TitleBar button
 
  Dim lngFormStyle As Long
  lngFormStyle = GetWindowLong(hWnd, GWL_STYLE)
  If Enable Then
    lngFormStyle = lngFormStyle Or WS_MAXIMIZEBOX
  Else
    lngFormStyle = lngFormStyle And Not WS_MAXIMIZEBOX
  End If
  SetWindowLong hWnd, GWL_STYLE, lngFormStyle
 
  ' Dirty, slimy, devious hack to ensure that the changes to the
  ' window's style take immediate effect before the form is shown
 
  SetParent hWnd, GetParent(hWnd)
  SetWindowPos hWnd, hWnd_NOTOPMOST, 0, 0, 0, 0, _
    SWP_NOZORDER Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_FRAMECHANGED
End Sub

' *******************************************************************************
'
'-------------------------------------------------------------------------------
Private Sub EnableSystemMenuItem(hWnd As Long, Item As Long, _
  Dummy As Long, Enable As Boolean, FuncName As String)
 
  If IsWindow(hWnd) = 0 Then
    Err.Raise vbObjectError, "basCloseBtn::" & FuncName, _
      "basCloseBtn::" & FuncName & "() - Invalid Window Handle"
    Exit Sub
  End If
 
  ' Retrieve a handle to the window's system menu
 
  Dim hMenu As Long
  hMenu = GetSystemMenu(hWnd, 0)
 
  ' Retrieve the menu item information for the Max menu item/button
 
  Dim MII As MENUITEMINFO
  MII.cbSize = Len(MII)
  MII.dwTypeData = String$(80, 0)
  MII.cch = Len(MII.dwTypeData)
  MII.fMask = MIIM_STATE
 
  If Enable Then
    MII.wID = Dummy
  Else
    MII.wID = Item
  End If
 
  If GetMenuItemInfo(hMenu, MII.wID, False, MII) = 0 Then
    Err.Raise vbObjectError, "basCloseBtn::" & FuncName, _
      "basCloseBtn::" & FuncName & "() - Menu Item Not Found"
    Exit Sub
  End If
 
  ' Switch the ID of the menu item so that VB can not undo the action itself
 
  Dim lngMenuID As Long
  lngMenuID = MII.wID
 
  If Enable Then
    MII.wID = Item
  Else
    MII.wID = Dummy
  End If
 
  MII.fMask = MIIM_ID
  If SetMenuItemInfo(hMenu, lngMenuID, False, MII) = 0 Then
    Err.Raise vbObjectError, "basCloseBtn::" & FuncName, _
      "basCloseBtn::" & FuncName & "() - Error encountered " & _
      "changing ID"
    Exit Sub
  End If
 
  ' Set the enabled / disabled state of the menu item
 
  If Enable Then
    MII.fState = MII.fState And Not MFS_GRAYED
  Else
    MII.fState = MII.fState Or MFS_GRAYED
  End If
 
  MII.fMask = MIIM_STATE
  If SetMenuItemInfo(hMenu, MII.wID, False, MII) = 0 Then
    Err.Raise vbObjectError, "basCloseBtn::" & FuncName, _
      "basCloseBtn::" & FuncName & "() - Error encountered " & _
      "changing state"
    Exit Sub
  End If
 
  ' Activate the non-client area of the window to update the titlebar, and
  ' draw the Max button in its new state.
 
  SendMessage hWnd, WM_NCACTIVATE, True, 0
End Sub

Wie Sie sehen können, sitzt im ersten Teil dieses Codes eine Prozedur zum Übergeben der NonClientButton-Steuerung. Damit erledigen wir den Aufruf, mit dem wir unseren "Fließeffekt" ermöglichen. Dieser Befehl erfolgt an geeigneten Stellen, an denen eine Form aufgerufen wird (z.B. in einem ButtonClick-, Unload-, Activate-, GotFocus- Ereignis usw.). Darauf gehen wir gleich näher ein.

Damit in einem Projekt mit mehreren Formularen alle Nachrichten und Befehle an das richtige Formular weitergeleitet werden, benutzen wir eine Variable mit dem Namen "AktuelleForm". Diese Variable wird ebenfalls in dieser Prozedur initialisiert:

Set AktuelleForm = ZuInitialisierendeForm

Eigene Aktionen

Im Abschnitt "NonClientAreaClick ermitteln" werden unsere eigenen Aktionen aufgerufen, mit denen wir die "Original"-Befehle der "Minimieren"-, "Maximieren"- und "Schliessen"-Buttons ersetzen.

Damit sie aufgerufen werden können, müssen wir sie auch programmieren. Dazu setzen wir nachfolgenden Code in den Bereich Nr. 2 (Der Bereich für eigene Aktionen) in der Mitte unseres Bas-Moduls:

' ==================================================================
' ==================== Eigene Aktionen (Anfang) ====================
' ==================================================================
'
' In diesem Abschnitt können die Original-Aktionen "Minimieren",
' "Maximieren" und "Schliessen" durch eigene Befehle ersetzt
' werden.
'____________________________________________________________________
 
Public Sub EigeneMinButtonAktion()
  ' "Minimieren"-Button ausschalten
  ' Diese Anweisung kann (an geeigneter Stelle) nach
  ' dem Wiederherstellen der Form wiederholt werden,
  ' um den Minimize-Button wieder sichtbar zu machen.
  m_blnMin = Not m_blnMin
  Call EnableMinButton(AktuelleForm.hWnd, m_blnMin)
 
  ' Form zum SysTray fließen lassen
  Call FormFliesstZumTray(AktuelleForm)
End Sub

Public Sub EigeneMaxButtonAktion()
  ' Hier eigene Aktion für den Maximize-Button einfügen
End Sub

Public Sub EigeneCloseButtonAktion()
  MsgBox "Auch der ''Schliessen''-Button kann mit " & _
    "einer eigenen Aktion belegt werden." & Chr(13) & _
    "                     " & _
    "In diesem Fall fließt das Fenster in den SysTray." & _
    Chr(13) & Chr(13) & Chr(13) & _
    " (Zum Schliessen des Programms den ''Beenden''" & _
    "-Button im Form drücken.)"
 
  ' "Schliessen"-Button ausschalten
  ' Diese Anweisung kann (an geeigneter Stelle) nach
  ' dem Wiederherstellen der Form wiederholt werden,
  ' um den Close-Button wieder sichtbar zu machen.
  m_blnClose = Not m_blnClose
  Call EnableCloseButton(AktuelleForm.hWnd, m_blnClose)
 
  ' Form zum SysTray fließen lassen
  Call FormFliesstZumTray(AktuelleForm)
End Sub
' 
' ==================================================================
' ===================== Eigene Aktionen (Ende) =====================
' ==================================================================

Jetzt ist es fast geschafft.

Wir haben ja schon den Aufruf für unseren Fließeffekt an einigen Stellen aufgeführt: "Call FormFliesstZumTray(AktuelleForm)" z.B. In der "EigeneMinButtonAktion", der "EigeneCloseButtonAktion" oder im PopUpMenü unseres TrayIcons. Das wäre also erledigt. Machen wir's uns nun also einfach, (war ja bis hierhin anstrengend genug) und kommen zum ...

... Übergeben der NonClientArea-Steuerung.

Das gestaltet sich in der Tat sehr einfach. Im FormLoad-Ereignis unserer sichtbaren Form (nicht "frmTrayIcon")
also z.B. Form1 würden wir eingeben:

Call NonClientAreaSteuerung(Form1, 2, 100)

Syntax:

NonClientAreaSteuerung(ZuInitialisierendeForm, AusblendEffekt, ReduzierFaktor)

Die Argumente bedeuten:

• "ZuInitialisierendeForm" ist das (nächste) Formular, für das die Steuerung der "NonClientButtons" übernommen werden soll.
• "AusblendEffekt" Ich habe 2 verschiedene Effekte zum fließen ins TrayIcon animiert. Mit diesem Argument kann man wählen.
• "ReduzierFaktor" Frei wählbar von 2 bis 400. Wird dazu benutzt, die Geschwindigkeit der Animation individuell einzustellen.

Alle anderen Einstellungen und Initialisierungen werden automatisch an anderen Stellen erledigt. In "frmTrayIcon" z.B. haben wir im FormLoad-Ereignis schon die Variablen zu "NonClientButton ein/ausschalten" initialisiert, nämlich "m_blnMin = True"; "m_blnMax = True" und "m_blnClose = True". In dessen Unload-Ereignis werden alle Forms unseres Projekts entladen, das Symbol aus dem SysTray entfernt und das Window-Handle zurückgegeben, das wir für unsere Zwecke übernommen hatten. Um all das müssen wir uns also nicht mehr kümmern.

Das einzige was noch zu tun bleibt, ist folgende Kleinigkeit:

Wenn wir ein Formular mit der StartUpPosition-Eigenschaft positionieren, z.B. in der Bildschirmmitte, dann "blitzt" das jeweilige Formular beim Eintreten unseres Fließeffekts kurz auf. Um das zu vermeiden, stellen wir die StartUpPosition unserer Forms zur Entwicklungszeit (also jetzt auf 0 = Manuell und fügen in unserem Modul "basFormFliesstZumTrayIcon" den folgenden Code ein:

Im Deklarations-Bereich:

' Zu "Desktop-Maße ermitteln"
'   Autor: Dieter Otter
'
Private Declare Function SystemParametersInfo Lib "user32" _
  Alias "SystemParametersInfoA" ( _
  ByVal uAction As Long, _
  ByVal uParam As Long, _
  ByRef lpvParam As Any, _
  ByVal fuWinIni As Long) As Long
 
Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
 
Public DesktopWeite As Long   ' Bildschirmbereichs-Weite
Public DesktopHöhe As Long    ' Bildschirmbereichs-Höhe

Im Code-Bereich:

' Desktop-Maße ermitteln 
'   Autor: Dieter Otter
'
Public Sub ErmitteleDesktopMasse() ' (Verfügbaren Arbeitsbereich ermitteln)
  Const SPI_GETWORKAREA = 48
  Dim Deskt As RECT
 
  ' verfügbarer Bildschirmbereich
  SystemParametersInfo SPI_GETWORKAREA, 0, Deskt, 0
 
  ' Die Wertangaben für "Left", "Top", "Right" und "Bottom" erfolgen
  ' in Pixel. Um nun die Breite und Höhe in Twips umzurechnen, können
  ' Sie folgende "Formel" verwenden:
 
  DesktopWeite = (Deskt.Right - Deskt.Left) * Screen.TwipsPerPixelX
  DesktopHöhe = (Deskt.Bottom - Deskt.Top) * Screen.TwipsPerPixelY
End Sub

Geschafft

Der komplette Aufruf unseres "Fließeffekts" sieht nun so aus:

In der ersten Form (z.B. Form1) fügen wir ein:

Private Sub Form_Load()
  ' Das Start-Formular in der Desktop-Mitte platzieren
  Call ErmitteleDesktopMasse    ' Klar, oder?
  Me.Move (DesktopWeite / 2) - (Me.Width / 2), _
    (DesktopHöhe / 2) - (Me.Height / 2)
 
  Load frmTrayIcon      ' frmTrayIcon unsichtbar laden
  Set AktuelleForm = Me ' Variable initialisieren
 
  ' Steuerung für NonClientButtons übernehmen
  Call NonClientAreaSteuerung(Me, 1, 100)
End Sub

Für eine weitere Form (Form2), die wir z.B. über den Button "cmdZeigeForm2" aufrufen würden, würden wir in Form1 folgenden Code eingeben:

Private Sub cmdZeigeForm2_Click()    
  ' Steuerung für NonClientButtons übernehmen
  Call NonClientAreaSteuerung(Form2, 2, 100)
  AktuelleForm.Show
  Me.Hide
End Sub

Zusammenfassung

Ich weiß, das war alles sehr viel und heftig verworren.

Deshalb hier eine kurze Zusammenfassung:

Benötigt werden:

• frmTrayIcon.frm
• basFormFliesstZumTrayIcon.bas
• jede Menge eigene Formulare

Die folgende beiden Einstellungen zur Entwicklungszeit vornehmen:

1. ShowInTaskbar der einzelnen Forms ausschalten.
2. "StartUpPosition" der Forms auf "0-Manuell" stellen. Dadurch wird verhindert, dass das jeweilige Formular beim "Fließen" zum/aus dem TrayIcon kurz auf dem Desktop aufblitzt.

Im Load-Ereignis des Startformulars wird das Startformular per Code an die gewünschte Stelle platziert. Über den Befehl "Load frmTrayIcon" wird "frmTrayIcon" unsichtbar geladen und mit "Set AktuelleForm = Me" die Befehle an das richtige Formular geleitet. Jetzt noch die Steuerung für die "NonClientButtons" übernehmen:

Call NonClientAreaSteuerung(Me, 2, 100)

Bei Anwendungen mit mehreren Formularen:
Wenn ein anderes Formular aufgerufen wird, die Steuerung für das jeweils aktuelle Formular übernehmen.

Beispiel:

Call NonClientAreaSteuerung(Form2, 2, 100)
AktuelleForm.Show
Me.Hide

Hinweis:
Der Punkt im SysTray, zu dem die Formulare fließen, kann mit der Variablen "Rechts" beeinflusst werden.

Das war's.

Sie finden den kompletten Code nochmals in einem Demo-Programm handlich verpackt in zum Download. Bei Fragen und Anregungen stehe ich gerne zur Verfügung.

Gudio Eisenbeis, kurz (GES), guidoeisenbeis@web.de, 2003-10-14