Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0566: Einrastbare Toolbar realisieren

 von 

Beschreibung 

Wer viel mit Officeanwendungen arbeitet, wird schnell merken, dass VB keine Funktion bietet, um eine Toolbar - genau wie in MS Office - einfach per Drag & Drop zu verscheiben.
Dieser Tipp soll ein Ansatz sein, wie man so etwas realisieren könnte.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

GetCursorPos, GetDesktopWindow, GetParent, ScreenToClient, SetParent

Download:

Download des Beispielprojektes [5,7 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Bildfeld-Steuerelement "picTool"
' Steuerelement: Timersteuerelement "Timer1" auf picTool
' Steuerelement: Schaltfläche "Command3" auf picTool
' Steuerelement: Schaltfläche "Command6" auf picTool
' Steuerelement: Schaltfläche "Command5" auf picTool
' Steuerelement: Schaltfläche "Command4" auf picTool
' Steuerelement: Schaltfläche "Command2" auf picTool
' Steuerelement: Schaltfläche "Command1" auf picTool
' Steuerelement: Textfeld "Text1"

'
'Autor: Sean Mertiens <sean.mertiens@gmx.de>

Option Explicit

' Gibt an ob die Toolbar gezogen wird
Dim DragFlag As Boolean

' Gibt an ob die Toolbar an ihrem richtigen Platz ist
Public ToolVisible As Boolean

Private Sub Command1_Click()
    WriteText "Neu"
End Sub

Private Sub Command2_Click()
    WriteText "Speichern"
End Sub

Private Sub Command3_Click()
    WriteText "Öffnen"
End Sub

Private Sub Command4_Click()
    WriteText "Ausschneiden"
End Sub

Private Sub Command5_Click()
    WriteText "Kopieren"
End Sub

Private Sub Command6_Click()
    WriteText "Einfügen"
End Sub

Private Sub Form_Load()
    'Toolbar erstellen
    CreateToolbar picTool, sttMouseDefault
    ToolVisible = True
End Sub

Private Sub CreateToolbar(pic As PictureBox, Optional state As STATECONSTANTS = sttMouseDefault)
    ' pic vorbereiten
    pic.AutoRedraw = True
    pic.BorderStyle = 0
    pic.Cls

    If state = sttMouseDefault Then
        ' Maus ist nicht drüber
        pic.Line (2, 2)-(150, pic.ScaleHeight), TLB_DEFAULT, BF
    ElseIf state = sttMouseOver Then
        ' Maus ist über dem Ziehbereich: anders färben
        pic.Line (2, 2)-(150, pic.ScaleHeight), TLB_OVER, BF
    End If
    
    ' 3d-effekt:
    pic.Line (1, 1)-(pic.ScaleWidth, 1), vbWhite
    pic.Line (1, 1)-(1, pic.ScaleHeight), vbWhite
    pic.Line (pic.ScaleWidth - 10, 1)-(pic.ScaleWidth - 10, pic.ScaleHeight - 10), vbBlack
    pic.Line (1, pic.ScaleHeight - 10)-(pic.ScaleWidth, pic.ScaleHeight - 10), vbBlack
    pic.Refresh
End Sub

Public Sub Form_Resize()
    Dim tH%
    ' Ist die Toolbar auf der Form, Platz lassen
    If ToolVisible Then
        tH = picTool.ScaleHeight
    Else
        tH = 0
    End If
    
    ' Textfeld anpassen
    Text1.Move 0, tH, Me.ScaleWidth, Me.ScaleHeight - tH
    
    ' Nur wenn toolbar in diesem Fenster:
    If GetParent(picTool.hwnd) = Me.hwnd Then
        picTool.Width = Me.ScaleWidth
    End If
End Sub

Private Sub picTool_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button <> vbLeftButton Then Exit Sub
    ' Verhindert, dass die Toolbar im falschen Fenster gezogen wird
    If GetParent(picTool.hwnd) <> Me.hwnd Then Exit Sub
    ' Toolbar kann nur mit dem Ziehbereich bewegt werden
    If picTool.Point(X, Y) <> TLB_OVER Then Exit Sub
    
    ' Ziehen starten
    DragFlag = True
End Sub

Private Sub picTool_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' Hover-Effekt aktualisieren
    If picTool.Point(X, Y) = TLB_DEFAULT Or picTool.Point(X, Y) = TLB_OVER Then
        CreateToolbar picTool, sttMouseOver
    Else
        CreateToolbar picTool, sttMouseDefault
    End If
End Sub

Private Sub picTool_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' Ziehen beenden, eventuell Toolbar "zurückschnappen" lassen
    If GetParent(picTool.hwnd) = Me.hwnd Then
        picTool.Move 0, 0
    End If
    
    DragFlag = False
End Sub

Private Sub Timer1_Timer()
    If Not DragFlag Then Exit Sub
    
    Dim PT As POINTAPI
    
    ' Cursor-Koordinaten ermitteln und umrechnen
    Call GetCursorPos(PT)
    Call ScreenToClient(Me.hwnd, PT)
    
    PT.X = PT.X * Screen.TwipsPerPixelX
    PT.Y = PT.Y * Screen.TwipsPerPixelY
    
    ' Toolbar bewegen
    picTool.Move PT.X, PT.Y
    
    ' Wenn die Toolbar vollständig aus ihrem Bereich gezogen wurde
    If picTool.Top >= (picTool.ScaleHeight) Then
        ' Ziehen beenden
        DragFlag = False
        
        ' Fenster anzeigen
        Form2.Show
        
        ' Toolbar in Fenster einbinden und Fenster als Child setzen
        Call SetParent(picTool.hwnd, Form2.hwnd)
        Call SetParent(Form2.hwnd, Me.hwnd)
        
        ' Fenster an Toolbar-Koordinaten bewegen
        Form2.Move PT.X, PT.Y
        
        ' Toolbar an Fenster anpassen
        picTool.Move 0, 0, Form2.ScaleWidth - 100, Form2.ScaleHeight
        
        ' Toolbar neuzeichnen
        CreateToolbar picTool
        ToolVisible = False
        Call Form_Resize
        
        WriteText "Um die Toolbar zurückzubewegen Fenster schließen"
    End If
End Sub
Sub WriteText(txt As String)
    Text1.Text = txt & vbCrLf & Text1.Text
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Formular "Form2" alias Form2.frm  ---------
Option Explicit

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
' Wird die Toolbar geschlossen, wird sie wieder am oberen Rand angedockt
    Call SetParent(Form1.picTool.hwnd, Form1.hwnd)
    Call SetParent(Me.hwnd, GetDesktopWindow)
    Form1.ToolVisible = True
    Call Form1.Form_Resize
    
    Unload Me
End Sub
'---------- Ende Formular "Form2" alias Form2.frm  ----------
'------ Anfang Modul "modDeclare" alias modDeclare.bas ------
Option Explicit

' Gibt an ob die Maus über der Ziehfläche ist
Public Enum STATECONSTANTS
    sttMouseDefault = 0
    sttMouseOver = 1
End Enum

' Farben für die Zieh-Fläche
Public Const TLB_DEFAULT = &H8F0000
Public Const TLB_OVER = vbBlue

' Zum ermitteln der Mauskoordinaten
Public Declare Function GetCursorPos Lib "user32" ( _
     lpPoint As POINTAPI) As Long

Public Type POINTAPI
    X As Long
    Y As Long
End Type

' umrechnen auf Client-Wert
Public Declare Function ScreenToClient Lib "user32" ( _
     ByVal hwnd As Long, _
     lpPoint As POINTAPI) As Long

' Eltern-fenster ermitteln
Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) _
As Long

' Eltern-fenster setzen
Public Declare Function SetParent Lib "user32" _
        (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long

' Desktop-fenster ermittlen
Public Declare Function GetDesktopWindow Lib "user32" () As Long


'------- Ende Modul "modDeclare" alias modDeclare.bas -------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 1 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von VisualbasT am 16.08.2003 um 15:50

Problem!
Hallo zusammen

Es gibt ein Problem und zwar folgendes: Wenn man die Toolbar nicht gedockt hat, dann kann man nicht mehr auf die Textbox / andere Fenster zugreifen.

Gruss, VisualbasT alias Tobias Soltermann from CH