ctltabs.pag

这个是我以前做的一个客户管理系统.包内已经含有源码和所用到的控件.代码是用VB写的,数据库采用MSSQL的.

VERSION 5.00
Begin VB.PropertyPage propTabCaptions 
   AutoRedraw      =   -1  'True
   Caption         =   "Tab Captions"
   ClientHeight    =   3630
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   5700
   LockControls    =   -1  'True
   PaletteMode     =   0  'Halftone
   ScaleHeight     =   3630
   ScaleWidth      =   5700
   Begin VB.CommandButton cmd 
      Caption         =   "Add"
      Height          =   330
      Index           =   2
      Left            =   90
      TabIndex        =   5
      TabStop         =   0   'False
      Top             =   2655
      Width           =   735
   End
   Begin VB.TextBox txtCaption 
      Height          =   315
      Left            =   90
      TabIndex        =   1
      Top             =   370
      Width           =   3030
   End
   Begin VB.ListBox cmbCaptions 
      Height          =   1680
      Left            =   90
      TabIndex        =   0
      Tag             =   "GapGridCol"
      Top             =   765
      Width           =   3030
   End
   Begin VB.CommandButton cmd 
      Caption         =   "Up"
      Height          =   330
      Index           =   1
      Left            =   2400
      TabIndex        =   3
      TabStop         =   0   'False
      ToolTipText     =   "Up"
      Top             =   2655
      Width           =   735
   End
   Begin VB.CommandButton cmd 
      Caption         =   "Down"
      Height          =   330
      Index           =   0
      Left            =   2400
      TabIndex        =   4
      TabStop         =   0   'False
      ToolTipText     =   "Down"
      Top             =   3000
      Width           =   735
   End
   Begin VB.CommandButton cmd 
      Caption         =   "Delete"
      Height          =   330
      Index           =   3
      Left            =   90
      TabIndex        =   6
      TabStop         =   0   'False
      Top             =   3000
      Width           =   735
   End
   Begin VB.Label lblCaption 
      Caption         =   "Caption:"
      Height          =   240
      Left            =   90
      TabIndex        =   2
      Top             =   120
      Width           =   2700
   End
End
Attribute VB_Name = "propTabCaptions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Dim tSettingUp As Boolean   'True=applying code changes, False=accepting user input

Private Sub cmbCaptions_Click()
    tSettingUp = True
    txtCaption.Text = cmbCaptions.Text
    txtCaption.SelStart = 0
    txtCaption.SelLength = Len(txtCaption.Text)
    tSettingUp = False
End Sub

Private Sub cmd_Click(Index As Integer)
    Dim t1 As Long, tmp$
    
    With cmbCaptions
        Select Case Index
        Case 0      'Down
            If .ListIndex < .ListCount - 1 Then
                tmp = .List(.ListIndex)
                .List(.ListIndex) = .List(.ListIndex + 1)
                .List(.ListIndex + 1) = tmp
                .ListIndex = .ListIndex + 1
                Changed = True
            End If
        
        Case 1  'Up
            If .ListIndex > 0 Then
                tmp = .List(.ListIndex)
                .List(.ListIndex) = .List(.ListIndex - 1)
                .List(.ListIndex - 1) = tmp
                .ListIndex = .ListIndex - 1
                Changed = True
            End If
                
        Case 2      'Add
            .AddItem "", .ListIndex + 1
            .ListIndex = .ListIndex + 1
            Changed = True
        
        Case 3      'Delete
            If .ListCount > 1 Then
                t1 = .ListIndex
                .RemoveItem .ListIndex
                .ListIndex = IIf(t1 >= .ListCount, .ListCount - 1, t1)
                cmbCaptions_Click
                Changed = True
            End If
        End Select
    End With
End Sub

Private Sub txtCaption_Change()
    If Not tSettingUp Then
        cmbCaptions.List(cmbCaptions.ListIndex) = txtCaption.Text
        Changed = True
    End If
End Sub


Private Sub PropertyPage_ApplyChanges()
    Dim t1 As Integer
    With SelectedControls(0)
        .Tabs = cmbCaptions.ListCount
        For t1 = 1 To .Tabs
            .Caption(t1) = cmbCaptions.List(t1 - 1)
        Next t1
    End With
End Sub



Private Sub PropertyPage_SelectionChanged()
    Dim t1 As Integer
    tSettingUp = True
    With SelectedControls(0)
        cmbCaptions.Clear
        For t1 = 1 To .Tabs
            cmbCaptions.AddItem .Caption(t1)
        Next t1
        cmbCaptions.ListIndex = 0
        cmbCaptions_Click
    End With
    tSettingUp = False
    Refresh
End Sub