Solved

Flat ToolBars

Posted on 1998-05-29
11
455 Views
Last Modified: 2008-02-01
I realize that there are several good ActiveX components out there but I would like to create my own flat toolbar mirroring the Office 97 toolbars.  Problem is, I'm not sure where to begin.  I want the flat buttons that raise when the mouse passes over them but I'm not sure how to do this.  (SetCapture, Timer, or what?  Even Microsoft is contradictory in it's Soft Button and Hot Tracking examples).  Also, How do you create dockable toolbars?  How about drop-down boxes with pictures (menus and combo-boxes)I could go on all day but you get the idea.  Essentially, I'm just fishing for advice, suggestions, comments(code is nice, if you want to include it, especially regarding API's) on where to begin.
0
Comment
Question by:nguy
  • 3
  • 3
  • 2
  • +2
11 Comments
 
LVL 4

Expert Comment

by:zsi
ID: 1462012
You can find source code to do this at http://premium.microsoft.com/download/vbasic/SoftBttn.exe

If you are not already, you will need to register your copy of VB.

zsi
0
 
LVL 4

Expert Comment

by:zsi
ID: 1462013
0
 

Author Comment

by:nguy
ID: 1462014
Thank you zsi, for your advice.  However, as alluded to, I have already examined both the Soft Button and Hot Tracking samples.  I am confused as to which to build upon.  The Soft Button uses SetCapture and several other API's to work around it's effects while the Hot Tracking documentation warns not to use SetCapture for tracking the mouse.  Which one is better?  A matter of taste perhaps but I would appreciate more feedback on this issue.  Thanks again.
0
 
LVL 4

Expert Comment

by:zsi
ID: 1462015
Ah, sorry.  I missed that.

My own personal preference is to use SetCapture.  I have used it for other effects, such as splitter bars without any problems.  Bruce McKinney, author of Hardcore Visual Basic, also recommends using SetCapture.

In the Hot Tracking example, which I have not had the time to scrutinize, what was their opinion on using SetCapture?

zsi
0
 
LVL 5

Accepted Solution

by:
yronnen earned 210 total points
ID: 1462016
Create a class, call it CoolBar.

In your form, where you want the toolbar called (for example) Tbar, type in the declarations:

dim x as CoolBar

and in the form_load:
x.TBMakeFlat Tbar

This will make the toolbar flat.

Here's the code for the class ,simply copy it:
Option Explicit
Public RebarWindow As Long
Private RebarChildWin As Object

Private Type tagInitCommonControlsEx
    lngSize As Long
    lngICC As Long
End Type

Public Enum BandPosition
    AddNewRow = 1
    AddToEnd = 2
End Enum

Private Const HWND_TOPMOST = -1
Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOREDRAW = &H8
Private Const SWP_SHOWWINDOW = &H40

Private RebarPic As Object

Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wcmd As Long) As Long
Private Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function InitCommonControlsEx Lib "Comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function CreateWindowEX Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function SendTBMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, _
ByVal lParam As Any) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Const WM_USER = &H400

' Toolbar Const
Private Const TBSTYLE_TRANSPARENT = &H8000 'Haven't gotton this one to work with regular toolbars yet.
Private Const TBSTYLE_FLAT = &H800
Private Const TB_SETSTYLE = (WM_USER + 56)
Private Const TB_GETSTYLE = (WM_USER + 57)
Private Const TBSTYLE_LIST = &H1000

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
 
' System Color Constants
Private Const COLOR_BTNFACE = 15
Private Const COLOR_BTNTEXT = 18

Private Const REBARCLASSNAME = "ReBarWindow32"
Private Const RBN_FIRST = 0 - 831
Private Const RBN_LAST = 0 - 859
Private Const RBIM_IMAGELIST = &H1
Private Const ICC_COOL_CLASSES = &H400

