'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" |