DockingToolB




'Create floating/docking toolbar

'**************************************

Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
Public Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'Description:

'This file contains all declarations required to use

'the Windows API functions and Necessary Constants for

'the functions to work This file also includes main

'routines

Attribute VB_Name = "Module1"
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type POINTAPI
X As Long
Y As Long
End Type
' Window Setting Constants

Public Const WS_BORDER = &H800000
Public Const WS_NOBORDER = &H6000000
Public Const WS_EX_WINDOWEDGE = &H100
Public Const WS_THICKFRAME = &H40000
' Docking Constants

Public Const DK_LEFT = 1 ' dock left
Public Const DK_RIGHT = 2 ' dock right
Public Const DK_TOP = 3 ' dock top
Public Const DK_BOTTOM = 4 ' dock bottom
Public Const DK_NONE = 5 ' undocked
' Misc Constants

Public Const GWL_STYLE = (-16)
Public Const GWL_HWNDPARENT = (-8)
Public Const COLOR_ACTIVECAPTION = 2
Public Const SM_CXDLGFRAME = 7
Public Const SM_CYDLGFRAME = 8
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
Public Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Public tpoint As POINTAPI
Public temp As POINTAPI
Public dpoint As POINTAPI
Public fbox As RECT
Public tbox As RECT
Public oldbox As RECT
Public TwipsPerPixelX
Public TwipsPerPixelY
Public Moving As Boolean ' Window Control Constants
Public DockSetting As Integer
Public DockOption
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'_________________________________________________________


Public Sub DockToolbar(frmChild As Form, DOCK_STYLE As Integer, frmParent As Form) ' Move the toolbar and resize it to desired' position.
Select Case DOCK_STYLE
Case DK_LEFT ' Place left dock code here
frmChild.Left = frmParent.Left + 60
frmChild.Top = frmParent.Top + 620
Case DK_RIGHT
frmChild.Left = frmParent.Left + frmParent.Width - frmChild.Width - 60
frmChild.Top = frmParent.Top + 620
Case DK_TOP ' Place top dock code here
frmChild.Left = frmParent.Left + 60
frmChild.Width = frmParent.Width - 120
Case DK_BOTTOM ' Place bottom dock code here
Case DK_NONE
End Select
End Sub
'_________________________________________________________


Public Sub BeginFRDrag(X As Single, Y As Single)
Dim tDc As Long
Dim sDc As Long
Dim d As Long
' convert points to POINTAPI struct

dpoint.X = X
dpoint.Y = Y
' get screen area of toolbar

GetWindowRect frmToolbar.hwnd, fbox 'screen Rect of toolbar
TwipsPerPixelX = Screen.TwipsPerPixelX
TwipsPerPixelY = Screen.TwipsPerPixelY
' get point of mousedown in screen coord

' inates

temp = dpoint
ClientToScreen frmToolbar.hwnd, temp
sDc = GetDC(ByVal 0)
DrawFocusRect sDc, fbox
d = ReleaseDC(0, sDc)
oldbox = fbox
Moving = True
End Sub
'_________________________________________________________


Public Sub DoFRDrag(X As Single, Y As Single)
If Moving = True Then
Dim tDc As Long
Dim sDc As Long
Dim d As Long
tpoint.X = X
tpoint.Y = Y
ClientToScreen frmToolbar.hwnd, tpoint
tbox.Left = (fbox.Left + tpoint.X / TwipsPerPixelX) - temp.X / TwipsPerPixelX
tbox.Top = (fbox.Top + tpoint.Y / TwipsPerPixelY) - temp.Y / TwipsPerPixelY
tbox.Right = (fbox.Right + tpoint.X / TwipsPerPixelX) - temp.X / TwipsPerPixelX
tbox.Bottom = (fbox.Bottom + tpoint.Y / TwipsPerPixelY) - temp.Y / TwipsPerPixelY
sDc = GetDC(ByVal 0)
DrawFocusRect sDc, oldbox
DrawFocusRect sDc, tbox
d = ReleaseDC(0, sDc)
oldbox = tbox
End If
End Sub
'_________________________________________________________


Public Sub EndFRDrag(X As Single, Y As Single)
If Moving = True Then
Dim tDc As Long
Dim sDc As Long
Dim d As Long
Dim newleft As Single
Dim newtop As Single
sDc = GetDC(ByVal 0)
DrawFocusRect sDc, oldbox
d = ReleaseDC(0, sDc)
newleft = X + fbox.Left * TwipsPerPixelX - dpoint.X
newtop = Y + fbox.Top * TwipsPerPixelY - dpoint.Y

frmToolbar.Move newleft, newtop
Moving = False
End If
End Sub
'_________________________________________________________


' Name: Create a Floating/Docking Toolbar

' Description: This code is the back bone

'of the Toolbar control dock Toolbar:

'Right click in Titlebar/Toolbar areaand

'select docking mode To Move Toolbar:

'Press and hold Left Mouse Button (LBM) on

'Titlebar and drag Toolbar Around the screen/form

'To Hide Toolbar: Select button on Toolbar

'Select View on Menu, Then Show Toolbar to Hide

'Toolbar To Show Toolbar: Select View on Menu,

'Then Show Toolbar to Show Toolbar

'Assumes: Create 1 File using a text editor

'Copy the code below into the file

'Then save file as in Filename above

VERSION 5.00
Begin VB.Form frmToolbar
AutoRedraw =-1 'True
BorderStyle =5 'Sizable ToolWindow
ClientHeight=2730
ClientLeft =60
ClientTop=60
ClientWidth =1110
ControlBox =0'False
LinkTopic="Form2"
MaxButton=0'False
MinButton=0'False
ScaleHeight =2730
ScaleWidth =1110
ShowInTaskbar=0'False
StartUpPosition =3 'Windows Default
Visible =0'False
WhatsThisHelp=-1 'True
Begin VB.CommandButton Command1
BackColor=&H00C0C0C0&
Caption ="X"
Height =210
Left=855
TabIndex=1
Top =15
UseMaskColor=-1 'True
Width=210
End
Begin VB.Label Label1
BackColor=&H80000002&
Caption ="Toolbar"
ForeColor=&H80000009&
Height =255
Left=0
TabIndex=0
Top =0
Width=1095
End
Begin VB.Menu mnuTB
Caption ="Toolbar"
Visible =0'False
Begin VB.Menu mnuTBDock
Caption ="Dock Left"
Index=1
End
Begin VB.Menu mnuTBDock
Caption ="Dock Right"
Checked =-1 'True
Index=2
End
Begin VB.Menu mnuTBDock
Caption ="Dock Top"
Index=3
End
Begin VB.Menu mnuTBDock
Caption ="Dock Bottom"
Index=4
End
Begin VB.Menu mnuTBDock
Caption ="Dock None"
Index=5
End
End
End
Attribute VB_Name = "frmToolbar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'_________________________________________________________


Private Sub Command1_Click()
Unload frmToolbar
Form1!mnuViewTB.Checked = False
End Sub
'_________________________________________________________


Private Sub Form_Initialize()
DockSetting = DK_RIGHT
DockOption = DK_RIGHT
End Sub
'_________________________________________________________


Private Sub Form_Load()
SetWindowLong frmToolbar.hwnd, GWL_HWNDPARENT, Form1.hwnd
DockSetting = DK_RIGHT
DockOption = DK_RIGHT
DockToolbar frmToolbar, DockSetting, Form1
End Sub
'_________________________________________________________


Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
PopupMenu mnuTB
End If
Form1.SetFocus
End Sub
'_________________________________________________________


Private Sub Form_Resize()
Label1.Width = frmToolbar.Width
Command1.Left = Label1.Left + Label1.Width - 340
If frmToolbar.Height > Form1.Height - 420 Then
frmToolbar.Height = Form1.Height - 420
Form1.SetFocus
End If
If frmToolbar.Width < 1095 Then
frmToolbar.Width = 1095
If frmToolbar.Left + frmToolbar.Width > Form1.Left _
+ Form1.Width Then frmToolbar.Left = Form1.Left _
+ Form1.Width - frmToolbar.Left - 60
Form1.SetFocus
End If
If frmToolbar.Height < 360 Then
frmToolbar.Top = Form1.Top + 360
frmToolbar.Height = 360
Form1.SetFocus
End If
If frmToolbar.Left < Form1.Left Then
frmToolbar.Left = frmToolbar.Left + 60
Form1.SetFocus
End If
DockToolbar frmToolbar, DockSetting, Form1
End Sub

Private Sub mnuTBDock_Click(Index As Integer)
mnuTBDock(DockOption).Checked = False
mnuTBDock(Index).Checked = True
DockSetting = Index
DockOption = DockSetting
DockToolbar frmToolbar, DockSetting, Form1
Form1.SetFocus
End Sub

Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
mnuTBDock(DockOption).Checked = False
DockSetting = DK_NONE
DockOption = DK_NONE
mnuTBDock(DockSetting).Checked = True
DockToolbar frmToolbar, DockSetting, Form1
BeginFRDrag X, Y
End If
Form1.SetFocus
End Sub
'_________________________________________________________


Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button > 0 Then
DoFRDrag X, Y
End If
Form1.SetFocus
End Sub
'_________________________________________________________

Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case Button
Case vbLeftButton
EndFRDrag X, Y
Case vbRightButton
PopupMenu mnuTB
End Select
frmToolbar.Refresh
Command1.Refresh
Label1.Refresh
Form1.SetFocus
End Sub
'_________________________________________________________


Private Sub mnuDocked_Click()
mnuDocked.Checked = Not mnuDocked.Checked
Select Case mnuDocked.Checked
Case vbChecked
Case vbUnchecked
Me.Width = InitialWidth
Me.Height = InitialHeight
End Select
Form1.SetFocus
End Sub
'_________________________________________________________


' Name: Create a Floating/Docking Toolba

' r

' Description: This file contains all ro

' utines for Loading the Toolbar

' Filename: frmToolbarTest.frm

' By: John Kowalski

'Date: 24/01/99

' Notes: This code is an update from the

' code supplied by:

'David J Berube - Creating a floating

' toolbar

'Mike Jones - Docking Toolbar (like vb

' , office97, etc.)

' Assumes: Create 1 File using a text ed

' itor

'Copy the code below into the file

'Then save file as in Filename above

VERSION 5.00
Begin VB.Form Form1
Caption ="Form1"
ClientHeight=4770
ClientLeft =165
ClientTop=735
ClientWidth =6405
BeginProperty Font
Name="Comic Sans MS"
Size=8.25
Charset =0
Weight =400
Underline=0'False
Italic =0'False
Strikethrough=0'False
EndProperty
LinkTopic="Form1"
ScaleHeight =4770
ScaleWidth =6405
StartUpPosition =3 'Windows Default
Begin VB.Menu mnuView
Caption ="View"
Begin VB.Menu mnuViewTB
Caption ="Show Toolbar"
Checked =-1 'True

End
End
End

Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'_________________________________________________________


Private Sub Form_Load()
frmToolbar.Show
End Sub

Private Sub Form_Paint()
DockToolbar frmToolbar, DockSetting, Form1
End Sub

Private Sub Form_Resize()
DockToolbar frmToolbar, DockSetting, Form1
End Sub

Private Sub Form_Unload(Cancel As Integer)
Unload frmToolbar
End Sub
'_________________________________________________________


Private Sub mnuViewTB_Click()
If mnuViewTB.Checked = False Then
frmToolbar.Show
mnuViewTB.Checked = True
Form1.SetFocus
ElseIf mnuViewTB.Checked = True Then
frmToolbar.Hide
mnuViewTB.Checked = False
End If
End Sub

Assumes:
Create 1 File using a text editor
Copy the code below into the file
Then save file as in Filename above
Attribute VB_Name = "Module1"










( dockingtoolb.html )- by Paolo Puglisi - Modifica del 17/12/2023