📄 system.frm
字号:
VERSION 5.00
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Object = "{65E121D4-0C60-11D2-A9FC-0000F8754DA1}#2.0#0"; "mschrt20.ocx"
Begin VB.Form system
Caption = "system"
ClientHeight = 4755
ClientLeft = 1635
ClientTop = 1470
ClientWidth = 7275
LinkTopic = "Form1"
OLEDropMode = 1 'Manual
PaletteMode = 1 'UseZOrder
ScaleHeight = 237.75
ScaleMode = 2 'Point
ScaleWidth = 363.75
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin TabDlg.SSTab SSTab1
Height = 4695
Left = 0
TabIndex = 0
Top = 0
Width = 7215
_ExtentX = 12726
_ExtentY = 8281
_Version = 393216
Tab = 2
TabHeight = 520
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
TabCaption(0) = "调查结果统计"
TabPicture(0) = "system.frx":0000
Tab(0).ControlEnabled= 0 'False
Tab(0).Control(0)= "Frame1"
Tab(0).Control(1)= "Frame2"
Tab(0).Control(2)= "Frame3"
Tab(0).ControlCount= 3
TabCaption(1) = "数据管理"
TabPicture(1) = "system.frx":001C
Tab(1).ControlEnabled= 0 'False
Tab(1).Control(0)= "CmdBackUpData"
Tab(1).ControlCount= 1
TabCaption(2) = "打印输出"
TabPicture(2) = "system.frx":0038
Tab(2).ControlEnabled= -1 'True
Tab(2).ControlCount= 0
Begin VB.CommandButton CmdBackUpData
Caption = "数据备份"
Height = 495
Left = -72240
TabIndex = 12
Top = 2040
Width = 1335
End
Begin VB.Frame Frame3
Caption = "Frame3"
Height = 3375
Left = -71880
TabIndex = 7
Top = 1200
Width = 3975
Begin MSChart20Lib.MSChart MSChart2
Height = 1815
Left = 240
OleObjectBlob = "system.frx":0054
TabIndex = 8
Top = 360
Width = 3495
End
Begin VB.Label Label3
Alignment = 2 'Center
Caption = "Label3"
Height = 375
Left = 360
TabIndex = 10
Top = 2280
Width = 3375
End
End
Begin VB.Frame Frame2
Caption = "Frame2"
Height = 3375
Left = -74640
OLEDropMode = 1 'Manual
TabIndex = 6
Top = 1200
Width = 2775
Begin MSChart20Lib.MSChart MSChart1
Height = 2415
Left = 120
OleObjectBlob = "system.frx":23A1
TabIndex = 1
Top = 240
Width = 2415
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Label1"
Height = 195
Left = 240
TabIndex = 9
Top = 2640
Width = 480
End
End
Begin VB.Frame Frame1
Caption = "统计选择"
Height = 735
Left = -74760
TabIndex = 2
Top = 360
Width = 6735
Begin VB.CommandButton Command1
Caption = "返回"
Height = 375
Left = 5160
TabIndex = 11
Top = 240
Width = 975
End
Begin VB.OptionButton Option3
Caption = "参与课外活动统计"
Height = 495
Left = 3240
TabIndex = 5
Top = 120
Width = 1935
End
Begin VB.OptionButton Option2
Caption = "学习压力统计"
Height = 495
Left = 1560
TabIndex = 4
Top = 120
Width = 2175
End
Begin VB.OptionButton Option1
Caption = "抽烟统计"
Height = 255
Left = 240
TabIndex = 3
Top = 240
Width = 1815
End
End
End
End
Attribute VB_Name = "system"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim i As Integer '性别分值
Dim j As Integer '年龄分值
Dim ages(2, 6) As Integer '年龄段记数器
Dim smok(2, 6) As Integer '抽烟累加记数器
Dim food(2, 6) As Integer '精神紧张累加记数器
Dim phis(2, 6) As Integer '锻炼累加记数器
Dim man As Integer '男性记数器
Dim woman As Integer '女性记数器
Dim max As Integer '最大值记数器
Dim min As Integer '最小值记数器
Dim msex As String '最大最小值性别
Dim mage As String '最大最小值年龄
Dim mi As Integer '最大最小值性别记数器
Dim mj As Integer '最大最小值年龄段记数器
Dim average As Integer '平均值变量
Dim db As Database
Private Sub CmdBackUpData_Click()
On Error GoTo err:
FileCopy datapath, App.Path + "\vbgxbbackup.mdb"
Exit Sub
err:
MsgBox "数据库尚未关闭！不能备份！", vbInformation, "消息"
End Sub
Private Sub Command1_Click()
system.Hide
formcover1.Show
End Sub
Private Sub Form_Activate()
'将默认状态设为抽烟统计
'调用数据库
Set db = OpenDatabase(datapath) '打开数据库
see = "select * from custerms " '定义记录集
Set record = db.OpenRecordset(see) '打开记录集
If Not record.RecordCount = 0 Then '捡查数据库是否有数据
record.MoveFirst '将数据指针移至第一个记录
Do While Not record.EOF '直至最后一个记录
j = record("age") '年龄分值
i = record("sex") '性别分值
If i = 0 Then man = man + 1 '男性总人数`
If i = 1 Then woman = woman + 1 '女性总人数
ages(i, j) = ages(i, j) + 1 '各年龄段男女总人数
'计算男女不同年龄的抽烟人，素食者及喜爱运动者人数。
If record("smoking") > 0 Then smok(i, j) = smok(i, j) + 1 '抽烟人数
If record("foods") = 0 Then food(i, j) = food(i, j) + 1 '素食人数
If record("phsicalexercise") = 0 Then phis(i, j) = phis(i, j) + 1 '运动人数
record.MoveNext '下一个记录
Loop
record.Close '关闭数据库
End If
'数据溢出保护
For i = 0 To 1
For j = 0 To 4
If ages(i, j) = 0 Then ages(i, j) = 1
Next: Next
'直方图格式定义
Frame2.Caption = "30岁以下男性抽烟人数" '饼图标题
Frame3.Caption = "男女各年龄段抽烟人数" '直方图标题
Label1.Caption = "占总人数百分比" '饼图说明
Label3.Caption = "抽烟人占总人数百分比" '直方说明
With MSChart2
.RowCount = 2 '设男女两组数据
.ColumnCount = 5 '设每组5个年龄段
.chartType = 1 '2维直方图方式
.Row = 1
.RowLabel = "男"
For j = 0 To 4 '直方图赋值，统计男性抽烟人数
.Column = j + 1
.Data = smok(0, j) / ages(0, j)
Next j
.Row = 2
.RowLabel = "女"
For j = 0 To 4 '直方图赋值，统计划内女性抽烟人数
.Column = j + 1
.Data = smok(1, j) / ages(1, j)
Next j
End With
'30岁以下男性抽烟比例
'饼图格式定义
With MSChart1
.RowCount = 1 '1组数据
.ColumnCount = 2 '1个年龄段
.chartType = 14 '饼图方式
If ages(0, 0) = 0 Then ages(0, 0) = 1
'.Column = 2
'.Data = smok(0, 0) / ages(0, 0)
.RowLabel = ""
.Column = 1
.ColumnLabel = "抽烟"
.Data = smok(0, 0)
.Column = 2
.ColumnLabel = "总人数"
.Data = ages(0, 0)
Label1.Caption = Label1.Caption + Format("00", Left(CStr(smok(0, 0) * 100 / ages(0, 0)), 2)) + "%"
End With
db.Close
End Sub
Private Sub Form_Load()
'变量赋初值
man = 0: woman = 0
For i = 0 To 1: For j = 0 To 4
ages(i, j) = 0: smok(i, j) = 0: food(i, j) = 0: phis(i, j) = 0
Next: Next
'定义标签字型
Label1.FontSize = 10
Label3.FontSize = 12
End Sub
Private Sub Option1_Click()
'直方图格式定义
Frame2.Caption = "30岁以下男性抽烟人数" '饼图标题
Frame3.Caption = "男女各年龄段抽烟人数" '直方图标题
Label1.Caption = "占总人数百分比" '饼图说明
Label3.Caption = "抽烟人占总人数百分比" '直方说明
With MSChart2
.RowCount = 2 '设男女两组数据
.ColumnCount = 5 '设每组5个年龄段
.chartType = 1 '2维直方图方式
.Row = 1
.RowLabel = "男"
For j = 0 To 4 '直方图赋值，统计男性抽烟人数
.Data = smok(0, j) / ages(0, j)
Next j
.Row = 2
.RowLabel = "女"
For j = 0 To 4 '直方图赋值，统计划内女性抽烟人数
.Data = smok(1, j) / ages(1, j)
Next j
End With
'30岁以下男性抽烟比例
'饼图格式定义
With MSChart1
.RowCount = 1 '1组数据
.ColumnCount = 2 '1个年龄段
.Row = 1
.chartType = 14 '饼图方式
If ages(0, 0) = 0 Then ages(0, 0) = 1
'.Data = smok(0, 0) / ages(0, 0)
.Column = 1
.ColumnLabel = "抽烟"
.Data = smok(0, 0)
.Column = 2
.ColumnLabel = "总人数"
.Data = ages(0, 0) - smok(0, 0)
Label1.Caption = Label1.Caption + Format("00", Left(CStr(smok(0, 0) * 100 / ages(0, 0)), 2)) + "%"
End With
End Sub
Private Sub Option2_Click()
'直方图格式定义
Frame2.Caption = "30岁以下男性学习压力人数" '饼图标题
Frame3.Caption = "男女各年龄段学习压力人数" '直方图标题
Label1.Caption = "占总人数百分比" '饼图说明
Label3.Caption = "学习压力人占总人数百分比" '直方说明
With MSChart2
.RowCount = 2 '设男女两组数据
.ColumnCount = 5 '设每组5个年龄段
.chartType = 1 '2维直方图方式
.Row = 1
.RowLabel = "男"
For j = 0 To 4 '直方图赋值，统计男性素食人数
.Data = food(0, j) / ages(0, j)
Next j
.Row = 2
.RowLabel = "女"
For j = 0 To 4 '直方图赋值，统计划内女性素食人数
.Data = food(1, j) / ages(1, j)
Next j
End With
'30岁以下男性素食比例
'饼图格式定义
With MSChart1
.RowCount = 1 '1组数据
.ColumnCount = 2 '1个年龄段
.Row = 1
.chartType = 14 '饼图方式
If ages(0, 0) = 0 Then ages(0, 0) = 1
.Column = 1
.ColumnLabel = "学习压力"
.Data = food(0, 0)
.Column = 2
.ColumnLabel = "总人数"
.Data = ages(0, 0) - food(0, 0)
Label1.Caption = Label1.Caption + Format("00", Left(CStr(food(0, 0) * 100 / ages(0, 0)), 2)) + "%"
End With
End Sub
Private Sub Option3_Click()
'直方图格式定义
Frame2.Caption = "30岁以下男性参与课外活动人数" '饼图标题
Frame3.Caption = "男女各年龄段参与课外活动人数" '直方图标题
Label1.Caption = "占总人数百分比" '饼图说明
Label3.Caption = "参与课外活动人占总人数百分比" '直方说明
With MSChart2
.RowCount = 2 '设男女两组数据
.ColumnCount = 5 '设每组5个年龄段
.chartType = 1 '2维直方图方式
.Row = 1
.RowLabel = "男"
For j = 0 To 4 '直方图赋值，统计男性锻炼人数
.Data = phis(0, j) / ages(0, j)
Next j
.Row = 2
.RowLabel = "女"
For j = 0 To 4 '直方图赋值，统计划内女性锻炼人数
.Data = phis(1, j) / ages(1, j)
Next j
End With
'30岁以下男性比例
'饼图格式定义
With MSChart1
.RowCount = 1 '1组数据
.ColumnCount = 2 '1个年龄段
.Row = 1
.chartType = 14 '饼图方式
If ages(0, 0) = 0 Then ages(0, 0) = 1
.Column = 1
.ColumnLabel = "参与课外活动"
.Data = phis(0, 0)
.Column = 2
.ColumnLabel = "总人数"
.Data = ages(0, 0) - phis(0, 0)
Label1.Caption = Label1.Caption + Format("00", Left(CStr(phis(0, 0) * 100 / ages(0, 0)), 2)) + "%"
End With
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -