📄 frmgrid.frm
字号:
VERSION 5.00
Object = "{00028C01-0000-0000-0000-000000000046}#1.0#0"; "DBGRID32.OCX"
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.2#0"; "COMCTL32.OCX"
Begin VB.Form frmGridModify
BackColor = &H00C0C0C0&
BorderStyle = 3 'Fixed Dialog
Caption = "基本信息修改"
ClientHeight = 6540
ClientLeft = 45
ClientTop = 615
ClientWidth = 9510
Icon = "frmGrid.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6540
ScaleWidth = 9510
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin ComctlLib.StatusBar SBar1
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 3
Top = 6165
Width = 9510
_ExtentX = 16775
_ExtentY = 661
SimpleText = ""
_Version = 327682
BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7}
NumPanels = 2
BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7}
AutoSize = 2
TextSave = ""
Object.Tag = ""
EndProperty
BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7}
AutoSize = 1
Object.Width = 14155
TextSave = ""
Object.Tag = ""
EndProperty
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin TabDlg.SSTab SSTab1
Height = 6060
Left = 30
TabIndex = 0
Top = 75
Width = 9435
_ExtentX = 16642
_ExtentY = 10689
_Version = 327680
Tabs = 2
TabsPerRow = 2
TabHeight = 882
BackColor = 12632256
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "幼圆"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
TabCaption(0) = "学生基本信息全屏修改"
TabPicture(0) = "frmGrid.frx":044A
Tab(0).ControlCount= 1
Tab(0).ControlEnabled= -1 'True
Tab(0).Control(0)= "DBGrdstudent"
Tab(0).Control(0).Enabled= 0 'False
TabCaption(1) = "学生家庭信息全屏修改"
TabPicture(1) = "frmGrid.frx":0764
Tab(1).ControlCount= 1
Tab(1).ControlEnabled= 0 'False
Tab(1).Control(0)= "dbgrdFamily"
Tab(1).Control(0).Enabled= 0 'False
Begin MSDBGrid.DBGrid DBGrdstudent
Bindings = "frmGrid.frx":0A7E
Height = 5295
Left = 90
OleObjectBlob = "frmGrid.frx":0A8E
TabIndex = 1
Top = 630
Width = 9225
End
Begin MSDBGrid.DBGrid dbgrdFamily
Bindings = "frmGrid.frx":1435
Height = 5295
Left = -74910
OleObjectBlob = "frmGrid.frx":1445
TabIndex = 2
Top = 630
Width = 9225
End
End
Begin VB.Data Data2
Caption = "Data2"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
Exclusive = 0 'False
Height = 375
Left = 1950
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 2460
Visible = 0 'False
Width = 1575
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
Exclusive = 0 'False
Height = 375
Left = 4290
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "ZBQKB"
Top = 4290
Visible = 0 'False
Width = 1455
End
Begin VB.Line Line1
BorderColor = &H00000000&
X1 = 30
X2 = 3090
Y1 = 30
Y2 = 30
End
Begin VB.Menu mnusys
Caption = "【文件&S】"
Begin VB.Menu mnusysexit
Caption = "退出[&X]"
End
End
Begin VB.Menu MNULOC
Caption = "【记录定位&L】"
Begin VB.Menu MNUDW
Caption = "基本库记录定位[&D]"
End
Begin VB.Menu MNU21
Caption = "-"
End
Begin VB.Menu MNUDW2
Caption = "家长库记录定位[&F]"
End
End
Begin VB.Menu MNUQH
Caption = "【功能切换&C】"
Begin VB.Menu MNUQH1
Caption = "数据录入[&A]"
End
Begin VB.Menu MNU31
Caption = "-"
End
Begin VB.Menu MNUQH2
Caption = "记录查询[&S]"
End
Begin VB.Menu MNU32
Caption = "-"
End
Begin VB.Menu MNUQH3
Caption = "数据统计[&C]"
End
End
Begin VB.Menu MNUFUZU
Caption = "【辅助功能&O】"
Begin VB.Menu MNUFUZU1
Caption = "允许成批修改[&A]"
End
End
Begin VB.Menu MNUHELP
Caption = "【帮助&H】"
Begin VB.Menu MNUNOTE
Caption = "使用说明[&N]"
End
End
End
Attribute VB_Name = "frmGridModify"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim msSortCol As String
Dim mbCtrlKey As Integer
Private Sub dbgrdFamily_BeforeColUpdate(ByVal ColIndex As Integer, OldValue As Variant, Cancel As Integer)
On Error Resume Next
If MNUFUZU1.Checked = True Then Exit Sub
If MsgBox("您同意改变吗!", vbInformation + vbOKCancel, "警告") = vbOK Then
Cancel = 0
Else
Cancel = 1
End If
End Sub
Private Sub dbgrdFamily_BeforeDelete(Cancel As Integer)
On Error Resume Next
If MNUFUZU1.Checked = True Then Exit Sub
If MsgBox("您同意删除吗!", vbInformation + vbOKCancel, "警告") = vbOK Then
Cancel = 0
Else
Cancel = 1
End If
End Sub
Private Sub dbgrdFamily_HeadClick(ByVal ColIndex As Integer)
If Data2.RecordsetType = vbRSTypeTable Then Exit Sub
If mbCtrlKey Then
msSortCol = Data2.Recordset(ColIndex).Name & " desc"
mbCtrlKey = 0
Else
msSortCol = Data2.Recordset(ColIndex).Name
End If
sort
msSortCol = gsNUL_STR
End Sub
Private Sub dbgrdStudent_BeforeColUpdate(ByVal ColIndex As Integer, OldValue As Variant, Cancel As Integer)
On Error Resume Next
If MNUFUZU1.Checked = True Then Exit Sub
If MsgBox("您同意改变吗!", vbInformation + vbOKCancel, "警告") = vbOK Then
Cancel = 0
Else
Cancel = 1
End If
End Sub
Private Sub dbgrdStudent_BeforeDelete(Cancel As Integer)
On Error Resume Next
If MNUFUZU1.Checked = True Then Exit Sub
If MsgBox("您同意删除吗!", vbInformation + vbOKCancel, "警告") = vbOK Then
Cancel = 0
Else
Cancel = 1
End If
End Sub
Private Sub dbgrdStudent_HeadClick(ByVal ColIndex As Integer)
If Data1.RecordsetType = vbRSTypeTable Then Exit Sub
If mbCtrlKey Then
msSortCol = Data1.Recordset(ColIndex).Name & " desc"
mbCtrlKey = 0
Else
msSortCol = Data1.Recordset(ColIndex).Name
End If
cmdSort_Click
msSortCol = gsNUL_STR
End Sub
Private Sub Form_Activate()
SSTab1.Tab = 0
SSTab1.SetFocus
End Sub
Private Sub Form_Load()
On Error GoTo err
Dim sqlForModify As String
Dim recForModify As Recordset
sqlForModify = "select xh as 学号,xm as 姓名,csny as 出生年月,xb as 性别,mz as 民族,xl as 学历,yx as 院系,bj as 班级,hksx as 户口属性,nj as 年级,sy as 生源,zzmm as 政治面貌,tc as 特长,sfzhm as 身份证号码,ltkhm as 灵通卡号码,ss as 宿舍,dh as 电话,zy as 专业 ,pyfs as 培养方式,BYZX AS 毕业中学 from zbqkb"
Set recForModify = Dbstudent.OpenRecordset(sqlForModify, dbOpenDynaset)
Set Data1.Recordset = recForModify
sqlForModify = "select xh as 学号,xm as 姓名,jzxm1 as 家长姓名1,gx1 as 关系1,dw1 as 单位地址,ym1 as 单位邮码,dh1 as 单位电话 ,jzxm2 as 家长姓名2,gx2 as 关系2,dw2 as 家庭地址,ym2 as 家庭邮码 ,dh2 as 家庭电话 from jtqkb "
Set recForModify = Dbstudent.OpenRecordset(sqlForModify, dbOpenDynaset)
Set Data2.Recordset = recForModify
SBar1.Panels(1).Text = "[学生基本信息库]中共有" & Data1.Recordset.RecordCount & "条记录!"
'Else
SBar1.Panels(2).Text = "[家庭情况信息库]中共有" & Data2.Recordset.RecordCount & "条记录!"
Exit Sub
err:
MsgBox err.Description
End Sub
Private Sub Form_Resize()
On Error Resume Next
Line1.X1 = 0
Line1.X2 = frmGridModify.Width
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Unload Me
End Sub
Private Sub MNUDW_Click()
On Error Resume Next
FRMDW.Caption = "学生基本信息库记录定位"
FRMDW.Label1.Caption = "请您输入定位学号："
FRMDW.Show 1
End Sub
Private Sub MNUDW2_Click()
On Error Resume Next
FRMDW.Label1.Caption = "请您输入定位学号："
FRMDW.Caption = "家长信息库记录定位"
FRMDW.Show 1
End Sub
Private Sub MNUFUZU1_Click()
If MNUFUZU1.Checked = True Then
MNUFUZU1.Checked = False
Else
MNUFUZU1.Checked = True
End If
End Sub
Private Sub MNUNOTE_Click()
On Error Resume Next
Dim TTT As String
Dim X
TTT = App.Path + "\help\repair.txt"
X = Shell("Notepad " + TTT, 1)
Exit Sub
End Sub
Private Sub MNUQH1_Click()
On Error Resume Next
frmBaseInput.Show 1
End Sub
Private Sub MNUQH2_Click()
On Error Resume Next
frmQuery.Show 1
End Sub
Private Sub MNUQH3_Click()
On Error Resume Next
frmCount.Show 1
End Sub
Private Sub mnusysexit_Click()
On Error Resume Next
Me.Hide
Unload Me
End Sub
Private Sub SSTab1_Click(PreviousTab As Integer)
'If SSTab1.Tab = 0 Then
SBar1.Panels(1).Text = "[学生基本信息库]中共有" & Data1.Recordset.RecordCount & "条记录!"
'Else
SBar1.Panels(2).Text = "[家庭情况信息库]中共有" & Data2.Recordset.RecordCount & "条记录!"
'End If
End Sub
Private Sub cmdSort_Click()
On Error GoTo sorterr
Dim recRecordset1 As Recordset, recRecordset2 As Recordset
Dim SortStr As String
Set recRecordset1 = Data1.Recordset 'copy the recordset
SortStr = msSortCol
recRecordset1.sort = SortStr
Set recRecordset2 = recRecordset1.OpenRecordset(recRecordset1.Type)
Set Data1.Recordset = recRecordset2
Screen.MousePointer = 0
Exit Sub
sorterr:
Screen.MousePointer = 0
On Error Resume Next
Exit Sub
End Sub
Private Sub sort()
On Error GoTo sorterr
Dim recRecordset1 As Recordset, recRecordset2 As Recordset
Dim SortStr As String
Set recRecordset1 = Data2.Recordset 'copy the recordset
SortStr = msSortCol
recRecordset1.sort = SortStr
Set recRecordset2 = recRecordset1.OpenRecordset(recRecordset1.Type)
Set Data2.Recordset = recRecordset2
Screen.MousePointer = 0
Exit Sub
sorterr:
Screen.MousePointer = 0
On Error Resume Next
Exit Sub
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -