📄 typedata1.frm
字号:
VERSION 5.00
Begin VB.Form typedata1
Appearance = 0 'Flat
BackColor = &H00FFC0C0&
Caption = "type data"
ClientHeight = 5910
ClientLeft = 645
ClientTop = 1890
ClientWidth = 8475
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
LinkTopic = "Form2"
PaletteMode = 1 'UseZOrder
ScaleHeight = 5910
ScaleWidth = 8475
Begin VB.CommandButton Command5
Caption = "数据修改"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2880
TabIndex = 10
Top = 1080
Width = 1935
End
Begin VB.CommandButton Command4
Caption = "删除记录"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2880
TabIndex = 9
Top = 1680
Width = 1935
End
Begin VB.CommandButton Command3
Caption = "返回主菜单"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2880
TabIndex = 6
Top = 2880
Width = 1935
End
Begin VB.PictureBox Picture1
BackColor = &H00FFFFFF&
BeginProperty Font
Name = "楷体_GB2312"
Size = 9.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1575
Left = 480
ScaleHeight = 1515
ScaleWidth = 7275
TabIndex = 5
Top = 3720
Width = 7335
End
Begin VB.ListBox List1
BackColor = &H00FFFFFF&
Height = 2595
ItemData = "TYPEDATA1.frx":0000
Left = 480
List = "TYPEDATA1.frx":0002
MultiSelect = 2 'Extended
TabIndex = 2
Top = 600
Width = 1935
End
Begin VB.CommandButton Command2
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "返回库"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2880
TabIndex = 1
Top = 2280
Width = 1935
End
Begin VB.CommandButton Command1
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "确认"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2880
TabIndex = 0
Top = 480
Width = 1935
End
Begin VB.Label Label4
BackColor = &H00FFC0C0&
Caption = "建议"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 120
TabIndex = 8
Top = 3240
Width = 1095
End
Begin VB.Label Label3
BackColor = &H00FFC0C0&
Caption = "判断"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1455
Left = 5280
TabIndex = 7
Top = 840
Width = 495
End
Begin VB.Label Label2
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "楷体_GB2312"
Size = 9.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2895
Left = 6000
TabIndex = 4
Top = 120
Width = 1815
End
Begin VB.Label Label1
BackColor = &H00FFC0C0&
Caption = "选择人后确认"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 3
Top = 120
Width = 2295
End
End
Attribute VB_Name = "typedata1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim db As Database
Dim record As Recordset
Dim custernum As Integer
Dim custername As String
Private Sub Command2_Click()
Unload typedata1
Databox1.Show
End Sub
Private Sub Command1_Click()
Label2.Caption = ""
Picture1.Cls
Set db = OpenDatabase(datapath)
see = "select * from custerms where custername like '" & List1.Text & "'"
Set record = db.OpenRecordset(see)
custernum = record("custernum")
custername = record("custername")
sex = record("sex")
age = record("age")
mentalcondition = record("mentalcondition")
heridity = record("heridity")
smoking = record("smoking")
weight = record("weight")
bloodpressure = record("bloodpressure")
foods = record("foods")
phsicalexercise = record("phsicalexercise")
db.Close
t = 0
t = t + sex
t = t + age
t = t + mentalcondition
t = t + heridity
t = t + smoking
t = t + weight
t = t + bloodpressure
t = t + foods
t = t + phsicalexercise
If (t <= 10) Then
cases = "你是一个中等偏下的学生。"
GoTo loop2
End If
If (t <= 15) Then
cases = "你是一个中等偏上的学生。"
GoTo loop2
End If
If (t <= 20) Then
cases = "你是一个良好的学生。"
GoTo loop2
End If
cases = "你是一个优秀的学生。"
loop2:
Label2.FontSize = 12
Label2.Caption = cases
If (mentalcondition = 1) Then advice1 = "多与人沟通"
If (smoking < 2) Then advice2 = "戒烟．"
If (weight < 2) Then advice3 = "认真做好上课安排,按老师的要求做．"
If (bloodpressure <= 1) Then advice4 = "请多参加集体活动,加强锻炼．"
If (foods < 2) Then advice5 = "放松心情,调整心态．"
' (phsicalexercise = 1) Then advice6 = "加强锻炼．"
Picture1.FontSize = 12
Picture1.Print advice1; advice2; advice3
Picture1.Print advice4; advice5;
End Sub
Private Sub Command3_Click()
Unload typedata1
formcover1.Show
End Sub
Private Sub Command4_Click()
MsgBox ("是否真的要将此记录从数据库中删除?")
Set db = OpenDatabase(datapath) '将病历库中选定的记录删除
If MsgBox("是否真的要将此记录从数据库中删除?", 1 + 32, "删除") = 1 Then
db.Execute "delete *from custerms where custername like '" & List1.Text & "'"
MsgBox "此记录已被删除!"
End If
db.Close
List1.clear '清除用户记录
Set db = OpenDatabase(datapath) '显示刷新后用户记录
see = "select * from custerms "
Set record = db.OpenRecordset(see)
record.MoveFirst
Do While Not record.EOF
List1.AddItem record("custername")
record.MoveNext
Loop
db.Close
End Sub
Private Sub Command5_Click()
MsgBox ("是否真的要将此字段从数据库中修改?")
Set db = OpenDatabase(datapath) '将病历库中选定的记录删除
Set db = OpenDatabase(datapath) '更改病历库中选定记录的用户姓名
If MsgBox("是否真的要将此字段从数据库中修改?", 1 + 32, "修改") = 1 Then
strnew = InputBox("请输入正确姓名！", "提示", "")
db.Execute "update custerms set custername='" & (strnew) & "' where custername= '" & List1.Text & "'"
MsgBox "此记录已被修改!"
End If
db.Close
List1.clear '清除用户记录
Set db = OpenDatabase(datapath) '显示刷新后用户记录
see = "select * from custerms "
Set record = db.OpenRecordset(see)
record.MoveFirst
Do While Not record.EOF
List1.AddItem record("custername")
record.MoveNext
Loop
db.Close
End Sub
Private Sub Form_Load()
Label2.Caption = ""
Picture1.Cls
typedata1.ForeColor = &HC000C0
typedata1.ForeColor = &H0
Set db = OpenDatabase(datapath)
see = "select * from custerms "
Set record = db.OpenRecordset(see)
record.MoveFirst
Do While Not record.EOF
List1.AddItem record("custername")
record.MoveNext
Loop
db.Close
' Set db = OpenDatabase(datapath)'将病历库中选定的记录删除
' If MsgBox("是否真的要将此记录从数据库中删除?", 1 + 32, "删除") = 1 Then
' db.Execute "delete *from custerms where custername like '" & List1.Text & "'"
' MsgBox "此记录已被删除!"
' End If
' db.Close
' Set db = OpenDatabase(datapath)'更改病历库中选定记录的用户姓名
' If MsgBox("是否真的要将此字段从数据库中修改?", 1 + 32, "修改") = 1 Then
' strnew = InputBox("请输入正确姓名！", "提示", "")
' db.Execute "update custerms set custername='" & (strnew) & "' where custername= '" & List1.Text & "'"
' MsgBox "此记录已被修改!"
' End If
'db.Close
'List1.clear '清除用户记录
'Set db = OpenDatabase(datapath)'显示刷新后用户记录
' see = "select * from custerms "
' Set record = db.OpenRecordset(see)
' record.MoveFirst
' Do While Not record.EOF
' List1.AddItem record("custername")
' record.MoveNext
' Loop
' db.Close
End Sub
Private Sub list1_DblClick()
Label2.Caption = ""
Picture1.Cls
Set db = OpenDatabase(datapath)
Set record = db.OpenRecordset("custerms")
record.MoveFirst
Do While Not record.EOF
If List1.Text = record("custername") Then Exit Do
record.MoveNext
Loop
custernum = record("custernum")
custername = record("custername")
sex = record("sex")
age = record("age")
mentalcondition = record("mentalcondition")
heridity = record("heridity")
smoking = record("smoking")
weight = record("weight")
bloodpressure = record("bloodpressure")
foods = record("foods")
phsicalexercise = record("phsicalexercise")
db.Close
t = 0
t = t + sex
t = t + age
t = t + mentalcondition
t = t + heridity
t = t + smoking
t = t + weight
t = t + bloodpressure
t = t + foods
t = t + phsicalexercise
If (t <= 10) Then
cases = "你是一个中等偏下的学生。"
GoTo loop2
End If
If (t <= 15) Then
cases = "你是一个中等偏上的学生。"
GoTo loop2
End If
If (t <= 20) Then
cases = "你是一个良好的学生。"
GoTo loop2
End If
cases = "你是一个优秀的学生。"
loop2:
Label13.FontSize = 12
Label13.Caption = cases
If (mentalcondition = 1) Then advice1 = "多与人沟通"
If (smoking < 2) Then advice2 = "戒烟．"
If (weight < 2) Then advice3 = "认真做好上课安排,按老师的要求做．"
If (bloodpressure <= 1) Then advice4 = "请多参加集体活动,加强锻炼．"
If (foods < 2) Then advice5 = "放松心情,调整心态．"
Picture1.FontSize = 12
Picture1.Print advice1; advice2; advice3
Picture1.Print advice4; advice5;
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -