How to Create a Floating Toolbar in Visual Basic 3.0

ID: Q114594

The information in this article applies to:

Microsoft Visual Basic Standard and Professional Editions for Windows, versions 2.0, 3.0

SUMMARY

This article contains code and instructions that show you how to create a floating toolbar in Visual Basic. A toolbar is a modeless dialog box owned by a parent window but not confined to the area of the parent.

This article combines methods that are described in more detail in the following articles in the Microsoft Knowledge Base:

Q114775 : How to Create a Modeless Dialog or Form in Visual Basic

Q114593 : How to Move a Form that Has No Titlebar or Caption

MORE INFORMATION

Instead of offering this article in a number of steps, we have modified our usual format to make it easier for you to create and use this Visual Basic application. Therefore, the three files you need (TOOLBAR.BAS, TOOLBAR.FRM, and PARENT.FRM) are listed below, so you can easily copy them into a text editor, and save them as separate files. Instructions for how to use the files are embedded in the files as comments.

TOOLBAR.BAS


' Place the following code in a single text file called TOOLBAR.BAS
'
' NOTE: After copying this into a file in a text editor, modify each
' Declare statement so that each one uses only one, single line.

Option Explicit

Type POINTAPI
    X As Integer
    Y As Integer
End Type

Type ConvertPOINTAPI
    xy As Long
End Type

Declare Function Sendmessage Lib "User" (ByVal hwnd As Integer,
   ByVal wMsg As Integer, ByVal wParam As Integer,
   ByVal lParam As Any) As Long
Declare Sub GetCursorPos Lib "User" (lpPoint As POINTAPI)
Declare Function GetSysColor Lib "User" (ByVal nIndex As Integer) As Long
Declare Function SetWindowWord Lib "User" (ByVal hwnd As Integer,
   ByVal Index As Integer, ByVal wNewWord As Integer) As Integer
Declare Function BitBlt Lib "GDI" (ByVal hDestDC%, ByVal X%, ByVal Y%,
   ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal Ysrc%,
   ByVal dwRop&) As Integer

Global Const WM_LBUTTONUP = &H202
Global Const WM_SYSCOMMAND = &H112
Global Const MOUSE_MOVE = &HF012

Global Const COLOR_APPWORKSPACE = 12
Global Const COLOR_ACTIVECAPTION = 2
Global Const COLOR_CAPTIONTEXT = 9
Global Const COLOR_GRAYTEXT = 17

Global Const DSTINVERT = &H550009   ' (DWORD) dest = (NOT dest)

Global Const GWW_HWNDPARENT = (-8)

Global ToolbarLoaded As Integer

TOOLBAR.FRM


' The following is a text dump of the TOOLBAR form. It includes the form
' and control description as well as necessary Function and Sub procedures.
' Save the code in a single TEXT file called TOOLBAR.FRM and you will
' be able to load it as a form in Visual Basic.
'
' NOTE: To make the code fit in this article, some of the statements are
' shown in multiple lines. Be sure to modify the lines in the text editor
' to ensure that all lines of code exist as one, single line of code
' in the file. Otherwise, you will receive errors when loading the form in
' Visual Basic.
'
' Also, this program loads some bitmaps from your Visual Basic directory.
' It assumes Visual Basic is installed in C:\VB.  If this is incorrect
' search for all the LoadPicture commands and change the path.

VERSION 2.00
Begin Form Toolbar
   ClientHeight    =   2160
   ClientLeft      =   1692
   ClientTop       =   1464
   ClientWidth     =   2928
   ControlBox      =   0   'False
   Height          =   2580
   KeyPreview      =   -1  'True
   Left            =   1644
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   180
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   244
   Top             =   1092
   Width           =   3024
   Begin PictureBox Picture1
      Height          =   780
      Left            =   0
      ScaleHeight     =   756
      ScaleWidth      =   636
      TabIndex        =   1
      Top             =   0
      Width           =   660
   End
   Begin Image Image3
      Height          =   612
      Index           =   0
      Left            =   600
      Top             =   1320
      Width           =   972
   End
   Begin Image Image2
      Height          =   852
      Index           =   0
      Left            =   1680
      Top             =   480
      Width           =   852
   End
   Begin Image Image1
      Height          =   612
      Index           =   0
      Left            =   720
      Top             =   600
      Width           =   852
   End
   Begin Label Label1
      BackColor       =   &H00FFFFFF&
      Caption         =   "Label1"
      Height          =   372
      Left            =   720
      TabIndex        =   0
      Top             =   0
      Width           =   1332
   End
End
Option Explicit

Dim MDown As Integer
Dim InvertedImage As Integer
Dim OriginalParenthWnd As Integer
Dim MinHeight As Long
Dim MinWidth As Long

Sub Form_Activate ()

   If Not MDown Then parent.SetFocus

End Sub

Sub Form_Load ()

   ToolbarLoaded = True

   Me.ScaleMode = 3   ' Pixels
   picture1.ScaleMode = 3
   picture1.AutoSize = True

   ' Load the picture
   picture1.Picture = LoadPicture("C:\VB\BITMAPS\OUTLINE\MINUS.BMP")

   ' NOTE: You can load the MINUS.BMP bitmap into paintbrush and
   ' change its background color from white to gray. To do this,
   ' load the bitmap into paintbrush, and click the light gray in
   ' the color palette. Then select the paint roller icon, and
   ' click the area between the hyphen and the border to fill
   ' the area with light gray. Save it as MINUS2.BMP. If you do this,
   ' use the following statement to load the picture box:
   ' picture1.Picture = LoadPicture("C:\VB\BITMAPS\OUTLINE\MINUS2.BMP")

   ' Get the users system color for the active window caption:
   label1.BackColor = GetSysColor(COLOR_ACTIVECAPTION)

   ' Position picturebox and label:
   picture1.Left = -1                ' Use -1 to put the controls
   picture1.Top = -1                 ' border behind the edge of
   label1.Top = -1                   ' the form.

   ' Overlap edge of label with picture:
   label1.Left = picture1.Left + picture1.Width - 1
   label1.Height = picture1.Height

   ' Load and locate the image controls:
   Call InitToolbox

   ' The guesswork on height and width could be replaced with a call to
   ' the GetSystemMetrics Windows API function to get the borderwidth of
   ' the form. Change the following two lines to one, single line:
   Me.Height =
      (picture1.Height + image1(0).Height + 12) * screen.TwipsPerPixelY
   ' Change the following two lines to one, single line:
   Me.Width =
      (image3(0).Left + image3(0).Width + 10) * screen.TwipsPerPixelX

   MinHeight = Me.Height
   MinWidth = Me.Width

   ' Set up the label:
   label1.Alignment = 2               ' Centered
   label1.BorderStyle = 1             ' Single
   label1.Caption = "Toolbar"

   ' Choose a small font or whatever looks best on your system:
   label1.FontName = "Small Fonts"
   label1.FontSize = 6
   label1.FontBold = False
   ' Use active caption color for label's caption:
   label1.ForeColor = GetSysColor(COLOR_CAPTIONTEXT)

   ' Color the background of the form to the MDI client area color:
   Me.BackColor = GetSysColor(COLOR_APPWORKSPACE)

   ' Set parent for the toolbar to display on top:
   OriginalParenthWnd = SetWindowWord(Me.hWnd, GWW_HWNDPARENT, parent.hWnd)

End Sub

Sub Form_Resize ()

   ' Check minimums for resize:
   If Me.Width < MinWidth Then Me.Width = MinWidth
   If Me.Height < MinHeight Then Me.Height = MinHeight

   ' Change size of label:
   label1.Width = Me.ScaleWidth - label1.Left + 1

End Sub

Sub Form_Unload (Cancel As Integer)
   Dim ret As Integer

   ' Return the original parent handle:
   ret = SetWindowWord(Me.hWnd, GWW_HWNDPARENT, OriginalParenthWnd)

   ' Clear the global flag:
   ToolbarLoaded = False

End Sub

Sub Image1_Click (Index As Integer)

   Clipboard.SetText parent.Text1.SelText
   parent.Text1.SelText = ""

End Sub

' Change the following two lines to one, single line:
Sub Image1_MouseDown (Index As Integer, Button As Integer,
   Shift As Integer, X As Single, Y As Single)

   If Button And 1 Then
      MDown = True
      image1(0).Picture = image1(2).Picture  ' Down
   End If

End Sub

' Change the following two lines to one, single line:
Sub Image1_MouseMove (Index As Integer, Button As Integer,
   Shift As Integer, X As Single, Y As Single)

   If Button And 1 Then                ' Left button down
      X = X \ screen.TwipsPerPixelX    ' x and y are in twips
      Y = Y \ screen.TwipsPerPixelY    ' Convert to pixels

      ' Change the following two lines to one, single line:
      If (X < 0) Or (X > image1(0).Width) Or (Y < 0) Or
         (Y > image1(0).Height) Then

         image1(0).Picture = image1(1).Picture  ' Up
      Else
         image1(0).Picture = image1(2).Picture  ' Down
      End If
   End If

End Sub

' Change the following two lines to one, single line:
Sub Image1_MouseUp (Index As Integer, Button As Integer, Shift As Integer,
   X As Single, Y As Single)

   If Button And 1 Then
      image1(0).Picture = image1(1).Picture  ' Up
      MDown = False
      parent.SetFocus
   End If

