⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 数据库_通用f2.frm

📁 <VB数理统计实用算法>书中的算法源程序
💻 FRM
字号:
VERSION 5.00
Begin VB.Form frmField 
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   Caption         =   "字段"
   ClientHeight    =   3900
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6435
   LinkTopic       =   "Form1"
   ScaleHeight     =   3900
   ScaleWidth      =   6435
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取    消"
      Height          =   375
      Left            =   4800
      TabIndex        =   11
      Top             =   3360
      Width           =   1455
   End
   Begin VB.ListBox lstFDName 
      Appearance      =   0  'Flat
      Height          =   2364
      Left            =   120
      TabIndex        =   10
      Top             =   360
      Width           =   2295
   End
   Begin VB.CommandButton cmdDelField 
      Caption         =   "删除字段"
      Height          =   375
      Left            =   240
      TabIndex        =   8
      Top             =   3360
      Width           =   1455
   End
   Begin VB.CommandButton cmdAddEnd 
      Caption         =   "完    成"
      Height          =   375
      Left            =   3240
      TabIndex        =   7
      Top             =   3360
      Width           =   1455
   End
   Begin VB.CommandButton cmdAddField 
      Caption         =   "添加字段"
      Height          =   375
      Left            =   1800
      TabIndex        =   6
      Top             =   3360
      Width           =   1335
   End
   Begin VB.TextBox txtFieldSize 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      Height          =   264
      Left            =   4080
      TabIndex        =   5
      Text            =   "Text2"
      Top             =   3000
      Width           =   2175
   End
   Begin VB.ListBox lstFieldType 
      Appearance      =   0  'Flat
      Height          =   2010
      Left            =   4080
      TabIndex        =   3
      Top             =   840
      Width           =   2175
   End
   Begin VB.TextBox txtFieldName 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      Height          =   264
      Left            =   4080
      TabIndex        =   1
      Text            =   "Text1"
      Top             =   480
      Width           =   2175
   End
   Begin VB.Label lblAdd 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "完成下面所提示的工作再单击“添加字段”"
      ForeColor       =   &H80000008&
      Height          =   252
      Left            =   2880
      TabIndex        =   13
      Top             =   120
      Width           =   3612
   End
   Begin VB.Label lblDel 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "单击“删除字段”,可将选中字段删除"
      ForeColor       =   &H80000008&
      Height          =   492
      Left            =   120
      TabIndex        =   12
      Top             =   2880
      Width           =   2412
   End
   Begin VB.Label lblFDName 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "选择数据表所包括的字段:"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   120
      TabIndex        =   9
      Top             =   120
      Width           =   2295
   End
   Begin VB.Label lblFieldSize 
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "给出字段大小"
      ForeColor       =   &H80000008&
      Height          =   375
      Left            =   2760
      TabIndex        =   4
      Top             =   3000
      Width           =   1215
   End
   Begin VB.Label lblFieldType 
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "选择字段类型"
      ForeColor       =   &H80000008&
      Height          =   495
      Left            =   2640
      TabIndex        =   2
      Top             =   840
      Width           =   1335
   End
   Begin VB.Label lblFieldName 
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "键入字段名"
      ForeColor       =   &H80000008&
      Height          =   375
      Left            =   2880
      TabIndex        =   0
      Top             =   480
      Width           =   1095
   End
End
Attribute VB_Name = "frmField"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'窗体frmField
'字段处理
Option Explicit
Dim strFDName As String             '保存字段名字
Dim strFDType As String             '保存字段类型
Dim strTextSize As String           '保存文本字段大小
Dim msgResult As VbMsgBoxResult     '保存信息框选择结果
Dim intIndex As Integer             '保存选中类型的索引号

Private Sub Form_Load()
'初始化
    strFDName = ""
    strFDType = ""
    strTextSize = ""
    txtFieldName.Text = ""
    txtFieldSize.Text = ""
    lblFieldSize.Visible = False
    txtFieldSize.Visible = False
'往列表框添加字段类型
    With lstFieldType
        .AddItem "dbText"
        .AddItem "dbInteger"
        .AddItem "dbLong"
        .AddItem "dbSingle"
        .AddItem "dbDouble"
        .AddItem "dbDate"
        .AddItem "dbBinary"
        .AddItem "dbBoolean"
        .AddItem "dbByte"
        .AddItem "dbCurrency"
        .AddItem "dbFloat"
        .AddItem "dbMemo"
        .AddItem "dbNumeric"
    End With
    lblFDName = td.Name & "所包括的字段:"
'在列表框显示字段
    For Each fd In td.Fields
        lstFDName.AddItem fd.Name
    Next
End Sub

'删除字段
Private Sub cmdDelField_Click()
    td.Fields.Delete (lstFDName)
    lblFDName = td.Name & "所包括的字段:"
'在列表框显示字段
    lstFDName.Clear                 '清除列表框
    For Each fd In td.Fields
        lstFDName.AddItem fd.Name
    Next
End Sub

'单击字段类型列表框事件
Private Sub lstFieldType_Click()
'如果字段类型是文本,需要字段大小
'为键入文本字段大小创造条件
    If lstFieldType.Text = "dbText" Then
        lblFieldSize.Visible = True     '使指示标签可视
        txtFieldSize.Visible = True     '使存贮文本大小的文本框可视
    End If
    intIndex = lstFieldType.ListIndex   '取得选中类型的索引号
End Sub

'添加字段
Private Sub cmdAddField_Click()
    strFDName = txtFieldName.Text
    strTextSize = txtFieldSize.Text
    If strFDName = "" Then
        MsgBox "没有给出字段名,重作", 0, "添加字段"
        Exit Sub
    End If
    strFDType = lstFieldType.Text   '从列表框取得字段类型
    If strFDType = "" Then
        MsgBox "没有选择类型,重作", 0, "添加字段"
        Exit Sub
    End If
    If strFDType = "dbText" And strTextSize = "" Then
        MsgBox "没有给出文本大小,重作", 0, "添加字段"
        Exit Sub
    End If
'按类型来建立字段
    Select Case strFDType
        Case "dbText"
            Set fd = td.CreateField(strFDName, dbText, Val(strTextSize))
        Case "dbInteger"
            Set fd = td.CreateField(strFDName, dbInteger)
        Case "dbLong"
            Set fd = td.CreateField(strFDName, dbLong)
        Case "dbSingle"
            Set fd = td.CreateField(strFDName, dbSingle)
        Case "dbDouble"
            Set fd = td.CreateField(strFDName, dbDouble)
        Case "dbDate"
            Set fd = td.CreateField(strFDName, dbDate)
        Case "dbBinary"
            Set fd = td.CreateField(strFDName, dbBinary)
        Case "dbBoolean"
            Set fd = td.CreateField(strFDName, dbBoolean)
        Case "dbByte"
            Set fd = td.CreateField(strFDName, dbByte)
        Case "dbCurrency"
            Set fd = td.CreateField(strFDName, dbCurrency)
        Case "dbFloat"
            Set fd = td.CreateField(strFDName, dbFloat)
        Case "dbMemo"
            Set fd = td.CreateField(strFDName, dbMemo)
        Case "dbNumeric"
            Set fd = td.CreateField(strFDName, dbNumeric)
        Case Else
            Set fd = td.CreateField(strFDName, dbText, 20)
    End Select
'添加字段到数据表
    td.Fields.Append fd
    lstFDName.Clear             '清除列表框
    lblFDName = td.Name & "所包括的字段:"
    For Each fd In td.Fields
        lstFDName.AddItem fd.Name
    Next
'准备接受下一个字段
    txtFieldName.Text = ""
    strFDName = ""
    strFDType = ""
    strTextSize = ""
    lstFieldType.Selected(intIndex) = False '清除选中类型的选中状态
    lblFieldSize.Visible = False
    txtFieldSize.Visible = False
End Sub

'完成
Private Sub cmdAddEnd_Click()
    On Error Resume Next
    db.TableDefs.Append td      '添加数据表到数据库
    Unload Me                   '卸载字段窗体
    Load frmDatabase            '加载数据库窗体
    frmDatabase.lblPoint.Visible = True
    frmDatabase.lblPoint.Caption = _
        "提示:完成字段操作,可以转入“索引”或“记录集”操作"
    frmDatabase.Line1.Visible = True
    frmDatabase.Visible = True  '使数据库窗体可视
End Sub

'取消
Private Sub cmdCancel_Click()
    Unload Me                   '卸载字段窗体
    Load frmDatabase            '加载数据库窗体
    frmDatabase.Visible = True  '使数据库窗体可视
    frmDatabase.lblPoint.Visible = True
    frmDatabase.lblPoint.Caption = _
        "提示:取消字段操作,可以考虑重新开始"
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -