frmc.frm
来自「能分班系统采用Z线分班方法：即由系统自动抽签(也可由班主任抽签)」· FRM 代码 · 共 934 行 · 第 1/3 页
FRM
934 行
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
Begin VSPrinter7LibCtl.VSPrinter vp
Height = 3525
Left = 4290
TabIndex = 20
Top = 2310
Visible = 0 'False
Width = 4155
_cx = 7329
_cy = 6218
Appearance = 1
BorderStyle = 1
Enabled = -1 'True
MousePointer = 0
BackColor = -2147483643
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty HdrFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_ConvInfo = 1
AutoRTF = -1 'True
Preview = -1 'True
DefaultDevice = 0 'False
PhysicalPage = -1 'True
AbortWindow = -1 'True
AbortWindowPos = 0
AbortCaption = "Printing..."
AbortTextButton = "Cancel"
AbortTextDevice = "on the %s on %s"
AbortTextPage = "Now printing Page %d of"
FileName = ""
MarginLeft = 1440
MarginTop = 1440
MarginRight = 1440
MarginBottom = 1440
MarginHeader = 0
MarginFooter = 0
IndentLeft = 0
IndentRight = 0
IndentFirst = 0
IndentTab = 720
SpaceBefore = 0
SpaceAfter = 0
LineSpacing = 100
Columns = 1
ColumnSpacing = 180
ShowGuides = 2
LargeChangeHorz = 300
LargeChangeVert = 300
SmallChangeHorz = 30
SmallChangeVert = 30
Track = 0 'False
ProportionalBars= -1 'True
Zoom = 17.7203918076581
ZoomMode = 3
ZoomMax = 400
ZoomMin = 10
ZoomStep = 25
EmptyColor = 0
TextColor = 0
HdrColor = 255
BrushColor = 16711680
BrushStyle = 0
PenColor = 0
PenStyle = 0
PenWidth = 0
PageBorder = 0
Header = ""
Footer = ""
TableSep = "|;"
TableBorder = 7
TablePen = 0
TablePenLR = 0
TablePenTB = 0
NavBar = 0
NavBarColor = 0
ExportFormat = 0
URL = ""
Navigation = 3
NavBarMenuText = "Whole &Page|Page &Width|&Two Pages|Thumb&nail"
End
End
Attribute VB_Name = "FRMC"
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 SM As Long
Dim SMA As String
Dim s As String
Dim nmc As String
Dim intRecCount As Long
Dim intCounter As Long
Dim XSA As String
Dim 科目 As String
Dim qqq As Long
Dim ii As Long
Dim ASM As Long
Dim ASMA As String
Private Sub Combo1_Click()
On Error Resume Next
s = "select 学号,姓名,性别,班级,分数 from NHB nhb where 班级= " & Combo1 & " ORDER BY " & "" & Combo3.Text & " desc"
cmbSource
For III = 1 To VF.Rows - 1
VF.TextMatrix(III, 0) = III
Next
For qqq = 0 To VF.Cols - 1
VF.ColAlignment(qqq) = flexAlignCenterCenter
' VSFlexGrid1.CellAlignment = flexAlignCenterCenter
Next qqq
End Sub
Private Sub Combo2_Click()
On Error Resume Next
vp.Columns = Combo2.Text
cmbSource
End Sub
Private Sub Combo3_Click()
On Error Resume Next
s = "select 学号,姓名,性别,班级,分数 from NHB nhb where 班级= " & Combo1 & " ORDER BY " & "" & Combo3.Text & " desc"
cmbSource
For III = 1 To VF.Rows - 1
VF.TextMatrix(III, 0) = III
Next
For qqq = 0 To VF.Cols - 1
VF.ColAlignment(qqq) = flexAlignCenterCenter
' VSFlexGrid1.CellAlignment = flexAlignCenterCenter
Next qqq
End Sub
Private Sub Command3_Click()
End Sub
Private Sub Form_Load()
On Error Resume Next
With vp
.PaperSize = pprA4
.Orientation = orLandscape
.HdrColor = vbRed
End With
cmbPercent.ListIndex = 0
cmbZoomMode.ListIndex = 3
Set db = OpenDatabase(MAIN.Cmd1.FileName)
Set rs = db.OpenRecordset("SELECT * FROM NAME")
nmc = rs![Name]
db.Close
Skin1.ApplySkin Me.hwnd
If MAIN.Cmd1.FileName = "" Then MsgBox "请指定一个数据后，才能进行分析处理。", 32, "无法操作": Exit Sub
Dim a
科目 = InputBox("请输入总班级数：(只能输入数字)", "班级自动分配")
If 科目 = "" Then
Exit Sub
Else
Set db = OpenDatabase(MAIN.Cmd1.FileName)
Set rs = db.OpenRecordset("SELECT COUNT(*) AS TOTAL FROM NHB WHERE 性别='男' ")
SM = rs![TOTAL]
If SM / 科目 - CByte(SM / 科目) > 0 Then
SMA = CByte(SM / 科目) + 1
Else
SMA = CByte(SM / 科目)
End If
Dim AW As Long
For AW = 1 To 科目
Combo1.AddItem AW
Next
Combo1.ListIndex = 0
DoEvents
WATING.Show
DoEvents
Data1.DatabaseName = MAIN.Cmd1.FileName
Data1.RecordSource = "select 分数,班级 from NHB WHERE 性别='男' ORDER BY 分数 desc"
Data1.Refresh
Dim III As Long
For III = 1 To VF.Rows - 1
VF.TextMatrix(III, 2) = III
DoEvents
WATING.Label1.Visible = False
WATING.Label2.Visible = True
WATING.PB.Visible = True
WATING.Label2.Caption = "载入男生智能引擎"
WATING.PB.Max = SMA
WATING.PB1.Max = SM
WATING.PB.Value = 0
WATING.PB1.Value = 0
DoEvents
Next
DoEvents
Set db = DBEngine.Workspaces(0).OpenDatabase(MAIN.Cmd1.FileName)
db.Execute "UPDATE NHB SET 班级=999 WHERE 性别='男'"
db.Close
DoEvents
WATING.Label2.Caption = "数据库初始化"
DoEvents
Dim QQ As Long
For QQ = 1 To SMA
Data1.DatabaseName = MAIN.Cmd1.FileName
Data1.RecordSource = "select 分数,班级 from NHB WHERE 班级>" & 科目 & " AND 性别='男' ORDER BY 分数 desc"
Data1.Refresh
Dim IIIA As Long
For IIIA = 1 To VF.Rows - 1
VF.TextMatrix(IIIA, 2) = IIIA
DoEvents
WATING.Label2.Caption = "智能分析男生 " & QQ & "--" & IIIA
WATING.PB.Max = SMA
WATING.PB.Value = QQ * 0.75
WATING.PB1.Value = 0
WATING.PB1.Value = IIIA
DoEvents
Next
Data1.RecordSource = "select 分数,班级 from NHB WHERE 班级>" & 科目 & " AND 性别='男' ORDER BY 分数 "
Data1.Refresh
Dim IIIAA As Long
For IIIAA = 1 To VF.Rows - 1
VF.TextMatrix(IIIAA, 2) = IIIAA
DoEvents
WATING.Label2.Caption = "智能分析男生 " & QQ & "--" & IIIAA
WATING.PB.Max = SMA
WATING.PB.Value = QQ * 0.75
WATING.PB1.Value = 0
WATING.PB1.Value = IIIAA
DoEvents
Next
Next QQ
'*****************************************************************************************************88
Set db = OpenDatabase(MAIN.Cmd1.FileName)
Set rs = db.OpenRecordset("SELECT COUNT(*) AS TOTAL FROM NHB WHERE 性别='女' ")
ASM = rs![TOTAL]
If ASM / 科目 - CByte(ASM / 科目) > 0 Then
ASMA = CByte(ASM / 科目) + 1
Else
ASMA = CByte(ASM / 科目)
End If
Combo1.ListIndex = 0
DoEvents
WATING.Show
DoEvents
Data1.DatabaseName = MAIN.Cmd1.FileName
Data1.RecordSource = "select 分数,班级 from NHB WHERE 性别='女' ORDER BY 分数 desc"
Data1.Refresh
Dim AIII As Long
For AIII = 1 To VF.Rows - 1
VF.TextMatrix(AIII, 2) = AIII
DoEvents
WATING.Label1.Visible = False
WATING.Label2.Visible = True
WATING.PB.Visible = True
WATING.Label2.Caption = "载入女生智能引擎"
WATING.PB.Max = ASMA
WATING.PB1.Max = ASM
WATING.PB.Value = 0
WATING.PB1.Value = 0
DoEvents
Next
DoEvents
Set db = DBEngine.Workspaces(0).OpenDatabase(MAIN.Cmd1.FileName)
db.Execute "UPDATE NHB SET 班级=999 WHERE 性别='女'"
db.Close
DoEvents
WATING.Label2.Caption = "数据库初始化"
DoEvents
Dim AQQ As Long
For AQQ = 1 To ASMA
Data1.DatabaseName = MAIN.Cmd1.FileName
Data1.RecordSource = "select 分数,班级 from NHB WHERE 班级>" & 科目 & " AND 性别='女' ORDER BY 分数 desc"
Data1.Refresh
Dim AIIIA As Long
For AIIIA = 1 To VF.Rows - 1
VF.TextMatrix(AIIIA, 2) = AIIIA
DoEvents
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?