End Sub

Sub Image2_Click (Index As Integer)

   ' Code for copy here:
   Clipboard.SetText parent.Text1.SelText

End Sub

' Change the following two lines to one, single line:
Sub Image2_MouseDown (Index As Integer, Button As Integer,
   Shift As Integer, X As Single, Y As Single)

   If Button And 1 Then
      MDown = True
      image2(0).Picture = image2(2).Picture  ' Down
   End If

End Sub

' Change the following two lines to one, single line:
Sub Image2_MouseMove (Index As Integer, Button As Integer,
   Shift As Integer, X As Single, Y As Single)

   If Button And 1 Then       ' Left button down
      X = X \ screen.TwipsPerPixelX
      Y = Y \ screen.TwipsPerPixelY

      ' Change the following two lines to one, single line:
      If (X < 0) Or (X > image2(0).Width) Or (Y < 0) Or
         (Y > image2(0).Height) Then
         image2(0).Picture = image2(1).Picture  'up
      Else
         image2(0).Picture = image2(2).Picture  'down
      End If
   End If

End Sub

' Change the following two lines to one, single line:
Sub Image2_MouseUp (Index As Integer, Button As Integer, Shift As Integer,
   X As Single, Y As Single)

   If Button And 1 Then
      MDown = False
      image2(0).Picture = image2(1).Picture  ' Up
      parent.SetFocus
   End If

End Sub

Sub Image3_Click (Index As Integer)

   ' Code for paste here
   parent.Text1.SelText = Clipboard.GetText()

End Sub

' Change the following two lines to one, single line:
Sub Image3_MouseDown (Index As Integer, Button As Integer,
   Shift As Integer, X As Single, Y As Single)

   If Button And 1 Then
      MDown = True
      image3(0).Picture = image3(2).Picture  ' Down
   End If

End Sub

' Change the following two lines to one, single line:
Sub Image3_MouseMove (Index As Integer, Button As Integer,
   Shift As Integer, X As Single, Y As Single)

   If Button And 1 Then               ' Left button down
      X = X \ screen.TwipsPerPixelX   ' Convert to pixels
      Y = Y \ screen.TwipsPerPixelY

      ' Change the following two lines to one, single line:
      If (X < 0) Or (X > image3(0).Width) Or (Y < 0) Or
         (Y > image3(0).Height) Then

         image3(0).Picture = image3(1).Picture  'up
      Else
         image3(0).Picture = image3(2).Picture  'down
      End If
   End If

End Sub

' Change the following two lines to one, single line:
Sub Image3_MouseUp (Index As Integer, Button As Integer, Shift As Integer,
   X As Single, Y As Single)

   If Button And 1 Then
      MDown = False
      image3(0).Picture = image3(1).Picture  'up
      parent.SetFocus
   End If

End Sub

Sub InitToolbox ()
   ' This procedure initializes the toolbox with three controls.
   ' Most of this could be done at design time.

   ' Load extra imagecontrol arrays
   Load image1(1)
   Load image1(2)
   Load image2(1)
   Load image2(2)
   Load image3(1)
   Load image3(2)

   ' Load the bitmaps - CHANGE PATHS AS NEEDED!!!!!
   image1(1).Picture = LoadPicture("c:\vb\bitmaps\toolbar3\cut-up.bmp")
   image1(2).Picture = LoadPicture("c:\vb\bitmaps\toolbar3\cut-mds.bmp")
   image2(1).Picture = LoadPicture("c:\vb\bitmaps\toolbar3\copy-up.bmp")
   image2(2).Picture = LoadPicture("c:\vb\bitmaps\toolbar3\copy-mds.bmp")
   image3(1).Picture = LoadPicture("c:\vb\bitmaps\toolbar3\pste-up.bmp")
   image3(2).Picture = LoadPicture("c:\vb\bitmaps\toolbar3\pste-mds.bmp")

   image1(0).Picture = image1(1).Picture
   image2(0).Picture = image2(1).Picture
   image3(0).Picture = image3(1).Picture

   ' Position image controls:
   image1(0).Left = 2
   image2(0).Left = image1(0).Left + image1(0).Width + 1
   image3(0).Left = image2(0).Left + image2(0).Width + 1
   image1(0).Top = label1.Height + 1
   image2(0).Top = image1(0).Top
   image3(0).Top = image1(0).Top

End Sub

