sqlform.frm

成绩管理

Private Sub Command2_Click()
qexit_Click
End Sub

Private Sub Command3_Click()
swq_Click
End Sub

Private Sub Click()
Command3_Click
End Sub

Private Sub Data1_Reposition()
Label7.Caption = Data1.Recordset.RecordCount
'Label9.Caption = Data1.Recordset.AbsolutePosition + 1
End Sub

Private Sub Form_Activate()
MDIForm1.Toolbar1.Visible = False
Command1_Click
End Sub

Private Sub Form_Load()
On Error Resume Next
MDIForm1.Toolbar1.Visible = False
'CenterForm Me
Me.Top = 0
Me.Left = 0
If gsdbname <> "" Then
   Data1.DatabaseName = gsdbname
   Me.Caption = Me.Caption + "---" + gsdbname + "--" + stab2
   Data1.RecordSource = stab2

End If
Set db = OpenDatabase(Data1.DatabaseName)
''''''''''''''''''''''''''''''''''''''''''''list1fill
Dim m As Integer
For m = 1 To km - 3
    List1.AddItem kmm(m)
Next m
For m = 0 To km - 3
    List1.Selected(m) = True
Next m

'''''''''''''''''''''''''''''''''''''''
Combo1.Clear
'Combo1.Text = "请选择查询方式"
Combo1.AddItem "浏览查询"
Combo1.AddItem "学号[like]"
Combo1.AddItem "姓名[like]"
Combo1.AddItem "总分"
Combo1.AddItem "名次"
Combo1.ListIndex = 0
'''''
Combo2.AddItem "学号"
Combo2.AddItem "姓名"
Combo2.AddItem "总分"
Combo2.ListIndex = 0
''''''
Combo3.AddItem "Asc 升序"
Combo3.AddItem "Desc降序"
Combo3.ListIndex = 0
''''''
For m = 2 To km - 5
    Combo1.AddItem kmm(m)
Next m
''''''''''''
Combo4.AddItem "<"
Combo4.AddItem "<="
Combo4.AddItem ">"
Combo4.AddItem ">="
Combo4.AddItem "="
Combo4.AddItem "like"
Combo4.ListIndex = 0
''''''
'Combo5.AddItem "Asc 升序"
'Combo5.AddItem "Desc降序"
'Combo5.ListIndex = 0
'''''''''''''
Label13.Caption = Now
dbGrid1.font = "system"
'Command3.Enabled = False
'Combo1.AddItem "Select * From xjgl21tab"
'Combo1.AddItem "Select [姓名],[性别],[出生年月] From xjgl21tab"
'Combo1.AddItem "Select * From xjgl21tab Where [姓名] like '方*'"
'Combo1.AddItem "Select * From xjgl21tab Where [性别]"
'Combo1.AddItem "Select * From xjgl21tab Where [Birthday] < #01/01/73# "
'Combo1.AddItem "Select * From xjgl21tab Order by [学号]"
'Combo1.AddItem "Select * From xjgl21tab Order by [姓名] Desc"
'Combo1.AddItem "Select xjgl21tab.[name],DWK.[name] From xjgl21tab Inner Join DWK On xjgl21tab.[jobid]=DWK.[jobid]"
wpc = List1.ListCount - 1
ddd = Data1.Recordset.RecordCount
End Sub

Private Sub Form_Resize()
'DBGrid1.Width = gridform.ScaleWidth - DBGrid1.Left - 200
'DBGrid1.Height = gridform.ScaleHeight - DBGrid1.Top - 200
End Sub

Private Sub Form_Unload(Cancel As Integer)
MDIForm1.Toolbar1.Visible = True
'db.TableDefs.Delete "总分"
qexit_Click
End Sub



Private Sub qabout_Click()
Form8.Show
End Sub