' Rebar Styles
Private Const RBS_AUTOSIZE = &H2000
Private Const RBS_VERTICALGRIPPER = &H4000   ' this always has the vertical gripper (default for horizontal mode)
Private Const RBS_TOOLTIPS = &H100
Private Const RBS_VARHEIGHT = &H200
Private Const RBS_BANDBORDERS = &H400
Private Const RBBS_VARIABLEHEIGHT = &H40
Private Const RBS_FIXEDORDER = &H800
Private Const RBBS_GRIPPERALWAYS = &H80      ' always show the gripper
Private Const RBBS_BREAK = &H1               ' break to new line
Private Const RBBS_FIXEDSIZE = &H2           ' band can't be sized
Private Const RBBS_CHILDEDGE = &H4           ' edge around top & bottom of child window
Private Const RBBS_HIDDEN = &H8              ' don't show
Private Const RBBS_NOVERT = &H10             ' don't show when vertical
Private Const RBBS_FIXEDBMP = &H20           ' bitmap doesn't move during band resize
Private Const RBBIM_STYLE = &H1
Private Const RBBIM_COLORS = &H2
Private Const RBBIM_TEXT = &H4
Private Const RBBIM_IMAGE = &H8
Private Const RBBIM_CHILD = &H10
Private Const RBBIM_CHILDSIZE = &H20
Private Const RBBIM_SIZE = &H40
Private Const RBBIM_BACKGROUND = &H80
Private Const RBBIM_ID = &H100
Private Const RB_BEGINDRAG = (WM_USER + 24)
Private Const RB_ENDDRAG = (WM_USER + 25)
Private Const RB_DRAGMOVE = (WM_USER + 26)
Private Const RB_HITTEST = (WM_USER + 8)
Private Const RB_INSERTBANDA = (WM_USER + 1)
Private Const RB_DELETEBAND = (WM_USER + 2)
Private Const RB_GETBARINFO = (WM_USER + 3)
Private Const RB_SETBARINFO = (WM_USER + 4)
Private Const RB_GETBANDINFO = (WM_USER + 5)
Private Const RB_SETBANDINFOA = (WM_USER + 6)
Private Const RB_SETPARENT = (WM_USER + 7)
Private Const RB_INSERTBANDW = (WM_USER + 10)
Private Const RB_SETBANDINFOW = (WM_USER + 11)
Private Const RB_GETBANDCOUNT = (WM_USER + 12)
Private Const RB_GETROWCOUNT = (WM_USER + 13)
Private Const RB_GETROWHEIGHT = (WM_USER + 14)
Private Const RB_SETBKCOLOR = (WM_USER + 19)
Private Const RB_GETBKCOLOR = (WM_USER + 20)
Private Const RB_SETTEXTCOLOR = (WM_USER + 21)
Private Const RB_GETTEXTCOLOR = (WM_USER + 22)
Private Const RBHT_NOWHERE = &H1
Private Const RBHT_CAPTION = &H2
Private Const RBHT_CLIENT = &H3
Private Const RBHT_GRABBER = &H4
Private Const GWL_HWNDPARENT = (-8)
Private Const GWL_STYLE = (-16)
Private Const RB_INSERTBAND = RB_INSERTBANDA
Private Const RB_SETBANDINFO = RB_SETBANDINFOA
Private Const RBN_HEIGHTCHANGE = (RBN_FIRST - 0)

' CreateWindowEx Constants
Private Const WS_BORDER = &H800000
Private Const WS_CLIPCHILDREN = &H2000000
Private Const WS_CLIPSIBLINGS = &H4000000
Private Const WS_VISIBLE = &H10000000
Private Const WS_CHILD = &H40000000
Private Const CCS_NORESIZE = &H4
Private Const CCS_NOPARENTALIGN = &H8
Private Const CCS_NODIVIDER = &H40
Private Const CCS_VERT = &H80

Private Type tagRebarInfo
    cbSize As Integer
    fMask As Integer
    himl As Long
End Type

Private Type tagRebarBandInfo
    cbSize As Long
    fMask As Long
    fStyle As Long
    clrFore As Long
    clrBack As Long
    lpText As String
    cch As Long
    iImage As Long
    hWndChild As Long
    cxMinChild As Long
    cyMinChild As Long
    cx As Long
    hbmBack As Long
    wID As Long
End Type
 
Private RebarhWnd As Long
Private RebarParent As Object
 
 
Sub TBMakeFlat(Tb As Object, Optional TBList As Boolean)
 
   Dim Style As Long
   Dim lRet As Long
   Dim ToolbarHandle As Long


   ToolbarHandle = FindWindowEx(Tb.hwnd, 0&, "ToolbarWindow32", vbNullString)

   Style = SendTBMessage(ToolbarHandle, TB_GETSTYLE, 0&, 0&)
   
   If TBList = True Then
   Style = Style Or TBSTYLE_FLAT Or TBSTYLE_TRANSPARENT Or CCS_NODIVIDER Or TBSTYLE_LIST
   Else
   Style = Style Or TBSTYLE_FLAT Or TBSTYLE_TRANSPARENT Or CCS_NODIVIDER
   End If
   
   lRet = SendTBMessage(ToolbarHandle, TB_SETSTYLE, 0, Style)

   Tb.Refresh
   
End Sub

Public Sub SetBandColors()
 
'This procedure is used to set the band colors in case the system color changes

Dim RebarBand As tagRebarBandInfo
RebarBand.cbSize = LenB(RebarBand)

'Add Mask for all possibilities
RebarBand.fMask = RBBIM_COLORS Or RBBIM_IMAGE Or RBBIM_BACKGROUND Or RBBS_FIXEDBMP Or RBBIM_CHILD Or RBBIM_CHILDSIZE Or _
RBBIM_ID Or RBBIM_STYLE Or RBBIM_TEXT Or RBBS_BREAK Or RBS_FIXEDORDER Or RBBS_FIXEDSIZE
'Set RebarBands Colors
 
Dim xReturn As Long
Dim xCount As Integer
xCount = SendMessage(RebarhWnd, RB_GETBANDCOUNT, 0, 0)

For xCount = 0 To xCount - 1
xReturn = SendMessage(RebarhWnd, RB_GETBANDINFO, xCount, RebarBand)

RebarBand.clrFore = GetSysColor(COLOR_BTNTEXT)
RebarBand.clrBack = GetSysColor(COLOR_BTNFACE)

xReturn = SendMessage(RebarhWnd, RB_SETBANDINFO, xCount, RebarBand)
Next

End Sub

Public Sub DestroyRebar()
On Error Resume Next
' We Must return all children that we did not create
' back to the form.

Dim hwnd As Long

Call ShowWindow(RebarhWnd, SW_HIDE)
' Get Window Handle of 1st child
hwnd = GetWindow(RebarhWnd, GW_CHILD)

Do
' Return Child
 Call SetParent(hwnd, Parent.hwnd)

' Get Next Window
hwnd = GetWindow(hwnd, GW_CHILD)

' Loop until we run out
Loop While hwnd <> 0

Dim BandCount As Integer, i As Integer

' Get number of bands
BandCount = SendMessage(RebarhWnd, RB_GETBANDCOUNT, 0, 0)

For i = 0 To BandCount - 1
Call SendMessage(RebarhWnd, RB_DELETEBAND, 0, 0)
Next
 
' Now it's safe to kill the rebar
If RebarhWnd <> 0 Then
   Call DestroyWindow(RebarhWnd)
End If

End Sub
Public Function GetRebarWindow()
GetRebarWindow = RebarhWnd
End Function
Public Sub Resize(frm As Object)
 On Error Resume Next
 Call MoveWindow(RebarhWnd, 0, 0, frm.Width / Screen.TwipsPerPixelX - 8, 0, True)
 Call UpdateWindow(RebarhWnd)
End Sub
Public Sub Move(Left As Long, Top As Long, Width As Long, Height As Long)
On Error Resume Next
    If hwnd <> 0 Then
        Call MoveWindow(hwnd, Left, Top, Width, Height, True)
    End If
   
End Sub
Public Property Get hwnd() As Long
    hwnd = RebarhWnd
    RebarWindow = RebarhWnd
End Property
Public Function Create()
On Error Resume Next
   
    If Parent Is Nothing Then
       Create = False
       Exit Function
    End If
         
    'RBS_AUTOSIZE Or
    RebarhWnd = CreateWindowEX(0, "ReBarWindow32", "", _
    WS_VISIBLE Or WS_BORDER Or WS_CHILD Or _
    RBS_VARHEIGHT Or RBS_BANDBORDERS Or _
    CCS_NODIVIDER Or RBS_VERTICALGRIPPER Or _
    RBBS_VARIABLEHEIGHT Or CCS_NOPARENTALIGN, _
    0, 0, Parent.Width, 60, _
    Parent.hwnd, 0&, App.hInstance, 0&)
     
    Call Move(CLng(0), CLng(0), CLng(Parent.Width), CLng(60))
    Call ShowWindow(RebarhWnd, SW_SHOWNORMAL)
    'Set Parent to receive messages
    Call SetParent(RebarhWnd, Parent.hwnd)
    Create = (RebarhWnd <> 0)

End Function
Public Property Set Parent(frm As Object)
    Set RebarParent = frm
End Property
Public Property Get Parent() As Object
    Set Parent = RebarParent
End Property
Public Property Set ImageForRebar(Img As Object)
On Error Resume Next
Set RebarPic = Img
End Property
Private Sub Class_Initialize()
    Dim iccex As tagInitCommonControlsEx
    With iccex
        .lngSize = LenB(iccex)
        .lngICC = ICC_COOL_CLASSES
    End With
    Call InitCommonControlsEx(iccex)
    RebarhWnd = 0
End Sub

0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

Author Comment

by:nguy
ID: 1462017
yronnen,
Thank you for the class.  I will examine the code and give it a try.  I'll probably add more points if it works out well since you provided me with another model to dissect.  If you don't mind my asking, did you create this class?  Thanks again, nguy
0
 
LVL 5

Expert Comment

by:yronnen
ID: 1462018
I did not create this class.
I don't even remember where I've got it (somewhere on the net).
0
 
LVL 4

Expert Comment

by:yowkee
ID: 1462019
nguy,

  For flat toolbar or Office 97 toolbar, refer to:
http://ourworld.compuserve.com/homepages/rfaricy/projects/TBar97.zip
http://ourworld.compuserve.com/homepages/rfaricy/projects/RebarSource.zip
 
  For menu with icons or owner draw menu, refer to:
http://ourworld.compuserve.com/homepages/rfaricy/projects/OwnMenu2.zip
http://ourworld.compuserve.com/homepages/rfaricy/projects/MnuBmp.zip

  For combobox which drop down a treeview(as windows explorer), refer to:
 http://www.zonecorp.com/VB5/ComboBox.htm  (this is written as a control but include source code)

  For dockable window, you must change the window style of the dockable window to WS_EX_PALETTEWINDOW. Implement this through API SetWindowLong:
SetWindowLong(Form1.hwnd, GWL_EXSTYLE, CLng(WS_EX_PALETTEWINDOW))
If you need source code, I can mail to you.

0
 
LVL 4

Expert Comment

by:yowkee
ID: 1462020
nguy,

 For flat toolbar or Office 97 toolbar, refer to:
http://ourworld.compuserve.com/homepages/rfaricy/projects/TBar97.zip
http://ourworld.compuserve.com/homepages/rfaricy/projects/RebarSource.zip

 For menu with icons, refer to:
http://ourworld.compuserve.com/homepages/rfaricy/projects/MnuBmp.zip
http://ourworld.compuserve.com/homepages/rfaricy/projects/OwnMenu2.zip

 For combobox which drop down a treeview(as windows explorer), refer to:
http://www.zonecorp.com/VB5/ComboBox.htm (it is written as control, include source code)

 For dockable window, you must set the window style to WS_EX_PALETTEWINDOW. Use API SetWindowLong to change window style:
SetWindowLong(Form1.hwnd, GWL_EXSTYLE, CLng(WS_EX_PALETTEWINDOW))
If you need source code, I can mail to you.

 By the way, SetCapture on a window will route every subsequent mouse message to that window, even mouse is not at the region of that window. So, be aware while using it and remember to ReleaseCapture.
0
 

Author Comment

by:nguy
ID: 1462021
Thank you Yowkee.  I'll look over the samples and see what I can use. And thanks again yronnen.  If you ever figure out where you got the code please let me know.
0
 

Expert Comment

by:wsanchez
ID: 1462022
I believe the code for the coolbar class was taken from http://www.geocities.com/SiliconValley/Way/6445.  You can download a demo there.
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now