frmedit.frm
来自「能分班系统采用Z线分班方法：即由系统自动抽签(也可由班主任抽签)」· FRM 代码 · 共 419 行
FRM
419 行
VERSION 5.00
Object = "{90F3D7B3-92E7-44BA-B444-6A8E2A3BC375}#1.0#0"; "ACTSKIN4.OCX"
Object = "{D76D7130-4A96-11D3-BD95-D296DC2DD072}#1.0#0"; "Vsflex7d.ocx"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form FRMedit
BorderStyle = 3 'Fixed Dialog
Caption = "修改分班数据"
ClientHeight = 4770
ClientLeft = 45
ClientTop = 330
ClientWidth = 4740
Icon = "FRMedit.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4770
ScaleWidth = 4740
StartUpPosition = 2 'CenterScreen
Begin ComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 885
Left = 0
TabIndex = 0
Top = 0
Width = 4740
_ExtentX = 8361
_ExtentY = 1561
ButtonHeight = 1411
Appearance = 1
_Version = 327682
BorderStyle = 1
Begin VB.TextBox Text2
Height = 315
Left = 9150
TabIndex = 8
Text = "Text2"
Top = 90
Visible = 0 'False
Width = 1665
End
Begin VB.TextBox Text1
Height = 315
Left = 9180
TabIndex = 7
Text = "Text1"
Top = 450
Visible = 0 'False
Width = 1695
End
Begin VB.CommandButton Command6
Caption = "保存退出"
Height = 465
Left = 3600
TabIndex = 6
Top = 180
Width = 885
End
Begin VB.CommandButton Command5
Caption = "删除此行"
Height = 465
Left = 2460
TabIndex = 5
Top = 180
Width = 885
End
Begin VB.CommandButton Command2
Caption = "插入空表"
Height = 465
Left = 1350
TabIndex = 4
Top = 180
Width = 885
End
Begin VB.ComboBox Combo2
ForeColor = &H000000FF&
Height = 300
ItemData = "FRMedit.frx":1042
Left = 240
List = "FRMedit.frx":1052
Style = 2 'Dropdown List
TabIndex = 3
Top = 390
Width = 885
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 255
Index = 1
Left = 150
OleObjectBlob = "FRMedit.frx":106E
TabIndex = 2
Top = 150
Width = 1065
End
Begin VB.CommandButton Command4
Caption = "Command4"
Height = 405
Left = 8490
TabIndex = 1
Top = 270
Visible = 0 'False
Width = 585
End
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access 2000;"
DatabaseName = ""
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
Exclusive = 0 'False
Height = 585
Left = 3180
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 6540
Visible = 0 'False
Width = 1275
End
Begin ACTIVESKINLibCtl.Skin Skin1
Left = 2220
OleObjectBlob = "FRMedit.frx":10CB
Top = 6390
End
Begin VSFlex7DAOCtl.VSFlexGrid VSFlexGrid1
Align = 1 'Align Top
Bindings = "FRMedit.frx":6CACE
Height = 3825
Left = 0
TabIndex = 9
Top = 885
Width = 4740
_cx = 8361
_cy = 6747
_ConvInfo = 1
Appearance = 0
BorderStyle = 0
Enabled = -1 'True
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
MousePointer = 0
BackColor = -2147483643
ForeColor = 16711680
BackColorFixed = 13876923
ForeColorFixed = 255
BackColorSel = 65535
ForeColorSel = 255
BackColorBkg = 13876923
BackColorAlternate= -2147483643
GridColor = 13876923
GridColorFixed = 13876923
TreeColor = -2147483632
FloodColor = 192
SheetBorder = -2147483642
FocusRect = 1
HighLight = 1
AllowSelection = -1 'True
AllowBigSelection= -1 'True
AllowUserResizing= 1
SelectionMode = 1
GridLines = 1
GridLinesFixed = 2
GridLineWidth = 1
Rows = 50
Cols = 10
FixedRows = 1
FixedCols = 1
RowHeightMin = 0
RowHeightMax = 0
ColWidthMin = 0
ColWidthMax = 0
ExtendLastCol = 0 'False
FormatString = ""
ScrollTrack = -1 'True
ScrollBars = 2
ScrollTips = -1 'True
MergeCells = 0
MergeCompare = 0
AutoResize = 0 'False
AutoSizeMode = 0
AutoSearch = 0
AutoSearchDelay = 2
MultiTotals = -1 'True
SubtotalPosition= 1
OutlineBar = 0
OutlineCol = 0
Ellipsis = 0
ExplorerBar = 0
PicturesOver = 0 'False
FillStyle = 1
RightToLeft = 0 'False
PictureType = 0
TabBehavior = 0
OwnerDraw = 0
Editable = 2
ShowComboButton = 2
WordWrap = 0 'False
TextStyle = 0
TextStyleFixed = 0
OleDragMode = 0
OleDropMode = 0
DataMode = 1
VirtualData = -1 'True
ComboSearch = 3
AutoSizeMouse = -1 'True
FrozenRows = 0
FrozenCols = 0
AllowUserFreezing= 3
BackColorFrozen = 255
ForeColorFrozen = 13876923
WallPaperAlignment= 9
End
End
Attribute VB_Name = "FRMedit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim db As Database
Dim rs As Recordset
Dim STR As String
Dim XS As String '取出COM中的输入显示中的代码信息
Dim NUM As Long
Dim iawv As Integer '取出满分数
Dim GYXEOV As Integer '取出总班级数
Private Sub Combo2_Click()
On Error Resume Next
Data1.DatabaseName = MAIN.Cmd1.FileName
Data1.RecordSource = "SELECT 学号,姓名,性别,分数 FROM NHB ORDER BY " & "" & Combo2.Text & ""
Data1.Refresh
Dim III As Long
For III = 1 To NUM
VSFlexGrid1.TextMatrix(III, 0) = III
Next
End Sub
Private Sub Command2_Click()
On Error Resume Next
Set db = OpenDatabase(MAIN.Cmd1.FileName)
STR = "INSERT INTO NHB (ID) VALUES ('" & 1 & "')"
db.Execute STR
db.Close '自动生成十行空数据
Data1.DatabaseName = MAIN.Cmd1.FileName
Data1.RecordSource = "SELECT 学号,姓名,性别,分数 FROM NHB"
Data1.Refresh
'############################################################################
Set db = OpenDatabase(MAIN.Cmd1.FileName)
Set rs = db.OpenRecordset("NHB")
NUM = 0
rs.MoveFirst
Do While Not rs.EOF()
NUM = NUM + 1
rs.MoveNext '得到数据库中的总数目
Loop
'############################################################################
Dim III As Long
For III = 1 To NUM + 10
VSFlexGrid1.TextMatrix(III, 0) = III
Next '在表格左列显示数据总数目
'############################################################################
Call Combo2_Click
End Sub
Private Sub Command4_Click()
On Error Resume Next
Dim QQ As Long
For QQ = 0 To VSFlexGrid1.Cols
VSFlexGrid1.ColAlignment(QQ) = flexAlignCenterCenter
' VSFlexGrid1.CellAlignment = flexAlignCenterCenter
Next QQ
End Sub
Private Sub Command5_Click()
On Error GoTo deldata
MsgBox "请您删除记录前，选对要删除的对象，否则数据库可能被您意处删除其它数据！！！", vbOKOnly, "警告！"
Select Case MsgBox("是否真的删除记录吗？", vbOKCancel, "警告！")
Case vbOK
Data1.Recordset.Delete
Data1.Recordset.MoveNext
If Data1.Recordset.EOF = True Then
Data1.Recordset.MovePrevious
End If
Data1.Refresh
Case Else
Cancel = True
End Select
deldata:
Select Case Err.Number
Case 3021
MsgBox "没有找到要删除的对象！", 32, "提示"
End Select
End Sub
Private Sub Command6_Click()
On Error Resume Next
Dim s$
Open App.Path & "\readme.txt" For Binary As #1
s = Input(LOF(1), 1)
Close #1
MsgBox s, vbInformation, "保存数据注意点："
Select Case MsgBox("是否真的保存数据后退出？", vbOKCancel, "警告！")
Case vbOK
MousePointer = vbDefault
Unload Me
Case Else
Cancel = True
End Select
End Sub
Private Sub Form_Load()
On Error GoTo 32755
MAIN.Enabled = False
Skin1.ApplySkin Me.hwnd
Data1.DatabaseName = MAIN.Cmd1.FileName
Data1.RecordSource = "SELECT 学号,姓名,性别,分数 FROM NHB"
Data1.Refresh
Combo2.ListIndex = 3
Dim s$
s = "|男|女"
Me.VSFlexGrid1.ColComboList(3) = s
Set db = OpenDatabase(MAIN.Cmd1.FileName)
Set rs = db.OpenRecordset("NHB")
NUM = 0
rs.MoveFirst
Do While Not rs.EOF()
NUM = NUM + 1
rs.MoveNext '得到数据库中的总数目
Loop
Dim III As Long
For III = 1 To NUM
VSFlexGrid1.TextMatrix(III, 0) = III
Next
32755:
Select Case Err.Number
Case 3021
MsgBox "无数据内容,或者该文件已损坏", 64, "无法载入"
Unload Me
Exit Sub
Case 3078
MsgBox "数据格式不对,您可以进行格式转换后,再试!!!", 64, "无法载入"
Unload Me
Exit Sub
Case 3343
MsgBox "无数据内容,或者该文件已损坏", 64, "无法载入"
Unload Me
Exit Sub
Case 3061
MsgBox "无数据内容,或者该文件已损坏", 64, "无法载入"
Unload Me
Exit Sub
End Select
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
MAIN.Enabled = True
Dim ws As Workspace
Dim db As Database
Dim rs As Recordset
For Each ws In Workspaces
For Each db In ws.Databases
For Each rs In db.Recordsets
rs.Close
Set rs = Nothing
Next
db.Close
Set db = Nothing
Next
ws.Close
Set ws = Nothing
Next
End Sub
Private Sub VSFlexGrid1_Click()
On Error Resume Next
Data1.Recordset.AbsolutePosition = VSFlexGrid1.Row - 1
'点击表格时，同时将DATA1的数据同步显示，确保准确删除数据
End Sub
Private Sub VSFlexGrid1_KeyPressEdit(ByVal Row As Long, ByVal Col As Long, KeyAscii As Integer)
On Error Resume Next
If VSFlexGrid1.Col = 4 Then
Select Case KeyAscii
Case 48 To 57, 8
Case 46
If InStr(VSFlexGrid1.TextMatrix(VSFlexGrid1.Row, VSFlexGrid1.Col), ".") <> 0 Then
KeyAscii = 0
End If
Case Else
KeyAscii = 0
End Select
End If
If VSFlexGrid1.Col = 3 Then
KeyAscii = 0
End If
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?