' Change the following two lines to one, single line:
Sub Label1_MouseDown (Button As Integer, Shift As Integer, X As Single,
   Y As Single)

   Dim mpos As POINTAPI
   Dim p As ConvertPOINTAPI
   Dim ret As Integer

   Call GetCursorPos(mpos)  ' Get the current position of the cursor
   LSet p = mpos            ' and convert it for API calls.

   ' Send buttonup to finish the impending buttondown. This line of
   ' code does invoke the Label1_MouseUp() event, so be careful what
   ' code you place there:
   ret = Sendmessage(Me.hWnd, WM_LBUTTONUP, 0, p.xy)

   ' Tell the form someone is clicking the window caption:
   ret = Sendmessage(Me.hWnd, WM_SYSCOMMAND, MOUSE_MOVE, p.xy)
   parent.SetFocus

End Sub

Sub Picture1_MouseDown (Button As Integer, Shift As Integer, X As Single,
                        Y As Single)
Dim ret As Integer

If Button And 1 Then      'if left button pressed
    MDown = True          'set flag and invert bitmap
    ret = BitBlt(picture1.hDC, 0, 0, picture1.ScaleWidth,
                 picture1.ScaleHeight, picture1.hDC, 0, 0, DSTINVERT)
    InvertedImage = True  'set flag for inverted bitmap
End If

End Sub

' Change the following two lines to one, single line:
Sub Picture1_MouseMove (Button As Integer, Shift As Integer, X As Single,
   Y As Single)

   Dim ret As Integer   ' Hold return value of BitBlt

   If MDown Then
      ' If left button is down, locate where mouse is:
      ' Change the following two lines to one, single line:
      If (X < picture1.ScaleLeft) Or (X >= picture1.ScaleWidth) Or
         (Y < picture1.ScaleTop) Or (Y >= picture1.ScaleHeight) Then

         ' Outside picturebox, make sure image is normal:
         If InvertedImage Then
            picture1.Refresh
            InvertedImage = False
         End If
      Else
         ' Inside picturebox, make sure image is inverted:
         If Not InvertedImage Then
            ' Change the following two lines to one, single line:
            ret = BitBlt(picture1.hDC, 0, 0, picture1.ScaleWidth,
               picture1.ScaleHeight, picture1.hDC, 0, 0, DSTINVERT)
            InvertedImage = True
         End If
      End If
   End If

End Sub

' Change the following two lines to one, single line:
Sub Picture1_MouseUp (Button As Integer, Shift As Integer, X As Single,
   Y As Single)

   If (Button And 1) Then        ' If left mouse
      MDown = False              ' Clear flag
      picture1.Refresh           ' Refresh image
      If InvertedImage Then      ' If over image
         InvertedImage = False   ' Clear flag
         Me.Hide                 ' Hide toolbar - faster loading next time
      End If
   End If
   parent.SetFocus

End Sub

PARENT.FRM


' The following is a text dump of the PARENT form. It includes the form
' and control description as well as necessary Function and Sub procedures.
' Save the code in a single TEXT file called PARENT.FRM and you will
' be able to load it as a form in Visual Basic.

VERSION 2.00
Begin Form Parent
   Caption         =   "Form2"
   ClientHeight    =   2724
   ClientLeft      =   1320
   ClientTop       =   1608
   ClientWidth     =   3816
   Height          =   3144
   Left            =   1272
   LinkTopic       =   "Form2"
   ScaleHeight     =   2724
   ScaleWidth      =   3816
   Top             =   1236
   Width           =   3912
   Begin CommandButton Command1
      Caption         =   "Show Toolbar"
      Height          =   372
      Left            =   840
      TabIndex        =   1
      Top             =   2160
      Width           =   1932
   End
   Begin TextBox Text1
      Height          =   1932
      HideSelection   =   0   'False
      Left            =   240
      MultiLine       =   -1  'True
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   120
      Width           =   3252
   End
End

Sub Command1_Click ()
   Toolbar.Show
End Sub

Sub Form_Load ()
   Me.Caption = "Toolbar Sample"
End Sub

Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
   If ToolbarLoaded Then
      Unload Toolbar
   End If
End Sub

How to Create and Run the Program

Start a new project in Visual Basic. Form1 is created by default.

From the File menu, choose Remove File to remove Form1.

From the File menu, choose Add File, and add TOOLBAR.BAS

Repeat step 3 to add TOOLBAR.FRM and PARENT.FRM to the project.

From the Options menu, choose Project, and set Start Up Form to Parent.

Run the application.

The example allows the user to choose three clipboard operations (cut, copy, and paste) from the toolbar. These operations are available by default in a standard Visual Basic text box control but were chosen to demonstrate the functionality of the floating toolbar.

Additional query words: 2.00 3.00


Keywords          : 
Version           : 
Platform          : 
Issue type        :

Last Reviewed: June 9, 1999