form18.frm

来自「主要用于学校机房考试,主要包括选择题,问答题,WORD操作题,WINDOWS操作」· FRM 代码 · 共 921 行 · 第 1/2 页

'画四个圆
CER = CreateEllipticRgn(0, 0, 52, 52)
CombineRgn Regn, Regn, CER, RGN_OR
CER = CreateEllipticRgn(X1 - 50, 0, X1 + 1, 52)
CombineRgn Regn, Regn, CER, RGN_OR
CER = CreateEllipticRgn(0, Y1 - 52, 52, Y1)
CombineRgn Regn, Regn, CER, RGN_OR
CER = CreateEllipticRgn(X1 - 9, Y1 - 9, X1, Y1)
CombineRgn Regn, Regn, CER, RGN_OR
Call SetWindowRgn(Me.hwnd, Regn, True) '创建窗体
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Imclose.Tag <> "" Then
Imclose.Picture = LoadPicture()
Imclose.Tag = ""
End If
If Immin.Tag <> "" Then
Immin.Picture = LoadPicture()
Immin.Tag = ""
End If
If Immax.Tag <> "" Then
Immax.Picture = LoadPicture()
Immax.Tag = ""
End If

End Sub

Private Sub Form_Resize()
On Error Resume Next
'改变一些控件位置
IMBar.Width = Me.Width - 1100
Immax.Top = 120
Immax.Left = Me.Width - 780
Immin.Top = 120
Immin.Left = Me.Width - 1095
Imclose.Top = 120
Imclose.Left = Me.Width - 465
Pbottom.Top = Me.Height - Pbottom.Height
Pbottom.Width = Me.Width - 240
Pright.Left = Me.Width - Pright.Width
Pright.Height = Me.Height - 240
Pjiao.Left = Me.Width - Pjiao.Width
Pjiao.Top = Me.Height - Pjiao.Height
'用于把主窗体图片打印成适合窗体大小
Me.Line (0, 0)-(Me.Width, Me.Height), Me.BackColor, BF
Me.PaintPicture Pmain.Picture, 420, 0, Me.Width, 600, 420, 0, 120, 600
Me.PaintPicture Pmain.Picture, 420, Me.Height - 600, Me.Width, 600, 420, Pmain.Height - 600, 120, 600

Me.PaintPicture Pmain.Picture, 0, 0, 200, Me.Height, 0, 880, 200, 40
Me.PaintPicture Pmain.Picture, Me.Width - 200, 0, 200, Me.Height, Pmain.Width - 200, 880, 200, 40

Me.PaintPicture Pmain.Picture, 0, 0, 450, 600, 0, 0, 450, 600
Me.PaintPicture Pmain.Picture, 0, Me.Height - 600, 450, 600, 0, Pmain.Height - 600, 450, 600

Me.PaintPicture Pmain.Picture, Me.Width - 1665, 0, 1665, 435, Pmain.Width - 1665, 0, 1665, 435
Me.PaintPicture Pmain.Picture, Me.Width - 1665, Me.Height - 525, 1665, 525, Pmain.Width - 1665, Pmain.Height - 525, 1665, 525
Me.PaintPicture Imico, 240, 100, 240, 240, 0, 0, 240, 240 '打印标题图标
Me.ForeColor = 12691863
Me.CurrentX = 530
Me.CurrentY = 110
Me.Print Me.caption '打印标题，有阴影的
Me.ForeColor = 11100191
Me.CurrentX = 540
Me.CurrentY = 120
Me.Print Me.caption
RMe
End Sub
Private Sub Form_Load()
On Error Resume Next
Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
Data1.DatabaseName = App.Path + "\" + "teacher.mdb"
Data1.RecordSource = "SELECT * FROM 学生情况表 order by 照片号"
a = 1
Text(1).BackColor = &HC0C0C0
Text(2).BackColor = &HC0C0C0
Text1.Visible = False
Text2.Text = "先在学科一栏中输入要录入分数的学科,如:语文,数学等,然后回车,即可按学号从小到大的顺序录入本科分数；若当前同学的本科成绩已有，按回车将显示下一们同学的信息；若想根据学号来输入本科分数，则可以用鼠标单击学号栏，再按F2键，取消学号栏的锁定，即可输入学号再输入本科分数。 若要锁定某一栏，可按F1键，取消锁定某一栏按F2键，锁定后本栏内容将不能改动。"
End Sub

Private Sub IMBar_DblClick()
Immax_Click '双击标题栏时最大化和还原
End Sub

Private Sub IMBar_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'不用多说，拖动窗体
If Button = 1 Then
ReleaseCapture
SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If

End Sub

Private Sub ImClose_Click()
Unload Me
Form2.Show
End Sub

Private Sub Immax_Click()
'由于最大化和还原按钮是同一个Image，所以这里麻烦一点
If Me.WindowState = 2 Then
Me.WindowState = 0
Pbottom.Visible = True
Pright.Visible = True
Immax.ToolTipText = "最大化"
Else
Me.WindowState = 2
Pbottom.Visible = False
Pright.Visible = False
Me.Line (Immax.Left, Immax.Top)-(Immax.Left + 240, Immax.Top + 240), 16448250, BF
Me.PaintPicture IMus0.Picture, Immax.Left, Immax.Top, 240, 240, 0, 0, 240, 240
Immax.ToolTipText = "还原"
End If
End Sub

Private Sub ImMin_Click()
Me.WindowState = 1
End Sub

Private Sub ImMin_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Immin.Picture = ImMin2.Picture
End Sub
Private Sub ImMin_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Immin.Tag = "" Then
Immin.Picture = ImMin1.Picture
Immin.Tag = "1"
End If
End Sub
Private Sub ImMin_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Immin.Picture = LoadPicture()
Immin.Tag = ""
End Sub


Private Sub Imclose_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Imclose.Picture = ImClose2.Picture
End Sub
Private Sub Imclose_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Imclose.Tag = "" Then
Imclose.Picture = ImClose1.Picture
Imclose.Tag = "1"
End If
End Sub
Private Sub Imclose_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Imclose.Picture = LoadPicture()
Imclose.Tag = ""
End Sub

Private Sub Immax_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Me.WindowState = 0 Then Immax.Picture = Immax2.Picture
If Me.WindowState = 2 Then Immax.Picture = IMus2.Picture
End Sub
Private Sub Immax_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Immax.Tag = "" Then
If Me.WindowState = 0 Then Immax.Picture = Immax1.Picture
If Me.WindowState = 2 Then Immax.Picture = IMus1.Picture
Immax.Tag = "1"
End If
End Sub
Private Sub Immax_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Immax.Picture = LoadPicture()
Immax.Tag = ""
End Sub

Private Sub pbottom_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Pbottom.Tag = ""
End Sub
Private Sub pbottom_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Pbottom.Tag = "1"
End Sub
Private Sub pbottom_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
If Pbottom.Tag <> "" Then
Dim pos As POINTAPI
GetCursorPos pos
gg = pos.y * 15 - Me.Top
If gg > 1500 Then Me.Height = gg '获得鼠标位置，用来改变窗体大小，这可是一个好办法哟
End If

End Sub

Private Sub Pright_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Pright.Tag = ""
End Sub
Private Sub Pright_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Pright.Tag = "1"
End Sub
Private Sub Pright_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
If Pright.Tag <> "" Then
Dim pos As POINTAPI
GetCursorPos pos
gg = pos.x * 15 - Me.Left
If gg > 2500 Then Me.Width = gg
End If

End Sub


Private Sub Pjiao_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Pjiao.Tag = ""
End Sub
Private Sub Pjiao_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Pjiao.Tag = "1"
End Sub
Private Sub Pjiao_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
If Pjiao.Tag <> "" Then
Dim pos As POINTAPI
GetCursorPos pos
gg = pos.x * 15 - Me.Left
gg2 = pos.y * 15 - Me.Top
If gg > 2500 Then Me.Width = gg
If gg2 > 1500 Then Me.Height = gg2

End If

End Sub

'Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Private Sub FS(aaa)

 Dim plays As Long
Dim bb As Integer
Dim i As Integer
bb = Len(Trim(aaa))
For i = 1 To bb
aa = Trim(Mid$(aaa, i, 1))
Select Case aa
  Case "0"
plays = sndPlaySound(App.Path + "\声音\" + "0.wav", &H0)
  Case "1"
  plays = sndPlaySound(App.Path + "\声音\" + "1.wav", &H0)
  Case "2"
plays = sndPlaySound(App.Path + "\声音\" + "2.wav", &H0)
  Case "3"
  plays = sndPlaySound(App.Path + "\声音\" + "3.wav", &H0)
Case "4"
plays = sndPlaySound(App.Path + "\声音\" + "4.wav", &H0)
Case "5"
plays = sndPlaySound(App.Path + "\声音\" + "5.wav", &H0)
Case "6"
plays = sndPlaySound(App.Path + "\声音\" + "6.wav", &H0)
  Case "7"
plays = sndPlaySound(App.Path + "\声音\" + "7.wav", &H0)
  Case "8"
  plays = sndPlaySound(App.Path + "\声音\" + "8.wav", &H0)
    Case "9"
plays = sndPlaySound(App.Path + "\声音\" + "9.wav", &H0)
End Select
Next i
End Sub
Private Sub FaSheng(aaa)
Select Case aaa
  Case vbKey0
       sndPlaySound App.Path & "\声音\0.wav", &H1
  Case vbKey1
       sndPlaySound App.Path + "\声音\1.wav", &H1
  Case vbKey2
       sndPlaySound App.Path + "\声音\2.wav", &H0
  Case vbKey3
       sndPlaySound App.Path + "\声音\3.wav", &H0
  Case vbKey4
       sndPlaySound App.Path + "\声音\4.wav", &H0
  Case vbKey5
       sndPlaySound App.Path + "\声音\5.wav", &H0
  Case vbKey6
       sndPlaySound App.Path + "\声音\6.wav", &H0
  Case vbKey7
       sndPlaySound App.Path + "\声音\7.wav", &H0
  Case vbKey8
       sndPlaySound App.Path + "\声音\8.wav", &H0
  Case vbKey9
       sndPlaySound App.Path + "\声音\9.wav", &H0
  Case vbKeyNumpad0
       sndPlaySound App.Path & "\声音\0.wav", &H0
  Case vbKeyNumpad1
       sndPlaySound App.Path + "\声音\1.wav", &H0
  Case vbKeyNumpad2
       sndPlaySound App.Path + "\声音\2.wav", &H0
  Case vbKeyNumpad3
       sndPlaySound App.Path + "\声音\3.wav", &H0
  Case vbKeyNumpad4
       sndPlaySound App.Path + "\声音\4.wav", &H0
  Case vbKeyNumpad5
       sndPlaySound App.Path + "\声音\5.wav", &H0
  Case vbKeyNumpad6
       sndPlaySound App.Path + "\声音\6.wav", &H0
  Case vbKeyNumpad7
       sndPlaySound App.Path + "\声音\7.wav", &H0
  Case vbKeyNumpad8
       sndPlaySound App.Path + "\声音\8.wav", &H0
  Case vbKeyNumpad9
       sndPlaySound App.Path + "\声音\9.wav", &H0
End Select
End Sub
Private Sub Text_GotFocus(Index As Integer)
'    If Index = 3 Then
'    Data1.RecordSource = "select 姓名,照片号" & "," & Trim(Text(0).Text) & " From 学生情况表"
'Data1.Refresh
'Data1.Recordset.MoveFirst
'Text(3).DataField = Trim(Text(0).Text)
'End If
End Sub

Private Sub Text_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
Select Case Index
Case 0
FaSheng KeyCode
If KeyCode = vbKeyF1 Then
Text(0).Locked = True
Text(0).BackColor = &HC0C0C0
End If
If KeyCode = vbKeyF2 Then
Text(0).Locked = False
Text(0).BackColor = &HC0FFC0
End If
Case 1
FaSheng KeyCode
If KeyCode = vbKeyF1 Then
Text(1).Locked = True
Text1.Visible = False
Text(1).BackColor = &HC0C0C0
End If
If KeyCode = vbKeyF2 Then
Text(1).Locked = False
'Text1.Visible = True
Text(1).BackColor = &HC0FFC0
End If
If KeyCode = vbKeyF3 Then
Text(1).Visible = False
Text1.Visible = True
Text(1).BackColor = &HC0FFC0
End If

Case 2
FaSheng KeyCode
If KeyCode = vbKeyF1 Then
Text(2).Locked = True
Text(2).BackColor = &HC0C0C0
End If
If KeyCode = vbKeyF2 Then
Text(2).Locked = False
Text(2).BackColor = &HC0FFC0
End If
Case 3
FaSheng KeyCode
If KeyCode = vbKeyF1 Then
Text(3).Locked = True
Text(3).BackColor = &HC0C0C0
End If
If KeyCode = vbKeyF2 Then
Text(3).Locked = False
Text(3).BackColor = &HC0FFC0
End If
End Select
End Sub

Private Sub Text_KeyPress(Index As Integer, KeyAscii As Integer)
On Error Resume Next
Select Case Index
 Case 0
     If KeyAscii = 13 And Text(0).Text <> "" Then
        If Text(1).Locked = False Then
           Text(1).SetFocus
        Else
           If Text(2).Locked = False Then
              Text(2).SetFocus
           Else
              If Text(3).Locked = False Then Text(3).SetFocus
           End If
        End If
     End If
 Case 1
     If KeyAscii = 13 Then
'        Data1.RecordSource = "select 姓名,照片号" & "," & Trim(Text(0).Text) & " From 学生情况表 WHERE 照片号 =" & "'" & Trim(Text(1).Text) & "'"
'        Data1.Refresh
'        Data1.Recordset.MoveFirst
'        Text(3).DataField = Trim(Text(0).Text)

        If Text(2).Locked = False Then
           Text(2).SetFocus
        Else
           If Text(3).Locked = False Then Text(3).SetFocus
        End If
    End If
 Case 2
     If KeyAscii = 13 Then Text(3).SetFocus
 Case 3
     If KeyAscii = 13 Then
     Text1.Text = ""
        If Text1.Visible = True Then
           Text1.SetFocus
        Else
           If Text(0).Locked = False Then
              Text(0).SetFocus
              Else
              Text(3).SetFocus
           End If
        End If
FS (Text(3).Text)
tt = Val(Text(3).Text)
 If tt >= 0 And tt <= 150 And Text(3).Text <> "" Then
        If Data1.Recordset.EOF Then
              MsgBox "录入结束"
                Data1.RecordSource = "select 姓名,照片号" & "," & Trim(Text(0).Text) & " From 学生情况表 "
                Data1.Refresh
            Data1.Recordset.MoveFirst
            
         Else
               Data1.Recordset.MoveNext
               a = a + 1
               Data1.Recordset.Edit
         End If
 Else
    MsgBox "输入的不是数字或数字大于150，请重新输入数字", , "输入错误"
    Text(3).Text = ""
  End If
End If
End Select
End Sub
Private Sub Text_LostFocus(Index As Integer)
On Error Resume Next
If Index = 0 Then
Text(3).DataField = Trim(Text(0).Text)
End If
Text(0).Locked = True
Text(0).BackColor = &HC0C0C0
'aa:
'MsgBox "请选择学科"

End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
On Error Resume Next
     If KeyAscii = 13 Then
     Data1.Recordset.FindFirst "照片号 =" & "'" & Trim(Text1.Text) & "'"
'        Data1.RecordSource = "select 姓名,照片号" & "," & Trim(Text(0).Text) & " From 学生情况表 WHERE 照片号 =" & "'" & Trim(Text1.Text) & "'"
'        Data1.Refresh
        If Data1.Recordset.RecordCount = 0 Then
        MsgBox "没有这位同学"
        
        End If
'        Data1.Recordset.MoveFirst
        Text(3).DataField = Trim(Text(0).Text)
        Text(3).SetFocus
        Text(1).Visible = True
'     FaSheng (Text(3).Text)
     End If
End Sub

Private Sub Text1_LostFocus()
'Text1.Visible = False
'Text(1).Visible = True
End Sub

Private Sub Timer1_Timer()
 Data1.caption = a
End Sub