Rubrik: Oberfläche · Fenster | VB-Versionen: VB5, VB6 | 04.04.02 |
Extra-Button in der TitelBar Dieser Tipp verrät Ihnen, wie sich ein zusätzlicher Button in der Titelzeile Ihrer Anwendung plazieren lässt. | ||
Autor: Dieter Otter | Bewertung: | Views: 25.619 |
www.tools4vb.de | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Vielleicht haben Sie es schon in anderen Anwendungen gesehen? Die Anzeige eines zusätzlichen Buttons in der Titelleiste eines Fensters.
Für was soll das gut sein? Es gibt mehrere Beispiele, für die es wirklich sinnvoll ist, einen zusätzlichen Button anzuzeigen. Zum Beispiel dann, wenn man über den Button die aktuelle Form immer im Vordergrund halten will.
Und so geht's:
Erstellen Sie ein neues Projekt und plazieren Sie auf die Form einen Button. Dieser Button soll dann zur Laufzeit in der TitelBar des Fensters angezeigt werden. Nennen Sie den Button cmdTBar (Wichtig! Aber dazu später mehr).
Um den Button in der TitelBar darstellen zu können, müssen wir das Window "subclassen", d.h. wir müssen die Fensternachrichten abfangen, um:
- den Button korrekt plazieren zu können (wenn das Fenster neu gezeichnet wird)
- auf den Mausklick reagieren zu können
Erstellen Sie also zunächst noch ein neues Modul und fügen den nachfolgenden Code in das Modul:
Option Explicit ' alle benötigten API-Deklarationen 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 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 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 As Long, _ ByVal lpfn As Long, _ ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" ( _ ByVal hHook As Long) As Long Private Declare Function GetVersionEx Lib "kernel32" _ Alias "GetVersionExA" ( _ lpVersionInformation As OSVERSIONINFO) As Long Private Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 End Type Const VER_PLATFORM_WIN32_WINDOWS = 1 Const VER_PLATFORM_WIN32_NT = 2 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 ' Konstanten Private Const WM_COMMAND = &H111 Private Const WM_NCPAINT = &H85 Private Const WM_MOVE = &H3 Private Const BM_SETSTATE As Long = &HF3 Private Const SWP_FRAMECHANGED = &H20 Private Const GWL_EXSTYLE = -20 Private winHook As Long Private IsWinNT As Boolean ' Form, auf der der Button plaziert wird ' Wichtig! Der Button muss "cmdTBar" heißen! Private oForm As Form
' Fensternachrichten abfangen und auswerten Private Function Hook(ByVal nCode As Long, _ ByVal wParam As Long, cSTRUCT As CWPSTRUCT) As Long Dim R As RECT Dim lngPos As Long Static bClicked As Boolean On Error Resume Next With oForm ' Klick auf Button? ' Win9x/ME If cSTRUCT.hwnd = GetParent(.cmdTBar.hwnd) And Not IsWinNT Then If cSTRUCT.Message = WM_COMMAND Then bClicked = Not bClicked If bClicked Then Call oForm.cmdTBar_Click End If ' WinNT/2K/XP ElseIf cSTRUCT.hwnd = .cmdTBar.hwnd Then If cSTRUCT.Message = BM_SETSTATE And cSTRUCT.wParam = 0 Then bClicked = Not bClicked If bClicked Then Call oForm.cmdTBar_Click End If End If ElseIf cSTRUCT.hwnd = .hwnd Then ' Button entsprechend Fensterstil plazieren If .BorderStyle > 0 And .BorderStyle < 4 Then lngPos = IIf(.MinButton Or .MaxButton, 3 * 16, 16) End If If cSTRUCT.Message = WM_NCPAINT Or _ cSTRUCT.Message = WM_MOVE Then GetWindowRect .hwnd, R SetWindowPos .cmdTBar.hwnd, 0, _ R.Right - lngPos - 10 - _ (.cmdTBar.Width / Screen.TwipsPerPixelX), _ R.Top + 6, .cmdTBar.Width / Screen.TwipsPerPixelX, _ 14, SWP_FRAMECHANGED End If End If End With On Error GoTo 0 End Function
' Button in der Titelbar anzeigen Public Sub ShowTBarButton(F As Form) ' Falls Fenster kein Rahmen hat, Prozedur verlassen If F.BorderStyle = 0 Then Exit Sub ' Windows-Version ermitteln Dim OSVersion As OSVERSIONINFO With OSVersion .dwOSVersionInfoSize = Len(OSVersion) GetVersionEx OSVersion IsWinNT = (.dwPlatformId = VER_PLATFORM_WIN32_NT) And _ (.dwMajorVersion >= 4) End With Set oForm = F winHook = SetWindowsHookEx(4, AddressOf Hook, _ 0, App.ThreadID) SetWindowLong oForm.cmdTBar.hwnd, GWL_EXSTYLE, &H80 SetParent oForm.cmdTBar.hwnd, GetParent(oForm.hwnd) End Sub
' Button wieder ausblenden ' Muss immer aufgerufen werden, bevor das Fenster ' entladen wird! Public Sub HideTBarButton() If winHook <> 0 Then UnhookWindowsHookEx winHook SetParent oForm.cmdTBar.hwnd, oForm.hwnd End If End Sub
In Form1, in der der zusätzliche Button angezeigt werden soll, fügen Sie nun noch folgenden Code ein:
Private Sub Form_Load() ' Button in die Titelzeile "verschieben" ShowTBarButton Me End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) ' Wichtig! ' Sonst stürzt Ihnen das Proggi samt IDE ab ;-( HideTBarButton End Sub
Public Sub cmdTBar_Click() MsgBox "Klick auf zusätzlichen Button!" End Sub