home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Programmer'…arterly (Limited Edition) / Visual_Basic_Programmers_Journal_VB-CD_Quarterly_Limited_Edition_1995.iso / code / ch26code / tab.bas < prev    next >
BASIC Source File  |  1995-07-28  |  12KB  |  202 lines
  1. Attribute VB_Name = "basTabs"
  2. '*********************************************************************
  3. ' TABS.BAS - Creates a tabbed dialog effect for a form.
  4. '---------------------------------------------------------------------
  5. ' USAGE:    1. Set AutoRedraw = True on the destination form.
  6. '           2. Create a control array of Frames named Tabs.
  7. '           3. Label each frame in Tabs with an appropriate caption.
  8. '           4. From your forms Form_Load() event, call SetupTabs.
  9. '           5. Paste "Tabs(DrawTabs(Me, X, Y) - 1).ZOrder" into the
  10. '              forms Form_MouseUp event.
  11. '*********************************************************************
  12. Option Explicit
  13. Private TabLabels() As String
  14. '*********************************************************************
  15. ' Setup Tabs - Prepares a form to be a tabbed dialog.
  16. '---------------------------------------------------------------------
  17. ' FormName      (Form)      Name of the form to draw the tabs
  18. ' NumTabs       (String)    The number of Tabs() frames on FormName
  19. '*********************************************************************
  20. Public Sub SetupTabs(FormName As Form, NumTabs%)
  21. Dim i%
  22. Static BeenHereBefore As Boolean
  23.     If Not BeenHereBefore Then
  24.         '*************************************************************
  25.         ' Set the backcolor of the form.
  26.         '*************************************************************
  27.         FormName.BackColor = vb3DFace
  28.         '*************************************************************
  29.         ' Build the array that holds the tab labels.
  30.         '*************************************************************
  31.         ReDim TabLabels(1 To NumTabs)
  32.         '*************************************************************
  33.         ' Fill the array with the values provided by Labels.
  34.         '*************************************************************
  35.         For i = 1 To NumTabs
  36.             TabLabels(i) = FormName.Tabs(i - 1)
  37.             FormName.Tabs(i - 1) = ""
  38.             FormName.Tabs(i - 1).BackColor = vb3DFace
  39.         Next i
  40.         '*************************************************************
  41.         ' Set the static to prevent this code from being called twice
  42.         '*************************************************************
  43.         BeenHereBefore = True
  44.     End If
  45.     '*****************************************************************
  46.     ' Initialize the tabs.
  47.     '*****************************************************************
  48.     FormName.Tabs(DrawTabs(FormName, 10, 10) - 1).ZOrder
  49.     '*****************************************************************
  50.     ' Put the frames on top of each other.
  51.     '*****************************************************************
  52.     For i = 0 To NumTabs - 1
  53.         FormName.Tabs(i).Move 8, 24, FormName.ScaleWidth - 17, _
  54.                                             FormName.ScaleHeight - 32
  55.     Next i
  56. End Sub
  57. '*********************************************************************
  58. ' DrawTabs - Draws tabs on a form that look like Word & Excel's.
  59. '---------------------------------------------------------------------
  60. ' FormName      (Form)      Name of the form to draw the tabs
  61. ' Tabs()        (String)    Array of names for the tabs
  62. ' XPos, YPos    (Single)    Point clicked on the form
  63. ' RETURNS:
  64. ' This function returns the 1-based index of the active tab.
  65. '*********************************************************************
  66. Public Function DrawTabs%(FormName As Form, ByVal XPos!, ByVal YPos!)
  67. Dim NumTabs%, TabWidth%, i%, ActiveTab%
  68. Dim X As Single, X1 As Single
  69. Const TABHEIGHT = 18
  70. Const OFFSET = 4
  71.     '*****************************************************************
  72.     ' The form's ScaleMode MUST be in pixels, or else...
  73.     '*****************************************************************
  74.     FormName.ScaleMode = vbPixels
  75.     '*****************************************************************
  76.     ' Only respond to clicks within a tab.
  77.     '*****************************************************************
  78.     If YPos < OFFSET Or YPos > OFFSET + TABHEIGHT Then Exit Function
  79.     '*****************************************************************
  80.     ' Cache the upper index of Tabs.
  81.     '*****************************************************************
  82.     NumTabs = UBound(TabLabels)
  83.     '*****************************************************************
  84.     ' Setup the width of the tabs.
  85.     '*****************************************************************
  86.     TabWidth = (FormName.ScaleWidth - 2) / NumTabs
  87.     '*****************************************************************
  88.     ' Clear the form to prepare for new drawing.
  89.     '*****************************************************************
  90.     FormName.Cls
  91.     '*****************************************************************
  92.     ' Draw a black border around the tabs.
  93.     '*****************************************************************
  94.     For i = 1 To NumTabs
  95.         FormName.Line (X, TABHEIGHT + OFFSET)-(X, 4 + OFFSET), 0
  96.         FormName.Line (X, 4 + OFFSET)-(X + 4, 0 + OFFSET), 0
  97.         FormName.Line (X + 4, 0 + OFFSET)-(X + TabWidth - 4, 0 + _
  98.                                                             OFFSET), 0
  99.         FormName.Line (X + TabWidth - 4, 0 + OFFSET)-(X + TabWidth, _
  100.                                                         4 + OFFSET), 0
  101.         FormName.Line (X + TabWidth, 4 + OFFSET)-(X + TabWidth, _
  102.                                             TABHEIGHT + OFFSET + 2), 0
  103.         X = X + TabWidth
  104.     Next i
  105.     '*****************************************************************
  106.     ' Draw a black border around the form.
  107.     '*****************************************************************
  108.     FormName.Line (0, TABHEIGHT + OFFSET)- _
  109.                                      (0, FormName.ScaleHeight - 1), 0
  110.     FormName.Line (0, FormName.ScaleHeight - 1)- _
  111.                   ((TabWidth * NumTabs), FormName.ScaleHeight - 1), 0
  112.     FormName.Line ((TabWidth * NumTabs), FormName.ScaleHeight - 1)- _
  113.                         ((TabWidth * NumTabs), TABHEIGHT + OFFSET), 0
  114.     '*****************************************************************
  115.     ' Draw the 3D effect for the form.
  116.     '*****************************************************************
  117.     FormName.Line (1, TABHEIGHT + OFFSET)-(1, FormName.ScaleHeight _
  118.                                                        - 1), vb3DHighlight
  119.     FormName.Line (2, TABHEIGHT + OFFSET)-(2, FormName.ScaleHeight _
  120.                                                        - 1), vb3DHighlight
  121.     FormName.Line (2, FormName.ScaleHeight - 2)-((TabWidth * NumTabs) _
  122.                             - 1, FormName.ScaleHeight - 2), vb3DShadow
  123.     FormName.Line (3, FormName.ScaleHeight - 3)-((TabWidth * NumTabs) _
  124.                             - 2, FormName.ScaleHeight - 3), vb3DShadow
  125.     FormName.Line ((TabWidth * NumTabs) - 1, FormName.ScaleHeight - 2) _
  126.             -((TabWidth * NumTabs) - 1, TABHEIGHT + OFFSET), vb3DShadow
  127.     FormName.Line ((TabWidth * NumTabs) - 2, FormName.ScaleHeight - 2) _
  128.             -((TabWidth * NumTabs) - 2, TABHEIGHT + OFFSET), vb3DShadow
  129.     '*****************************************************************
  130.     ' Determine which tab was clicked.
  131.     '*****************************************************************
  132.     If XPos <> 0 Then ActiveTab = Int(XPos / TabWidth) + 1
  133.     '*****************************************************************
  134.     ' Make sure that ActiveTab is valid.
  135.     '*****************************************************************
  136.     If ActiveTab < 1 Or ActiveTab > NumTabs Then ActiveTab = 1
  137.     '*****************************************************************
  138.     ' Draw the 3D effect around the active tab.
  139.     '*****************************************************************
  140.     X = (ActiveTab - 1) * TabWidth
  141.     FormName.Line (X + 1, TABHEIGHT + OFFSET)-(X + 1, 4 + OFFSET), _
  142.                                                             vb3DHighlight
  143.     FormName.Line (X + 1, 4 + OFFSET)-(X + 4, 1 + 0 + OFFSET), _
  144.                                                             vb3DHighlight
  145.     FormName.Line (X + 2, TABHEIGHT + OFFSET)-(X + 2, 4 + OFFSET), _
  146.                                                             vb3DHighlight
  147.     FormName.Line (X + 2, 4 + OFFSET)-(X + 5, 1 + 0 + OFFSET), _
  148.                                                             vb3DHighlight
  149.     FormName.Line (X + 4, 1 + 0 + OFFSET)-(X + TabWidth - 4, 1 + 0 _
  150.                                                  + OFFSET), vb3DHighlight
  151.     FormName.Line (X + TabWidth - 4, 1 + 0 + OFFSET)-(X + TabWidth _
  152.                                         - 1, 4 + OFFSET), vb3DShadow
  153.     FormName.Line (X + TabWidth - 1, 4 + OFFSET)-(X + TabWidth - 1, _
  154.                                  TABHEIGHT + OFFSET + 2), vb3DShadow
  155.     FormName.Line (X + TabWidth - 5, 1 + 0 + OFFSET)-(X + TabWidth _
  156.                                         - 2, 4 + OFFSET), vb3DShadow
  157.     FormName.Line (X + TabWidth - 2, 4 + OFFSET)-(X + TabWidth - 2, _
  158.                                   TABHEIGHT + OFFSET + 2), vb3DShadow
  159.     '*****************************************************************
  160.     ' Draw a horizontal 3D line to the left of the active tab.
  161.     '*****************************************************************
  162.     X = 2
  163.     X1 = ((ActiveTab - 1) * TabWidth) + 1
  164.     If X <> X1 + 1 Then
  165.         FormName.Line (X - 1, TABHEIGHT + OFFSET)-(X1, TABHEIGHT + _
  166.                                                           OFFSET), 0
  167.         FormName.Line (X, TABHEIGHT + OFFSET + 1)-(X1 + 1, TABHEIGHT _
  168.                                                + OFFSET + 1), vb3DHighlight
  169.     End If
  170.     '*****************************************************************
  171.     ' Draw a horizontal 3D line to the right of the active tab.
  172.     '*****************************************************************
  173.     X = ActiveTab * TabWidth
  174.     X1 = (TabWidth * NumTabs) - 2
  175.     If X <> X1 + 2 Then
  176.         FormName.Line (X, TABHEIGHT + OFFSET)-(X1 + 1, TABHEIGHT + _
  177.                                                           OFFSET), 0
  178.         FormName.Line (X - 1, TABHEIGHT + OFFSET + 1)-(X1, TABHEIGHT _
  179.                                                + OFFSET + 1), vb3DHighlight
  180.     End If
  181.     '*****************************************************************
  182.     ' Print the text on the tabs.
  183.     '*****************************************************************
  184.     X = 0
  185.     FormName.CurrentY = OFFSET + ((TABHEIGHT / 2) - _
  186.                                        (FormName.TextHeight("X") / 2))
  187.     For i = 1 To NumTabs
  188.         FormName.FontBold = IIf(i = ActiveTab, True, False)
  189.         FormName.CurrentX = X + (TabWidth / 2) - _
  190.                            (FormName.TextWidth(Trim(TabLabels(i))) / 2)
  191.         '*************************************************************
  192.         ' A semi-colon is required to prevent changing CurrentY.
  193.         '*************************************************************
  194.         FormName.Print Trim(TabLabels(i));
  195.         X = X + TabWidth
  196.     Next i
  197.     '*****************************************************************
  198.     ' Return the active tab index.
  199.     '*****************************************************************
  200.     DrawTabs = ActiveTab
  201. End Function
  202.