Microsoft KB Archive/114594

= How to Create a Floating Toolbar in Visual Basic 3.0 =

Article ID: 114594

Article Last Modified on 12/9/2003

-

APPLIES TO


 * Microsoft Visual Basic 2.0 Standard Edition
 * Microsoft Visual Basic 3.0 Professional Edition
 * Microsoft Visual Basic 2.0 Professional Edition
 * Microsoft Visual Basic 3.0 Professional Edition

-



This article was previously published under Q114594



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:

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

114593 : 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

 * 1) Start a new project in Visual Basic. Form1 is created by default.
 * 2) From the File menu, choose Remove File to remove Form1.
 * 3) From the File menu, choose Add File, and add TOOLBAR.BAS
 * 4) Repeat step 3 to add TOOLBAR.FRM and PARENT.FRM to the project.
 * 5) From the Options menu, choose Project, and set Start Up Form to Parent.
 * 6) Run the application.
 * 7) 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: KB114594

-

[mailto:TECHNET@MICROSOFT.COM Send feedback to Microsoft]

© Microsoft Corporation. All rights reserved.