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 :