📄 tblstru.frm
字号:
VERSION 5.00
Begin VB.Form frmTblStruct
BorderStyle = 1 'Fixed Single
Caption = "表结构"
ClientHeight = 3630
ClientLeft = 3420
ClientTop = 3105
ClientWidth = 4680
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
HelpContextID = 2016147
Icon = "tblstru.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 3630
ScaleWidth = 4680
Begin VB.CommandButton cmdadd
Caption = "添加(&T)"
Default = -1 'True
Enabled = 0 'False
Height = 375
Left = 1695
MaskColor = &H00000000&
TabIndex = 9
ToolTipText = "用于选定课首次输入成绩"
Top = 2775
Width = 1455
End
Begin VB.ComboBox Combo1
Height = 330
ItemData = "tblstru.frx":0442
Left = 3360
List = "tblstru.frx":0467
TabIndex = 8
Top = 2160
Width = 1215
End
Begin VB.ComboBox cboFieldType
Height = 330
ItemData = "tblstru.frx":048D
Left = 3360
List = "tblstru.frx":048F
Style = 2 'Dropdown List
TabIndex = 7
Top = 1680
Width = 1215
End
Begin VB.CommandButton comovfld
Caption = "删除(&S)"
Height = 375
Left = 3150
TabIndex = 6
ToolTipText = "删除选定课和其下包含的成绩"
Top = 2790
Width = 1455
End
Begin VB.CommandButton Cmdputin
Caption = "录入(&S)"
Height = 375
HelpContextID = 2016147
Left = 1710
MaskColor = &H8000000F&
TabIndex = 2
ToolTipText = "修改选定课的成绩或基本表内的人名"
Top = 3150
UseMaskColor = -1 'True
Width = 1455
End
Begin VB.CommandButton cmdexit
Caption = "关闭(&C)"
Height = 375
Left = 3150
MaskColor = &H8000000F&
TabIndex = 3
Top = 3150
UseMaskColor = -1 'True
Width = 1455
End
Begin VB.ListBox lstFields
BackColor = &H00C0E0FF&
Height = 1950
Left = 150
TabIndex = 1
Top = 1320
Width = 1455
End
Begin VB.TextBox txtTableName
BackColor = &H00C0E0FF&
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 1590
TabIndex = 0
Top = 60
Width = 2895
End
Begin VB.Frame Frame1
Caption = "统计信息:"
Height = 2055
Left = 1680
TabIndex = 10
Top = 630
Width = 2895
Begin VB.ComboBox txtfieldName
Height = 330
ItemData = "tblstru.frx":0491
Left = 1350
List = "tblstru.frx":04B0
TabIndex = 16
Text = " "
Top = 375
Width = 1335
End
Begin VB.OptionButton OpFU
Caption = "副科"
Height = 210
Left = 2040
TabIndex = 15
Top = 780
Width = 1215
End
Begin VB.OptionButton OpZU
Caption = "主科"
Height = 255
Left = 960
TabIndex = 14
Top = 780
Width = 1215
End
Begin VB.Label lblLabels
AutoSize = -1 'True
Caption = "课时/周:"
Height = 210
Index = 2
Left = 240
TabIndex = 13
Top = 1560
Width = 930
End
Begin VB.Label lblLabels
AutoSize = -1 'True
Caption = "分值类型："
Height = 210
Index = 5
Left = 180
TabIndex = 12
Top = 1140
Width = 1140
End
Begin VB.Label lblLabels
AutoSize = -1 'True
Caption = "当前科目："
Height = 210
Index = 4
Left = 180
TabIndex = 11
Top = 420
Width = 1140
End
End
Begin VB.Label lblLabels
AutoSize = -1 'True
Caption = "现有科目："
Height = 210
Index = 1
Left = 210
TabIndex = 5
Top = 810
Width = 1140
End
Begin VB.Label lblLabels
AutoSize = -1 'True
Caption = " 表名称： "
Height = 210
Index = 0
Left = 0
TabIndex = 4
Top = 150
Width = 1395
End
End
Attribute VB_Name = "frmTblStruct"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim xuhao As Integer
Dim xuhao2 As String
Private Sub cmdputin_Click()
On Error GoTo so '此陷阱为原来cmdaddtable所留
If lstFields.SelCount = 0 Or Len(Trim(txtfieldName.Text)) < 1 Then
Beep
MsgBox "先单击现有课程列表，选定目标！"
Exit Sub
End If
If ObjectExists(scoretab.Fields, txtfieldName.Text) Then
FrmPutIn.Show
If Worktype = 12 Then _
Unload FrmPutIn
Else
Beep
MsgBox "请选择“添加课程”按钮！"
End If
Exit Sub
so:
If Err.Number = 3367 Then '此陷阱为原来cmdaddtable所留
Resume Next
Else
Beep
MsgBox "操作有误，请重来！"
End If
End Sub
Private Sub CmdExit_Click()
MSG = "真的要退出？请再确认！"
style = vbDefaultButton1 + vbInformation + vbYesNo
If MsgBox(MSG, style, TiShi) = vbYes Then
If Worktype = 2 Then
dbname.Close
End If
Unload Me
End If
End Sub
Private Sub comovfld_Click() '待定
MSG7 = "所有学生该门课成绩将删除，继续吗？"
On Error GoTo RFErr
If lstFields.SelCount = 0 Then
Dim l As Single
l = Me.Left
l = Me.Top
Beep
MsgBox "先单击现有课程列表，选定目标！"
Exit Sub
End If
If lstFields.ListIndex < 0 Then Exit Sub
If MsgBox(MSG7, vbYesNo + vbQuestion) = vbYes Then
'清除字段属性值
txtfieldName.Text = vbNullString
'cboFieldType.Text = vbNullString
' txtDefaultValue.Text = vbNullString
' chkRequired.Value = vbUnchecked
' chkAllowZeroLen.Value = vbUnchecked
'从表定义结构中删除
scoretab.Fields.Delete lstFields.Text
'从列表中删除
lstFields.RemoveItem lstFields.ListIndex
End If
If lstFields.ListCount = 0 Then
'没有字段，所以关闭生成（build）按钮
cmdAddTable.Enabled = False
End If
Exit Sub
RFErr:
Beep
MsgBox "操作有误，请重来！"
End Sub
Private Sub Form_Unload(Cancel As Integer)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -