www.pudn.com > Super_richBoxall.zip > frmTabs.frm
VERSION 5.00
Begin VB.Form frmTabs
BorderStyle = 3 'Fixed Dialog
Caption = "Tabs"
ClientHeight = 2745
ClientLeft = 4845
ClientTop = 4590
ClientWidth = 4155
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmTabs.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2745
ScaleWidth = 4155
ShowInTaskbar = 0 'False
Begin VB.CommandButton cmdDelete
Caption = "&Delete"
Height = 375
Left = 1440
TabIndex = 6
Top = 2280
Width = 1275
End
Begin VB.CommandButton cmdSet
Caption = "&Set"
Height = 375
Left = 120
TabIndex = 5
Top = 2280
Width = 1275
End
Begin VB.ListBox lstTabs
Height = 1425
Left = 120
TabIndex = 4
Top = 780
Width = 2595
End
Begin VB.TextBox txtSize
Height = 315
Left = 120
TabIndex = 2
Top = 300
Width = 2595
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "Cancel"
Height = 375
Left = 2820
TabIndex = 1
Top = 480
Width = 1275
End
Begin VB.CommandButton cmdOK
Caption = "OK"
Default = -1 'True
Height = 375
Left = 2820
TabIndex = 0
Top = 60
Width = 1275
End
Begin VB.Label lblSize
Caption = "Tab Size"
Height = 195
Left = 120
TabIndex = 3
Top = 60
Width = 2535
End
End
Attribute VB_Name = "frmTabs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_lTabCount As Long
Private m_lWidths() As Long
Private m_bLoaded As Boolean
Private m_bCancel As Boolean
Public Property Get Cancelled() As Boolean
Cancelled = m_bCancel
End Property
Public Property Get TabCount() As Long
TabCount = m_lTabCount
End Property
Public Property Get TabWidth(ByVal iIndex As Long) As Long
TabWidth = m_lWidths(iIndex)
End Property
Public Sub AddTab(ByVal lWidth As Long)
m_lTabCount = m_lTabCount + 1
ReDim Preserve m_lWidths(1 To m_lTabCount) As Long
m_lWidths(m_lTabCount) = lWidth
ShowTabs
End Sub
Private Sub ShowTabs()
Dim i As Long
Dim sValue As Single
Dim lCurrent As Long
If (m_bLoaded) Then
On Error Resume Next
sValue = CSng(txtSize.Text)
lCurrent = sValue * 1440
On Error GoTo 0
lstTabs.Clear
lstTabs.AddItem ""
For i = 1 To m_lTabCount
sValue = m_lWidths(i) / 1440#
lstTabs.AddItem sValue
If (m_lWidths(i) = lCurrent) Then
lstTabs.ListIndex = lstTabs.NewIndex
End If
lstTabs.ItemData(lstTabs.NewIndex) = i
Next i
End If
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdDelete_Click()
Dim i As Long
Dim lIndex As Long
If lstTabs.ListIndex <> -1 Then
lIndex = lstTabs.ItemData(lstTabs.ListIndex)
If (m_lTabCount = 1) Then
m_lTabCount = 0
Erase m_lWidths
ShowTabs
Else
For i = lIndex + 1 To m_lTabCount
m_lWidths(i - 1) = m_lWidths(i)
Next i
m_lTabCount = m_lTabCount - 1
ReDim Preserve m_lWidths(1 To m_lTabCount) As Long
End If
ShowTabs
End If
End Sub
Private Sub cmdOK_Click()
m_bCancel = False
Unload Me
End Sub
Private Sub cmdSet_Click()
Dim lCurrent As Long
Dim sValue As Single
On Error Resume Next
sValue = CSng(txtSize.Text)
If (Err.Number = 0) Then
lCurrent = sValue * 1440
If (lstTabs.ListIndex < 1) Then
' New
AddTab lCurrent
Else
' Existing
m_lWidths(lstTabs.ItemData(lstTabs.ListIndex)) = lCurrent
End If
ShowTabs
Else
MsgBox "Please enter a tab size in inches.", vbInformation
txtSize.SetFocus
End If
End Sub
Private Sub Form_Load()
m_bLoaded = True
m_bCancel = True
ShowTabs
End Sub
Private Sub lstTabs_Click()
If (lstTabs.ListIndex > 0) Then
txtSize.Text = lstTabs.List(lstTabs.ListIndex)
End If
End Sub