home *** CD-ROM | disk | FTP | other *** search
- Attribute VB_Name = "basTabs"
- '*********************************************************************
- ' TABS.BAS - Creates a tabbed dialog effect for a form.
- '---------------------------------------------------------------------
- ' USAGE: 1. Set AutoRedraw = True on the destination form.
- ' 2. Create a control array of Frames named Tabs.
- ' 3. Label each frame in Tabs with an appropriate caption.
- ' 4. From your forms Form_Load() event, call SetupTabs.
- ' 5. Paste "Tabs(DrawTabs(Me, X, Y) - 1).ZOrder" into the
- ' forms Form_MouseUp event.
- '*********************************************************************
- Option Explicit
- Private TabLabels() As String
- '*********************************************************************
- ' Setup Tabs - Prepares a form to be a tabbed dialog.
- '---------------------------------------------------------------------
- ' FormName (Form) Name of the form to draw the tabs
- ' NumTabs (String) The number of Tabs() frames on FormName
- '*********************************************************************
- Public Sub SetupTabs(FormName As Form, NumTabs%)
- Dim i%
- Static BeenHereBefore As Boolean
- If Not BeenHereBefore Then
- '*************************************************************
- ' Set the backcolor of the form.
- '*************************************************************
- FormName.BackColor = vb3DFace
- '*************************************************************
- ' Build the array that holds the tab labels.
- '*************************************************************
- ReDim TabLabels(1 To NumTabs)
- '*************************************************************
- ' Fill the array with the values provided by Labels.
- '*************************************************************
- For i = 1 To NumTabs
- TabLabels(i) = FormName.Tabs(i - 1)
- FormName.Tabs(i - 1) = ""
- FormName.Tabs(i - 1).BackColor = vb3DFace
- Next i
- '*************************************************************
- ' Set the static to prevent this code from being called twice
- '*************************************************************
- BeenHereBefore = True
- End If
- '*****************************************************************
- ' Initialize the tabs.
- '*****************************************************************
- FormName.Tabs(DrawTabs(FormName, 10, 10) - 1).ZOrder
- '*****************************************************************
- ' Put the frames on top of each other.
- '*****************************************************************
- For i = 0 To NumTabs - 1
- FormName.Tabs(i).Move 8, 24, FormName.ScaleWidth - 17, _
- FormName.ScaleHeight - 32
- Next i
- End Sub
- '*********************************************************************
- ' DrawTabs - Draws tabs on a form that look like Word & Excel's.
- '---------------------------------------------------------------------
- ' FormName (Form) Name of the form to draw the tabs
- ' Tabs() (String) Array of names for the tabs
- ' XPos, YPos (Single) Point clicked on the form
- ' RETURNS:
- ' This function returns the 1-based index of the active tab.
- '*********************************************************************
- Public Function DrawTabs%(FormName As Form, ByVal XPos!, ByVal YPos!)
- Dim NumTabs%, TabWidth%, i%, ActiveTab%
- Dim X As Single, X1 As Single
- Const TABHEIGHT = 18
- Const OFFSET = 4
- '*****************************************************************
- ' The form's ScaleMode MUST be in pixels, or else...
- '*****************************************************************
- FormName.ScaleMode = vbPixels
- '*****************************************************************
- ' Only respond to clicks within a tab.
- '*****************************************************************
- If YPos < OFFSET Or YPos > OFFSET + TABHEIGHT Then Exit Function
- '*****************************************************************
- ' Cache the upper index of Tabs.
- '*****************************************************************
- NumTabs = UBound(TabLabels)
- '*****************************************************************
- ' Setup the width of the tabs.
- '*****************************************************************
- TabWidth = (FormName.ScaleWidth - 2) / NumTabs
- '*****************************************************************
- ' Clear the form to prepare for new drawing.
- '*****************************************************************
- FormName.Cls
- '*****************************************************************
- ' Draw a black border around the tabs.
- '*****************************************************************
- For i = 1 To NumTabs
- FormName.Line (X, TABHEIGHT + OFFSET)-(X, 4 + OFFSET), 0
- FormName.Line (X, 4 + OFFSET)-(X + 4, 0 + OFFSET), 0
- FormName.Line (X + 4, 0 + OFFSET)-(X + TabWidth - 4, 0 + _
- OFFSET), 0
- FormName.Line (X + TabWidth - 4, 0 + OFFSET)-(X + TabWidth, _
- 4 + OFFSET), 0
- FormName.Line (X + TabWidth, 4 + OFFSET)-(X + TabWidth, _
- TABHEIGHT + OFFSET + 2), 0
- X = X + TabWidth
- Next i
- '*****************************************************************
- ' Draw a black border around the form.
- '*****************************************************************
- FormName.Line (0, TABHEIGHT + OFFSET)- _
- (0, FormName.ScaleHeight - 1), 0
- FormName.Line (0, FormName.ScaleHeight - 1)- _
- ((TabWidth * NumTabs), FormName.ScaleHeight - 1), 0
- FormName.Line ((TabWidth * NumTabs), FormName.ScaleHeight - 1)- _
- ((TabWidth * NumTabs), TABHEIGHT + OFFSET), 0
- '*****************************************************************
- ' Draw the 3D effect for the form.
- '*****************************************************************
- FormName.Line (1, TABHEIGHT + OFFSET)-(1, FormName.ScaleHeight _
- - 1), vb3DHighlight
- FormName.Line (2, TABHEIGHT + OFFSET)-(2, FormName.ScaleHeight _
- - 1), vb3DHighlight
- FormName.Line (2, FormName.ScaleHeight - 2)-((TabWidth * NumTabs) _
- - 1, FormName.ScaleHeight - 2), vb3DShadow
- FormName.Line (3, FormName.ScaleHeight - 3)-((TabWidth * NumTabs) _
- - 2, FormName.ScaleHeight - 3), vb3DShadow
- FormName.Line ((TabWidth * NumTabs) - 1, FormName.ScaleHeight - 2) _
- -((TabWidth * NumTabs) - 1, TABHEIGHT + OFFSET), vb3DShadow
- FormName.Line ((TabWidth * NumTabs) - 2, FormName.ScaleHeight - 2) _
- -((TabWidth * NumTabs) - 2, TABHEIGHT + OFFSET), vb3DShadow
- '*****************************************************************
- ' Determine which tab was clicked.
- '*****************************************************************
- If XPos <> 0 Then ActiveTab = Int(XPos / TabWidth) + 1
- '*****************************************************************
- ' Make sure that ActiveTab is valid.
- '*****************************************************************
- If ActiveTab < 1 Or ActiveTab > NumTabs Then ActiveTab = 1
- '*****************************************************************
- ' Draw the 3D effect around the active tab.
- '*****************************************************************
- X = (ActiveTab - 1) * TabWidth
- FormName.Line (X + 1, TABHEIGHT + OFFSET)-(X + 1, 4 + OFFSET), _
- vb3DHighlight
- FormName.Line (X + 1, 4 + OFFSET)-(X + 4, 1 + 0 + OFFSET), _
- vb3DHighlight
- FormName.Line (X + 2, TABHEIGHT + OFFSET)-(X + 2, 4 + OFFSET), _
- vb3DHighlight
- FormName.Line (X + 2, 4 + OFFSET)-(X + 5, 1 + 0 + OFFSET), _
- vb3DHighlight
- FormName.Line (X + 4, 1 + 0 + OFFSET)-(X + TabWidth - 4, 1 + 0 _
- + OFFSET), vb3DHighlight
- FormName.Line (X + TabWidth - 4, 1 + 0 + OFFSET)-(X + TabWidth _
- - 1, 4 + OFFSET), vb3DShadow
- FormName.Line (X + TabWidth - 1, 4 + OFFSET)-(X + TabWidth - 1, _
- TABHEIGHT + OFFSET + 2), vb3DShadow
- FormName.Line (X + TabWidth - 5, 1 + 0 + OFFSET)-(X + TabWidth _
- - 2, 4 + OFFSET), vb3DShadow
- FormName.Line (X + TabWidth - 2, 4 + OFFSET)-(X + TabWidth - 2, _
- TABHEIGHT + OFFSET + 2), vb3DShadow
- '*****************************************************************
- ' Draw a horizontal 3D line to the left of the active tab.
- '*****************************************************************
- X = 2
- X1 = ((ActiveTab - 1) * TabWidth) + 1
- If X <> X1 + 1 Then
- FormName.Line (X - 1, TABHEIGHT + OFFSET)-(X1, TABHEIGHT + _
- OFFSET), 0
- FormName.Line (X, TABHEIGHT + OFFSET + 1)-(X1 + 1, TABHEIGHT _
- + OFFSET + 1), vb3DHighlight
- End If
- '*****************************************************************
- ' Draw a horizontal 3D line to the right of the active tab.
- '*****************************************************************
- X = ActiveTab * TabWidth
- X1 = (TabWidth * NumTabs) - 2
- If X <> X1 + 2 Then
- FormName.Line (X, TABHEIGHT + OFFSET)-(X1 + 1, TABHEIGHT + _
- OFFSET), 0
- FormName.Line (X - 1, TABHEIGHT + OFFSET + 1)-(X1, TABHEIGHT _
- + OFFSET + 1), vb3DHighlight
- End If
- '*****************************************************************
- ' Print the text on the tabs.
- '*****************************************************************
- X = 0
- FormName.CurrentY = OFFSET + ((TABHEIGHT / 2) - _
- (FormName.TextHeight("X") / 2))
- For i = 1 To NumTabs
- FormName.FontBold = IIf(i = ActiveTab, True, False)
- FormName.CurrentX = X + (TabWidth / 2) - _
- (FormName.TextWidth(Trim(TabLabels(i))) / 2)
- '*************************************************************
- ' A semi-colon is required to prevent changing CurrentY.
- '*************************************************************
- FormName.Print Trim(TabLabels(i));
- X = X + TabWidth
- Next i
- '*****************************************************************
- ' Return the active tab index.
- '*****************************************************************
- DrawTabs = ActiveTab
- End Function
-