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