Private Sub qexit_Click()
Unload Me
Form1.Show
End Sub
Private Sub qptr_Click(Index As Integer)
Dim wrig As String
wrig = GetSetting("cjgl21", "startup", "lastentry")
If wrig = "58001546" Then
 
  Select Case Index
   Case 0
     Dim fnt As Single
     Dim pp As Integer
     pp = 0
     Dim strx, stry, strx1, stry1, linw, page1, p As Integer
     ReDim a(wpc) As Integer
     ss$ = "学期考试成绩一览表"
     kan = 0
     For i = 1 To wpc - 2 '- 1
         a(i) = 1500  'Len(Data1.Recordset.Fields(i).Name) * 130
         kan = kan + a(i)
     Next i
         a(wpc - 1) = 750
         a(wpc) = 750
         kan = kan + a(wpc - 1) + a(wpc)
     '''''''''
     page1 = 35
     strx = 200
     strx1 = 200
     stry = 1400
     stry1 = 1400
     linw = 360
     fnt = 12
     Printer.FontName = "宋体"
     dd = prnt1(4000, 700, 18, ss$)
     ''''''''
     Printer.Line (strx - 50, stry - 30)-(strx + kan - 10, stry - 30)
     '''''''''
     For j = 0 To ddd ''' - 1 ''Data1.Recordset.RecordCount - 1
         dbGrid1.Row = j
         strx = strx1
         Printer.Line (strx - 50, stry - 30)-(strx + kan - 10, stry - 30)
         p = p + 1
         For i = 1 To wpc '- 1 '''''
             dbGrid1.Col = i
             dd = prnt1(strx, stry, fnt, dbGrid1.Text)
             strx = strx + a(i)
         Next i
         
         If p > page1 Then
            p = 0
            strx = strx1
            Printer.Line (strx - 50, stry + linw)-(strx + kan - 10, stry + linw)
            stry = stry1
            For n = 0 To wpc - 1
               Printer.Line (strx - 30, stry - 30)-(strx - 30, stry + (page1 + 2) * linw)
               strx = strx + a(n)
            Next n
            Printer.Line (strx - 30, stry - 30)-(strx - 30, stry + (page1 + 2) * linw)
            pp = pp + 1
            foot$ = "第" + CStr(pp) + "页"
            dd = prnt1(strx - 30 - 1000, stry + (page1 + 2) * linw + 100, 10, foot$)
            
            Printer.NewPage
            dd = prnt1(4000, 700, 18, ss$)
            strx = strx1
            stry = stry1
            Printer.Line (strx - 50, stry - 30)-(strx + kan - 10, stry - 30)
         Else
            stry = stry + linw
         End If
      Next j
      ''''''''''''''''''''''''''
      'st=stry
      If p < page1 Then
      For i = p To Page + 1
          strx = strx1
          Printer.Line (strx - 50, stry - 30)-(strx + kan - 10, stry - 30)
          stry = stry + linw
      Next i
      End If
      stry = stry1
      strx = strx1
      For n = 0 To wpc
          Printer.Line (strx - 30, stry - 30)-(strx - 30, stry + (page1 + 2) * linw)
          strx = strx + a(n)
      Next n
      Printer.Line (strx - 30, stry - 30)-(strx - 30, stry + (page1 + 2) * linw)
          pp = pp + 1
          foot$ = "第" + CStr(pp) + "页"
          dd = prnt1(strx - 30 - 1000, stry + (page1 + 2) * linw + 100, 10, foot$)
      Printer.EndDoc
            
Case 1
Dim xlapp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Set xlapp = CreateObject("excel.application")
xlapp.Visible = True
Set xlbook = xlapp.Workbooks.Add
Set xlsheet = xlbook.Worksheets(1)
'xlsheet.cells(1, 1) = "i"
xlsheet.Cells(1, 3) = "考试成绩一览表"
For i = 0 To Data1.Recordset.RecordCount ' - 1  '''''
    dbGrid1.Row = i
    For j = 1 To wpc '- 1
        dbGrid1.Col = j
        If IsNull(dbGrid1.Text) = False Then
           xlsheet.Cells(i + 2, j) = dbGrid1.Text
        End If
    Next j
Next i
End Select
Else
  MsgBox "未注册，对不起，您不能使用该项功能 ", , "成绩管理系统V2.1"
End If

End Sub

Private Sub qqoper_Click()
On Error Resume Next
Dim i As Integer
wsql = "select [姓名]"
Dim kk As Integer
For kk = 0 To List1.ListCount - 1
    If List1.Selected(kk) Then
       wsql = wsql + "," + "[" + List1.List(kk) + "]"
    End If
Next kk
wsql = wsql + "from " + stab2
wpc = List1.SelCount + 1
''''''''''''''''''''''''''''''''''''''
Select Case Combo1.ListIndex
    Case 0
     wsql = wsql
    Case 1
     wsql = wsql & " where [学号] like " & "'" & Text1.Text & "'"
    Case 2
     wsql = wsql & " where [姓名] like " & "'" & Text1.Text & "'"
    Case 3
     wsql = wsql & " where [总分]" & Trim$(Combo4.Text) & "val(" & Text1.Text & ")"
    Case 4
     wsql = wsql & " where [名次]" & Trim$(Combo4.Text) & "val(" & Text1.Text & ")"
    Case Else
     wsql = wsql & " where [" & Trim$(Combo1.Text) & "] " & Trim$(Combo4.Text) & "'" & Text1.Text & "'" & "and [" & Trim$(Combo1.Text) & "] <> " & "'" & 100 & "'"
End Select
     wsql = wsql & " order by [" & Trim$(Combo2.Text) & "] "
     wsql = wsql & Left$(Combo3.Text, 4)
Set Data1.Recordset = db.OpenRecordset(wsql, dbOpenDynaset)

dbGrid1.ColWidth(1) = 0
dbGrid1.TextArray(fgi(0, 0)) = "姓名"
For i = dbGrid1.FixedRows To dbGrid1.Rows - 1
    dbGrid1.TextArray(fgi(i, 0)) = dbGrid1.TextArray(fgi(i, 1))
Next i

ddd = Data1.Recordset.RecordCount
If ddd <> 0 Then
    qprint.Enabled = True
Else
   MsgBox "无满足条件的记录", , "成绩管理系统V2.1"
     qprint.Enabled = False
End If
End Sub

Private Function prnt1(ByVal x As Integer, ByVal y As Integer, font As Single, txt As String)
   Printer.CurrentX = x
   Printer.CurrentY = y
   Printer.FontBold = False
   Printer.FontSize = font
   Printer.Print txt
End Function

Private Sub qusage_Click()
  Dim i As Double
    'If Index = 0 Then
        i = Shell("winhelp " + App.Path + "\my2.hlp", 1)
   ' End If
End Sub

Private Sub swq_Click()
On Error GoTo wqq
Dim wq As String
Dim ll As Integer
Dim i As Integer
Dim wstrg As String
'''''''''
For i = Val(Text2.Text) To Val(Text3.Text)
    wstrg = wstrg + "[学期" + Trim(Str(i)) + "_总分]+"
Next i
ll = Len(wstrg)
wstrg = Left$(wstrg, ll - 1)
'''''''''''''''''''''''''''''''''''''''''''''''''''
If Text2.Text = Text3.Text Then
   wq = "select 学期" + Text2.Text + "." + "[姓名],学期" + Text2.Text + "." + "[学号]"
   wq = wq + ",学期" + Text2.Text + "." + "[总分]"
   wq = wq + " from " + "学期" + Text2.Text
   wq = wq & " order by 学期" + Text2.Text + "." + "[学号]"
   Set Data1.Recordset = db.OpenRecordset(wq, dbOpenDynaset)
   wpc = 3
Else
wq = "select 学期" + Text2.Text + "." + "[姓名],学期" + Text2.Text + "." + "[学号]"
For i = Val(Text2.Text) To Val(Text3.Text)
    wq = wq + ",学期" + Trim(Str(i)) + "." + "[总分]"
Next i

wq = wq + " From "
For i = Val(Text2.Text) To Val(Text3.Text)
    wq = wq + "学期" + Trim(Str(i)) + ","
Next i
ll = Len(wq)
wq = Left$(wq, ll - 1)

wq = wq + " Where "
For i = Val(Text2.Text) To Val(Text3.Text) - 1
    wq = wq + "学期" + Trim(Str(i)) + "." + "[学号]=" + "学期" + Trim(Str(i + 1)) + "." + "[学号] and "
Next i
ll = Len(wq)
wq = Left$(wq, ll - 5)
'End If
wq = wq & " order by 学期" + Text2.Text + "." + "[学号]"
     
Set Data1.Recordset = db.OpenRecordset(wq, dbOpenDynaset)
wpc = 3 + Val(Text3.Text) - Val(Text2.Text)
End If
Exit Sub
wqq:
   MsgBox "未输入查询学期号, 或查询起始学期号大于查询终止学期号, 或库中无指定学期号中的某个学期", , "成绩管理系统V2.1"
End Sub

Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub
Private Function fgi(r As Integer, c As Integer) As Integer
fgi = c + dbGrid1.Cols * r
End Function