GFTabString/GFTabStringcls.cls
VERSION 1.0 CLASS
BEGIN
MultiUse = ‑1 'True
END
Attribute VB_Name = "GFTabStringcls"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'(c)2001, 2002 by Louis.
'NOTE: the GFTabString behaves ALMOST like the original TabString,
'only the tab header width differs by a small amount.
'
'THIS CLASS IS PLUG‑IN CODE, DO NOT CHANGE!
'
'v1.1; supports placing the GFTabString into a child window to allow
'moving the GFTabString
'(GFTabStringLine(0) must be moved into child window, but is still a child of the form).
'
'TabHeaderLine
'
'NOTE: the TabHeaderLines are copies of GFTabStringLine(0)
'and are used to create the TabHeaders and the TabBox.
'
Dim TabHeaderLineIndexMax As Integer 'how many lines are used until now
'FontStruct
Private Type FontStruct
Name As String
Size As Single
Bold As Boolean
Italic As Boolean
Underline As Boolean
StrikeThrough As Boolean
End Type
'TabHeader
Private Type TabHeaderStruct
TabHeaderText As String
TabHeaderWidth As Long 'inner width in pixels
TabHeaderLineStartIndex As Integer 'GFTabStringLine(x min)
TabHeaderLineEndIndex As Integer 'GFTabStringLine(x max)
TabHeaderControlNumber As Integer
TabHeaderControlArray() As Control
End Type
Dim TabHeaderStructNumber As Integer
Dim TabHeaderStructArray() As TabHeaderStruct
'TabString
'
'NOTE: the TabString consists of the TabBox and the TabHeaders.
'
Private Type TabStringStruct
TabBoxXPos As Long
TabBoxYPos As Long
TabBoxWidth As Long
TabBoxHeight As Long
TabHeaderFocusedIndex As Integer 'which header is marked
TabStringWindow As Object 'form/picture box where the tab string is to be displayed in
TabStringLineWindow As Form 'form that owns the GFTabStringLine(0)
TabStringDescription As String 'description (name) of current tab string
TabStringVisibleFlag As Boolean 'if the tab string and all its controls are visible or not
TabStringForeColor As Long 'back color defined by window back color
TabStringFont As FontStruct 'font used when printing tab header descriptions
AutoControlChangeEnabledFlag As Boolean 'if tab string displays/hides controls when the focused header has changed
End Type
Dim TabStringStructVar As TabStringStruct
'other
Const Version As String = "v1.4"
Const TabHeaderYSize As Long = 18
'***INTERFACE SUBS***
Public Sub TabString_Create(ByVal TabStringDescription As String, ByRef TabStringWindow As Object, ByRef TabStringLineWindow As Form, ByVal TabBoxXPos As Long, ByVal TabBoxYPos As Long, ByVal TabBoxWidth As Long, ByVal TabBoxHeight As Long)
'On Error Resume Next
If TabStringStructVar.TabStringDescription = TabStringDescription Then
'
'NOTE: the TabStringWindow was reloaded. The GFTabStringLines
'located on TabStringWindow have also been unloaded, so the whole
'values belonging to this tab string must also be reset.
'
TabHeaderLineIndexMax = 0 'reset
TabHeaderStructNumber = 0 'reset
ReDim TabHeaderStructArray(1 To 1) As TabHeaderStruct 'reset
End If
TabStringStructVar.AutoControlChangeEnabledFlag = True 'preset (can be changed via related property)
TabStringStructVar.TabBoxXPos = TabBoxXPos
TabStringStructVar.TabBoxYPos = TabBoxYPos + TabHeaderYSize
TabStringStructVar.TabBoxWidth = TabBoxWidth
TabStringStructVar.TabBoxHeight = TabBoxHeight ‑ TabHeaderYSize
TabStringStructVar.TabHeaderFocusedIndex = 1 'preset
TabStringStructVar.TabStringDescription = TabStringDescription
TabStringStructVar.TabStringVisibleFlag = True 'preset
Set TabStringStructVar.TabStringWindow = TabStringWindow
Set TabStringStructVar.TabStringLineWindow = TabStringLineWindow
TabStringStructVar.TabStringForeColor = TabStringWindow.ForeColor
'preset font
TabStringStructVar.TabStringFont.Name = TabStringStructVar.TabStringWindow.Font.Name
TabStringStructVar.TabStringFont.Size = TabStringStructVar.TabStringWindow.Font.Size
TabStringStructVar.TabStringFont.Bold = TabStringStructVar.TabStringWindow.Font.Bold
TabStringStructVar.TabStringFont.Italic = TabStringStructVar.TabStringWindow.Font.Italic
TabStringStructVar.TabStringFont.Underline = TabStringStructVar.TabStringWindow.Font.Underline
TabStringStructVar.TabStringFont.StrikeThrough = TabStringStructVar.TabStringWindow.Font.StrikeThrough
'end of presetting font
End Sub
Public Function GFTabString_MouseDown(ByVal X As Single, ByVal Y As Single) As Boolean
'On Error Resume Next 'function returns True if TabHeader and TabBox must be redrawn, False if not
Dim Temp As Long
Dim TabHeaderXPos As Long
Dim TabHeaderYPos As Long
Dim TabHeaderXStartPos As Long
Dim TabHeaderXEndPos As Long
'preset
X = X / Screen.TwipsPerPixelX
Y = Y / Screen.TwipsPerPixelY
TabHeaderXPos = TabStringStructVar.TabBoxXPos
TabHeaderYPos = TabStringStructVar.TabBoxYPos
GFTabString_MouseDown = False 'preset (TabHeader and TabBox must not be redrawn)
'begin
TabHeaderXEndPos = TabHeaderXPos
For Temp = 1 To TabHeaderStructNumber
'preset (within loop)
TabHeaderXStartPos = TabHeaderXEndPos
TabHeaderXEndPos = TabHeaderXStartPos + (TabHeaderStructArray(Temp).TabHeaderWidth + 1)
'begin (within loop)
If (Not (X < TabHeaderXStartPos)) And (Not (X > TabHeaderXEndPos)) Then
If (Not (Y < TabHeaderYPos ‑ TabHeaderYSize)) And (Not (Y > TabHeaderYPos)) Then
Debug.Print "TabString: clicked: " + LTrim$(Str$(Temp))
If Not (Temp = TabStringStructVar.TabHeaderFocusedIndex) Then
Debug.Print "TabString: should be redrawn"
TabStringStructVar.TabHeaderFocusedIndex = Temp
GFTabString_MouseDown = True 'TabHeader and TabBox must be redrawn
Else
Debug.Print "TabString: must not be redrawn"
'do nothing
End If
End If
End If
Next Temp
End Function
Public Sub TabBox_Add()
'On Error Resume Next 'call to reserve TabHeaderLine indices
Dim Temp As Long
'
'IMPORTANT: call TabBox_Add before adding any tab header.
'
For Temp = 1 To 10
With TabStringStructVar.TabStringLineWindow
Load .GFTabStringLine(TabHeaderLineIndexMax + Temp)
.GFTabStringLine(TabHeaderLineIndexMax + Temp).Visible = True 'DEBUG
End With
Next Temp
TabHeaderLineIndexMax = TabHeaderLineIndexMax + 12
End Sub
Public Sub TabHeader_Add(ByVal TabHeaderText As String)
'On Error Resume Next
Dim Temp As Long
'begin
If TabHeaderText = "" Then Exit Sub 'error
If Not (TabHeaderStructNumber = 32766) Then
TabHeaderStructNumber = TabHeaderStructNumber + 1
Else
Exit Sub 'error
End If
ReDim Preserve TabHeaderStructArray(1 To TabHeaderStructNumber) As TabHeaderStruct
TabHeaderStructArray(TabHeaderStructNumber).TabHeaderText = TabHeaderText
TabHeaderStructArray(TabHeaderStructNumber).TabHeaderWidth = ((TabStringStructVar.TabStringWindow.TextWidth(TabHeaderText) / Screen.TwipsPerPixelX) + 14)
'save indices of used TabHeaderLines
TabHeaderStructArray(TabHeaderStructNumber).TabHeaderLineStartIndex = TabHeaderLineIndexMax + 1
TabHeaderStructArray(TabHeaderStructNumber).TabHeaderLineEndIndex = TabHeaderLineIndexMax + 8
TabHeaderLineIndexMax = TabHeaderLineIndexMax + 8
'load used TabHeaderLines
For Temp = TabHeaderStructArray(TabHeaderStructNumber).TabHeaderLineStartIndex To TabHeaderStructArray(TabHeaderStructNumber).TabHeaderLineEndIndex
With TabStringStructVar.TabStringLineWindow
Load .GFTabStringLine(Temp)
.GFTabStringLine(Temp).Visible = True 'DEBUG
End With
Next Temp
End Sub
Public Sub TabString_AddControl(ByVal ControlName As Object, ByVal TabHeaderIndex As Integer)
'On Error Resume Next
Dim Temp As Long
If Not ((TabHeaderIndex < 1) Or (TabHeaderIndex > TabHeaderStructNumber)) Then 'verify
If Not (TabHeaderStructArray(TabHeaderIndex).TabHeaderControlNumber = 32766) Then 'verify
TabHeaderStructArray(TabHeaderIndex).TabHeaderControlNumber = TabHeaderStructArray(TabHeaderIndex).TabHeaderControlNumber + 1
Else
Exit Sub 'error
End If
ReDim Preserve TabHeaderStructArray(TabHeaderIndex).TabHeaderControlArray(1 To TabHeaderStructArray(TabHeaderIndex).TabHeaderControlNumber) As Control
Set TabHeaderStructArray(TabHeaderIndex).TabHeaderControlArray(TabHeaderStructArray(TabHeaderIndex).TabHeaderControlNumber) = _
ControlName
Else
MsgBox "internal error in TabString_AddControl(): passed value invalid !", vbOKOnly + vbExclamation
End If
End Sub
Public Sub TabBox_Refresh()
'On Error Resume Next
Dim TabBoxXPos As Long
Dim TabBoxYPos As Long
Dim TabBoxWidth As Long
Dim TabBoxHeight As Long
Dim TabHeaderFocusedXStartPos As Long
Dim TabHeaderFocusedXEndPos As Long
Dim Temp As Long
'preset
TabBoxXPos = TabStringStructVar.TabBoxXPos
TabBoxYPos = TabStringStructVar.TabBoxYPos
TabBoxWidth = TabStringStructVar.TabBoxWidth
TabBoxHeight = TabStringStructVar.TabBoxHeight
'preset (2)
TabHeaderFocusedXEndPos = TabBoxXPos 'preset
For Temp = 1 To TabStringStructVar.TabHeaderFocusedIndex
TabHeaderFocusedXStartPos = TabHeaderFocusedXEndPos
TabHeaderFocusedXEndPos = TabHeaderFocusedXStartPos + (TabHeaderStructArray(Temp).TabHeaderWidth + 1)
Next Temp
TabHeaderFocusedXEndPos = TabHeaderFocusedXEndPos + 4 'add 4 as x size of activated TabHeader is increased by 4
'begin
'
'NOTE: tab box must have been added before tab headers.
'
'NOTE: lines are drawn beginning with left edge, counter‑clockwise.
With TabStringStructVar.TabStringLineWindow
'left outside
.GFTabStringLine(1).BorderColor = &H80000014
.GFTabStringLine(1).X1 = (TabBoxXPos) * Screen.TwipsPerPixelX
.GFTabStringLine(1).X2 = (TabBoxXPos) * Screen.TwipsPerPixelX
.GFTabStringLine(1).Y1 = (TabBoxYPos) * Screen.TwipsPerPixelY
.GFTabStringLine(1).Y2 = (TabBoxYPos + TabBoxHeight) * Screen.TwipsPerPixelY
.GFTabStringLine(1).Visible = TabStringStructVar.TabStringVisibleFlag
'
'left inside
.GFTabStringLine(2).BorderColor = &H80000016
.GFTabStringLine(2).X1 = (TabBoxXPos + 1) * Screen.TwipsPerPixelX
.GFTabStringLine(2).X2 = (TabBoxXPos + 1) * Screen.TwipsPerPixelX
.GFTabStringLine(2).Y1 = (TabBoxYPos + 1) * Screen.TwipsPerPixelY
.GFTabStringLine(2).Y2 = (TabBoxYPos + TabBoxHeight ‑ 1) * Screen.TwipsPerPixelY
.GFTabStringLine(2).Visible = TabStringStructVar.TabStringVisibleFlag
'
'bottom outside
.GFTabStringLine(3).BorderColor = &H0
.GFTabStringLine(3).X1 = (TabBoxXPos) * Screen.TwipsPerPixelX
.GFTabStringLine(3).X2 = (TabBoxXPos + TabBoxWidth) * Screen.TwipsPerPixelX
.GFTabStringLine(3).Y1 = (TabBoxYPos + TabBoxHeight) * Screen.TwipsPerPixelY
.GFTabStringLine(3).Y2 = (TabBoxYPos + TabBoxHeight) * Screen.TwipsPerPixelY
.GFTabStringLine(3).Visible = TabStringStructVar.TabStringVisibleFlag
'
'bottom inside
.GFTabStringLine(4).BorderColor = &H80000010
.GFTabStringLine(4).X1 = (TabBoxXPos + 1) * Screen.TwipsPerPixelX
.GFTabStringLine(4).X2 = (TabBoxXPos + TabBoxWidth) * Screen.TwipsPerPixelX
.GFTabStringLine(4).Y1 = (TabBoxYPos + TabBoxHeight ‑ 1) * Screen.TwipsPerPixelY
.GFTabStringLine(4).Y2 = (TabBoxYPos + TabBoxHeight ‑ 1) * Screen.TwipsPerPixelY
.GFTabStringLine(4).Visible = TabStringStructVar.TabStringVisibleFlag
'
'left outside
.GFTabStringLine(5).BorderColor = &H0
.GFTabStringLine(5).X1 = (TabBoxXPos + TabBoxWidth) * Screen.TwipsPerPixelX
.GFTabStringLine(5).X2 = (TabBoxXPos + TabBoxWidth) * Screen.TwipsPerPixelX
.GFTabStringLine(5).Y1 = (TabBoxYPos + TabBoxHeight) * Screen.TwipsPerPixelY
.GFTabStringLine(5).Y2 = (TabBoxYPos ‑ 1) * Screen.TwipsPerPixelY
.GFTabStringLine(5).Visible = TabStringStructVar.TabStringVisibleFlag
'
'left inside
.GFTabStringLine(6).BorderColor = &H80000010
.GFTabStringLine(6).X1 = (TabBoxXPos + TabBoxWidth ‑ 1) * Screen.TwipsPerPixelX
.GFTabStringLine(6).X2 = (TabBoxXPos + TabBoxWidth ‑ 1) * Screen.TwipsPerPixelX
.GFTabStringLine(6).Y1 = (TabBoxYPos + TabBoxHeight) * Screen.TwipsPerPixelY
.GFTabStringLine(6).Y2 = (TabBoxYPos) * Screen.TwipsPerPixelY
.GFTabStringLine(6).Visible = TabStringStructVar.TabStringVisibleFlag
'
'top left outside
.GFTabStringLine(7).BorderColor = &H80000014
.GFTabStringLine(7).X1 = (TabBoxXPos) * Screen.TwipsPerPixelX
.GFTabStringLine(7).X2 = (TabHeaderFocusedXStartPos) * Screen.TwipsPerPixelX
.GFTabStringLine(7).Y1 = (TabBoxYPos) * Screen.TwipsPerPixelY
.GFTabStringLine(7).Y2 = (TabBoxYPos) * Screen.TwipsPerPixelY
.GFTabStringLine(7).Visible = TabStringStructVar.TabStringVisibleFlag
'
'top left inside
.GFTabStringLine(8).BorderColor = &H80000016
.GFTabStringLine(8).X1 = (TabBoxXPos) * Screen.TwipsPerPixelX
.GFTabStringLine(8).X2 = (TabHeaderFocusedXStartPos) * Screen.TwipsPerPixelX
.GFTabStringLine(8).Y1 = (TabBoxYPos + 1) * Screen.TwipsPerPixelY
.GFTabStringLine(8).Y2 = (TabBoxYPos + 1) * Screen.TwipsPerPixelY
.GFTabStringLine(8).Visible = TabStringStructVar.TabStringVisibleFlag
'
'top right outside
.GFTabStringLine(9).BorderColor = &H80000014
.GFTabStringLine(9).X1 = (TabHeaderFocusedXEndPos) * Screen.TwipsPerPixelX
.GFTabStringLine(9).X2 = (TabBoxXPos + TabBoxWidth) * Screen.TwipsPerPixelX
.GFTabStringLine(9).Y1 = (TabBoxYPos) * Screen.TwipsPerPixelY
.GFTabStringLine(9).Y2 = (TabBoxYPos) * Screen.TwipsPerPixelY
.GFTabStringLine(9).Visible = TabStringStructVar.TabStringVisibleFlag
'
'top right inside
.GFTabStringLine(10).BorderColor = &H80000016
.GFTabStringLine(10).X1 = (TabHeaderFocusedXEndPos) * Screen.TwipsPerPixelX
.GFTabStringLine(10).X2 = (TabBoxXPos + TabBoxWidth ‑ 1) * Screen.TwipsPerPixelX
.GFTabStringLine(10).Y1 = (TabBoxYPos + 1) * Screen.TwipsPerPixelY
.GFTabStringLine(10).Y2 = (TabBoxYPos + 1) * Screen.TwipsPerPixelY
.GFTabStringLine(10).Visible = TabStringStructVar.TabStringVisibleFlag
'
End With
End Sub
Public Sub TabHeader_Select(ByVal TabHeaderIndex As Integer)
'On Error Resume Next
'verify
If TabHeaderIndex < 1 Then TabHeaderIndex = 1
If TabHeaderIndex > TabHeaderStructNumber Then TabHeaderIndex = TabHeaderStructNumber
'begin
If Not (TabStringStructVar.TabHeaderFocusedIndex = TabHeaderIndex) Then 'refresh if necessary only
TabStringStructVar.TabHeaderFocusedIndex = TabHeaderIndex
Call TabBox_Refresh 'refresh both header and box
Call TabHeader_Refresh
End If
End Sub
Public Sub TabHeader_Refresh(Optional ByVal RefreshTabHeaderTextOnlyFlag As Boolean = False, Optional ByVal EraseTabHeaderTextFlag As Boolean = True)
'On Error Resume Next 'draws all tab headers
Dim TabHeaderXPos As Long 'x pos of current header to draw
Dim TabHeaderLoop As Integer
Dim TabHeaderXStartPos As Long
Dim TabHeaderYPos As Long
Dim TabHeaderFocusedFlagInteger As Integer '1 (!) if current TabHeader is Focused, 0 if not
Dim TabHeaderBeforeFocusedFlag As Boolean 'True if current TabHeader is located before the Focused one, False if not
Dim TabHeaderAfterFocusedFlag As Boolean 'True if current TabHeader is located after the Focused one, False if not
Dim Temp As Long
Dim TempForeColor As Long
Dim TempFontStruct As FontStruct
'
'NOTE: RefreshTabHeaderTextOnlyFlag can be used to erase tab header text only
'when changing font (set Visible property temporarily to False).
'
'preset
TabHeaderXStartPos = TabStringStructVar.TabBoxXPos + 2 'when activated, TabHeader x size is increased by 4 pixels
TabHeaderYPos = TabStringStructVar.TabBoxYPos '‑ TabHeaderYSize 'bottom y pos
'
TempForeColor = TabStringStructVar.TabStringWindow.ForeColor
TempFontStruct.Name = TabStringStructVar.TabStringWindow.Font.Name
TempFontStruct.Size = TabStringStructVar.TabStringWindow.Font.Size
TempFontStruct.Bold = TabStringStructVar.TabStringWindow.Font.Bold
TempFontStruct.Italic = TabStringStructVar.TabStringWindow.Font.Italic
TempFontStruct.Underline = TabStringStructVar.TabStringWindow.Font.Underline
TempFontStruct.StrikeThrough = TabStringStructVar.TabStringWindow.Font.StrikeThrough
TabStringStructVar.TabStringWindow.ForeColor = TabStringStructVar.TabStringForeColor
TabStringStructVar.TabStringWindow.Font.Name = TabStringStructVar.TabStringFont.Name
TabStringStructVar.TabStringWindow.Font.Size = TabStringStructVar.TabStringFont.Size
TabStringStructVar.TabStringWindow.Font.Bold = TabStringStructVar.TabStringFont.Bold
TabStringStructVar.TabStringWindow.Font.Italic = TabStringStructVar.TabStringFont.Italic
TabStringStructVar.TabStringWindow.Font.Underline = TabStringStructVar.TabStringFont.Underline
TabStringStructVar.TabStringWindow.Font.StrikeThrough = TabStringStructVar.TabStringFont.StrikeThrough
'reset
If EraseTabHeaderTextFlag = True Then
TabStringStructVar.TabStringWindow.Cls
End If
'begin
TabHeaderXPos = TabHeaderXStartPos
'refresh (hide) all controls (avoid control 'salad' on slower computers)
If (RefreshTabHeaderTextOnlyFlag = False) And (TabStringStructVar.AutoControlChangeEnabledFlag = True) Then
For TabHeaderLoop = 1 To TabHeaderStructNumber
For Temp = 1 To TabHeaderStructArray(TabHeaderLoop).TabHeaderControlNumber
TabHeaderStructArray(TabHeaderLoop). _
TabHeaderControlArray(Temp).Visible = False
Next Temp
Next TabHeaderLoop
End If
'draw tab headers
For TabHeaderLoop = 1 To TabHeaderStructNumber
'
'refresh tab header width (could have changed if font was changed)
TabHeaderStructArray(TabHeaderLoop).TabHeaderWidth = ((TabStringStructVar.TabStringWindow.TextWidth(TabHeaderStructArray(TabHeaderLoop).TabHeaderText) / Screen.TwipsPerPixelX) + 14)
'
'NOTE: if the current TabHeader is Focused (was clicked),
'its size is increased and overlaps the bordering Tab Headers.
'The code must simulate this appearance by showing/hiding
'lines and changing its positions.
'
If TabHeaderLoop = TabStringStructVar.TabHeaderFocusedIndex Then
TabHeaderFocusedFlagInteger = 1
Else
TabHeaderFocusedFlagInteger = 0
End If
If TabHeaderLoop = (TabStringStructVar.TabHeaderFocusedIndex ‑ 1) Then
TabHeaderBeforeFocusedFlag = True
Else
TabHeaderBeforeFocusedFlag = False
End If
If TabHeaderLoop = (TabStringStructVar.TabHeaderFocusedIndex + 1) Then
TabHeaderAfterFocusedFlag = True
Else
TabHeaderAfterFocusedFlag = False
End If
'
'refresh header lines
If RefreshTabHeaderTextOnlyFlag = False Then
With TabStringStructVar.TabStringLineWindow
'left outside
If TabHeaderAfterFocusedFlag = True Then
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex).Visible = False
Else
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex).Visible = TabStringStructVar.TabStringVisibleFlag
End If
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex).BorderColor = &H80000014
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex).X1 = (TabHeaderXPos ‑ TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelX
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex).X2 = (TabHeaderXPos ‑ TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelX
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex).Y2 = (TabHeaderYPos + TabHeaderFocusedFlagInteger * 1) * Screen.TwipsPerPixelY
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex).Y1 = (TabHeaderYPos ‑ TabHeaderYSize + 2 ‑ TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelY
'
'left inside
If TabHeaderAfterFocusedFlag = True Then
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 1).Visible = False
Else
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 1).Visible = TabStringStructVar.TabStringVisibleFlag
End If
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 1).BorderColor = &H80000016
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 1).X1 = (TabHeaderXPos + 1 ‑ TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelX
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 1).X2 = (TabHeaderXPos + 1 ‑ TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelX
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 1).Y2 = (TabHeaderYPos + TabHeaderFocusedFlagInteger * 1) * Screen.TwipsPerPixelY
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 1).Y1 = (TabHeaderYPos ‑ TabHeaderYSize + 2 ‑ TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelY
'
'top outside
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 2).BorderColor = &H80000014
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 2).X1 = (TabHeaderXPos + 2 ‑ TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelX
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 2).X2 = (TabHeaderXPos + TabHeaderStructArray(TabHeaderLoop).TabHeaderWidth ‑ 1 + TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelX
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 2).Y1 = (TabHeaderYPos ‑ TabHeaderYSize ‑ TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelY
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 2).Y2 = (TabHeaderYPos ‑ TabHeaderYSize ‑ TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelY
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 2).Visible = TabStringStructVar.TabStringVisibleFlag
'
'top inside (point)
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 3).BorderColor = &H80000014
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 3).X1 = (TabHeaderXPos + 1 ‑ TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelX
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 3).X2 = (TabHeaderXPos + 2 ‑ TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelX
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 3).Y1 = (TabHeaderYPos ‑ TabHeaderYSize + 1 ‑ TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelY
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 3).Y2 = (TabHeaderYPos ‑ TabHeaderYSize + 1 ‑ TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelY
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 3).Visible = TabStringStructVar.TabStringVisibleFlag
'
'top inside
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 4).BorderColor = &H80000016
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 4).X1 = (TabHeaderXPos + 2 ‑ TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelX
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 4).X2 = (TabHeaderXPos + TabHeaderStructArray(TabHeaderLoop).TabHeaderWidth ‑ 1 + TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelX
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 4).Y1 = (TabHeaderYPos ‑ TabHeaderYSize + 1 ‑ TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelY
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 4).Y2 = (TabHeaderYPos ‑ TabHeaderYSize + 1 ‑ TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelY
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 4).Visible = TabStringStructVar.TabStringVisibleFlag
'
'right inside
If TabHeaderBeforeFocusedFlag = True Then
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 5).Visible = False
Else
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 5).Visible = TabStringStructVar.TabStringVisibleFlag
End If
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 5).BorderColor = &H80000010
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 5).X1 = (TabHeaderXPos + TabHeaderStructArray(TabHeaderLoop).TabHeaderWidth ‑ 1 + TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelX
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 5).X2 = (TabHeaderXPos + TabHeaderStructArray(TabHeaderLoop).TabHeaderWidth ‑ 1 + TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelX
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 5).Y1 = (TabHeaderYPos ‑ TabHeaderYSize + 2 ‑ TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelY
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 5).Y2 = (TabHeaderYPos + TabHeaderFocusedFlagInteger * 1) * Screen.TwipsPerPixelY
'
'right inside (point)
If TabHeaderBeforeFocusedFlag = True Then
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 6).Visible = False
Else
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 6).Visible = TabStringStructVar.TabStringVisibleFlag
End If
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 6).BorderColor = &H0
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 6).X1 = (TabHeaderXPos + TabHeaderStructArray(TabHeaderLoop).TabHeaderWidth ‑ 1 + TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelX
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 6).X2 = (TabHeaderXPos + TabHeaderStructArray(TabHeaderLoop).TabHeaderWidth ‑ 1 + TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelX
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 6).Y1 = (TabHeaderYPos ‑ TabHeaderYSize + 1 ‑ TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelY
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 6).Y2 = (TabHeaderYPos ‑ TabHeaderYSize + 2 ‑ TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelY
'
'right outside
If TabHeaderBeforeFocusedFlag = True Then
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 7).Visible = False
Else
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 7).Visible = TabStringStructVar.TabStringVisibleFlag
End If
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 7).BorderColor = &H0
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 7).X1 = (TabHeaderXPos + TabHeaderStructArray(TabHeaderLoop).TabHeaderWidth + TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelX
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 7).X2 = (TabHeaderXPos + TabHeaderStructArray(TabHeaderLoop).TabHeaderWidth + TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelX
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 7).Y1 = (TabHeaderYPos ‑ TabHeaderYSize + 2 ‑ TabHeaderFocusedFlagInteger * 2) * Screen.TwipsPerPixelY
.GFTabStringLine(TabHeaderStructArray(TabHeaderLoop).TabHeaderLineStartIndex + 7).Y2 = (TabHeaderYPos + TabHeaderFocusedFlagInteger * 1) * Screen.TwipsPerPixelY
'
End With
End If
'refresh tab header text
TabStringStructVar.TabStringWindow.AutoRedraw = True
' If EraseTabHeaderTextFlag = True Then
' 'erase tab header text at 'NOT'‑position
' TabStringStructVar.TabStringWindow.ForeColor = TabStringStructVar.TabStringWindow.BackColor
' TabStringStructVar.TabStringWindow.CurrentX = (TabHeaderXPos + 8) * Screen.TwipsPerPixelX
' TabStringStructVar.TabStringWindow.CurrentY = (TabHeaderYPos ‑ 16 ‑ (1 ‑ TabHeaderFocusedFlagInteger) * 2) * Screen.TwipsPerPixelY
' TabStringStructVar.TabStringWindow.Print TabHeaderStructArray(TabHeaderLoop).TabHeaderText
' End If
'print tab header text if tab string is visible
If TabStringStructVar.TabStringVisibleFlag = True Then
'print text
TabStringStructVar.TabStringWindow.ForeColor = TabStringStructVar.TabStringForeColor
TabStringStructVar.TabStringWindow.CurrentX = (TabHeaderXPos + 8) * Screen.TwipsPerPixelX
TabStringStructVar.TabStringWindow.CurrentY = (TabHeaderYPos ‑ 16 ‑ (0 + TabHeaderFocusedFlagInteger) * 2) * Screen.TwipsPerPixelY
TabStringStructVar.TabStringWindow.Print TabHeaderStructArray(TabHeaderLoop).TabHeaderText
Else
'erase text
TabStringStructVar.TabStringWindow.ForeColor = TabStringStructVar.TabStringWindow.BackColor
TabStringStructVar.TabStringWindow.CurrentX = (TabHeaderXPos + 8) * Screen.TwipsPerPixelX
TabStringStructVar.TabStringWindow.CurrentY = (TabHeaderYPos ‑ 16 ‑ (0 + TabHeaderFocusedFlagInteger) * 2) * Screen.TwipsPerPixelY
TabStringStructVar.TabStringWindow.Print TabHeaderStructArray(TabHeaderLoop).TabHeaderText
End If
'end
'
TabHeaderXPos = TabHeaderXPos + (TabHeaderStructArray(TabHeaderLoop).TabHeaderWidth + 1)
'
'refresh (show/hide) controls (show if tab string is enabled only)
If (RefreshTabHeaderTextOnlyFlag = False) And (TabStringStructVar.AutoControlChangeEnabledFlag = True) Then
For Temp = 1 To TabHeaderStructArray(TabHeaderLoop).TabHeaderControlNumber
If TabHeaderLoop = TabStringStructVar.TabHeaderFocusedIndex Then
'current tab header activated
If TabStringStructVar.TabStringVisibleFlag = True Then
TabHeaderStructArray(TabHeaderLoop). _
TabHeaderControlArray(Temp).Visible = True
Else
TabHeaderStructArray(TabHeaderLoop). _
TabHeaderControlArray(Temp).Visible = False
End If
Else
'current tab header not activated
TabHeaderStructArray(TabHeaderLoop). _
TabHeaderControlArray(Temp).Visible = False
End If
Next Temp
End If
Next TabHeaderLoop
'
TabStringStructVar.TabStringWindow.ForeColor = TempForeColor
TabStringStructVar.TabStringWindow.Font.Name = TempFontStruct.Name
TabStringStructVar.TabStringWindow.Font.Size = TempFontStruct.Size
TabStringStructVar.TabStringWindow.Font.Bold = TempFontStruct.Bold
TabStringStructVar.TabStringWindow.Font.Italic = TempFontStruct.Italic
TabStringStructVar.TabStringWindow.Font.Underline = TempFontStruct.Underline
TabStringStructVar.TabStringWindow.Font.StrikeThrough = TempFontStruct.StrikeThrough
End Sub
Public Function GetTabHeaderFocusedIndex() As Integer
'On Error Resume Next 'returns index of currently activated TabHeader
GetTabHeaderFocusedIndex = TabStringStructVar.TabHeaderFocusedIndex
End Function
Public Function GetTabHeaderFocusedText() As String
'On Error Resume Next 'returns text of currently activated TabHeader
GetTabHeaderFocusedText = TabHeaderStructArray(TabStringStructVar.TabHeaderFocusedIndex).TabHeaderText
End Function
Public Property Set AutoControlChange() As Boolean
'On Error Resume Next
AutoControlChange = TabStringStructVar.AutoControlChangeEnabledFlag
End Property
Public Property Let AutoControlChange(ByVal Flag As Boolean)
'On Error Resume Next
TabStringStructVar.AutoControlChangeEnabledFlag = Flag
End Property
Public Property Let Width(ByVal WidthNew As Long)
'On Error Resume Next 'format: twips
TabStringStructVar.TabBoxWidth = WidthNew / Screen.TwipsPerPixelX
Call TabBox_Refresh
Call TabHeader_Refresh
End Property
Public Property Set Width() As Long
'On Error Resume Next 'format: twips
Width = TabStringStructVar.TabBoxWidth * Screen.TwipsPerPixelX
End Property
Public Property Let Height(ByVal HeightNew As Long)
'On Error Resume Next 'format: twips
TabStringStructVar.TabBoxHeight = (HeightNew / Screen.TwipsPerPixelY) ‑ TabHeaderYSize
Call TabBox_Refresh
Call TabHeader_Refresh
End Property
Public Property Set Height() As Long
'On Error Resume Next 'format: twips
Height = (TabStringStructVar.TabBoxHeight + TabHeaderYSize) * Screen.TwipsPerPixelY
End Property
Public Property Let ForeColor(ByVal ForeColorPassed As Long)
'On Error Resume Next
TabStringStructVar.TabStringForeColor = ForeColorPassed
Call TabHeader_Refresh(True) 'text needs to be redrawn only
End Property
Public Property Set ForeColor() As Long
'On Error Resume Next
ForeColor = TabStringStructVar.TabStringForeColor
End Property
Public Sub SetFont(ByVal FontName As String, ByVal FontSize As Single, ByVal FontBoldFlag As Boolean, ByVal FontItalicFlag As Boolean, ByVal FontUnderlineFlag As Boolean, ByVal FontStrikeThroughFlag As Boolean)
'On Error Resume Next
Dim TabStringVisibleFlagUnchanged As Boolean
'preset
TabStringVisibleFlagUnchanged = Me.Visible
Me.Visible = False
Call TabHeader_Refresh(True) 'use old font when erasing header description
'begin
TabStringStructVar.TabStringFont.Name = FontName
TabStringStructVar.TabStringFont.Size = FontSize
TabStringStructVar.TabStringFont.Bold = FontBoldFlag
TabStringStructVar.TabStringFont.Italic = FontItalicFlag
TabStringStructVar.TabStringFont.Underline = FontUnderlineFlag
TabStringStructVar.TabStringFont.StrikeThrough = FontStrikeThroughFlag
'
Me.Visible = TabStringVisibleFlagUnchanged
Call TabHeader_Refresh(True) 'use new font when printing header description
Call TabBox_Refresh 'make fit to changed header size
'
End Sub
Public Property Set TabHeaderFocusedIndex() As Integer
'On Error Resume Next 'returns index of tab header that is currently selected
TabHeaderFocusedIndex = TabStringStructVar.TabHeaderFocusedIndex
End Property
Public Property Let Visible(ByVal VisibleFlag As Boolean)
'On Error Resume Next
Dim RedrawFlag As Boolean
'preset
If Not (TabStringStructVar.TabStringVisibleFlag = VisibleFlag) Then RedrawFlag = True
'begin
TabStringStructVar.TabStringVisibleFlag = VisibleFlag
If RedrawFlag = True Then
'the visible property has been changed, redraw whole tab string
Call TabBox_Refresh 'will hide tab string box if necessary
Call TabHeader_Refresh 'will hide tab string header and all controls if necessary
End If
End Property
Public Property Set Visible() As Boolean
'On Error Resume Next
Visible = TabStringStructVar.TabStringVisibleFlag
End Property
Public Property Set Enabled()
'On Error Resume Next 'write protected (changing this property is not supported yet)
Enabled = True
End Property
'***END OF INTERFACE SUBS***
[END OF FILE]