📄 frmqueryroom.frm
字号:
TabIndex = 23
Top = 4260
Width = 1695
End
Begin VB.Label Label11
Alignment = 2 'Center
BackColor = &H00808000&
BorderStyle = 1 'Fixed Single
Caption = "八月份"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FFFF&
Height = 375
Left = 6090
TabIndex = 21
Top = 3780
Width = 1695
End
Begin VB.Label Label10
Alignment = 2 'Center
BackColor = &H00808000&
BorderStyle = 1 'Fixed Single
Caption = "七月份"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FFFF&
Height = 375
Left = 6090
TabIndex = 19
Top = 3300
Width = 1695
End
Begin VB.Label Label9
Alignment = 2 'Center
BackColor = &H00808000&
BorderStyle = 1 'Fixed Single
Caption = "六月份"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FFFF&
Height = 375
Left = 6090
TabIndex = 17
Top = 2820
Width = 1695
End
Begin VB.Label Label8
Alignment = 2 'Center
BackColor = &H00808000&
BorderStyle = 1 'Fixed Single
Caption = "五月份"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FFFF&
Height = 375
Left = 6090
TabIndex = 15
Top = 2340
Width = 1695
End
Begin VB.Label Label7
Alignment = 2 'Center
BackColor = &H00808000&
BorderStyle = 1 'Fixed Single
Caption = "四月份"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FFFF&
Height = 375
Left = 6090
TabIndex = 13
Top = 1860
Width = 1695
End
Begin VB.Label Label6
Alignment = 2 'Center
BackColor = &H00808000&
BorderStyle = 1 'Fixed Single
Caption = "三月份"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FFFF&
Height = 375
Left = 6090
TabIndex = 11
Top = 1380
Width = 1695
End
Begin VB.Label Label5
Alignment = 2 'Center
BackColor = &H00808000&
BorderStyle = 1 'Fixed Single
Caption = "二月份"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FFFF&
Height = 375
Left = 6090
TabIndex = 9
Top = 900
Width = 1695
End
Begin VB.Label Label4
Alignment = 2 'Center
BackColor = &H00808000&
BorderStyle = 1 'Fixed Single
Caption = "一月份"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FFFF&
Height = 375
Index = 0
Left = 6090
TabIndex = 7
Top = 420
Width = 1695
End
Begin VB.Label Label3
Alignment = 2 'Center
BackColor = &H00808000&
BorderStyle = 1 'Fixed Single
Caption = "宿舍成员"
BeginProperty Font
Name = "宋体"
Size = 15
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FFFF&
Height = 495
Left = 2970
TabIndex = 5
Top = 2340
Width = 1335
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H00808000&
BorderStyle = 1 'Fixed Single
Caption = "综合成绩"
BeginProperty Font
Name = "宋体"
Size = 15
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FFFF&
Height = 495
Left = 2970
TabIndex = 4
Top = 1500
Width = 1335
End
Begin VB.Label Label1
Alignment = 2 'Center
BackColor = &H00808000&
BorderStyle = 1 'Fixed Single
Caption = "宿舍号"
BeginProperty Font
Name = "宋体"
Size = 15
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FFFF&
Height = 495
Left = 2970
TabIndex = 2
Top = 420
Width = 1335
End
Begin VB.Shape Shape1
BorderColor = &H00FF00FF&
BorderStyle = 6 'Inside Solid
FillColor = &H00C0C0FF&
FillStyle = 0 'Solid
Height = 6195
Left = 150
Shape = 4 'Rounded Rectangle
Top = 120
Width = 9195
End
Begin VB.Menu MNUFILE
Caption = "文件[&F]"
Begin VB.Menu MNUEXIT
Caption = "退出[&X]"
End
End
End
Attribute VB_Name = "frmQueryRoom"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdExit_Click()
On Error Resume Next
Unload Me
Frmstart.Show
End Sub
Private Sub cmdPrint_Click()
On Error Resume Next
Dim sngTpp As Single
Dim intWidtht As Integer
Dim intwidthp As Integer
Screen.MousePointer = 11
frmSSHReport.Show
frmSSHReport.rptReports.ReportFileName = App.Path + "\print\room.rpt"
frmSSHReport.rptReports.Destination = 0
frmSSHReport.rptReports.WindowParentHandle = frmSSHReport.hWnd
frmSSHReport.rptReports.WindowTop = 0
frmSSHReport.rptReports.WindowLeft = 0
If frmSSHReport.WindowState = 0 Then
frmSSHReport.Left = 0
frmSSHReport.Top = 0
frmSSHReport.Height = 9600
frmSSHReport.Width = 9600
End If
intWidtht = frmSSHReport.ScaleWidth
frmSSHReport.ScaleMode = 3
intwidthp = frmSSHReport.ScaleWidth
frmSSHReport.ScaleMode = 1
sngTpp = intWidtht / intwidthp
frmSSHReport.rptReports.WindowWidth = frmSSHReport.ScaleWidth / sngTpp
frmSSHReport.rptReports.WindowHeight = frmSSHReport.ScaleHeight / sngTpp
frmSSHReport.Caption = "Preview"
frmSSHReport.rptReports.WindowTitle = "print"
frmSSHReport.rptReports.DataFiles(0) = App.Path + "\database\student.mdb"
DoEvents
frmSSHReport.rptReports.Action = 1
Screen.MousePointer = 0
End Sub
Private Sub Form_Load()
On Error Resume Next
Dim sqlSS As String
Dim recSS As Recordset
Dim I As Integer
Line1.X1 = 0
Line1.X2 = frmQueryRoom.Width
frmQueryRoom.Picture = LoadPicture(App.Path + "\picture\sky.bmp")
sqlSS = "select distinct ss from zbqkb"
Set recSS = dbStudent.OpenRecordset(sqlSS, dbOpenSnapshot)
If recSS.RecordCount <> 0 Then
recSS.MoveLast
recSS.MoveFirst
If Not IsNull(recSS!SS) Then
lstSSH.AddItem "" + Trim(recSS!SS) + ""
End If
For I = 1 To recSS.RecordCount - 1
recSS.MoveNext
lstSSH.AddItem "" + Trim(recSS!SS) + ""
Next I
Else
MsgBox "数据库无宿舍号!", vbCritical
End If
On Error Resume Next
'frmQueryRoom.Picture = LoadPicture(App.Path + "\PICTURE\SKY.BMP")
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Unload Me
'frmRoomMDI.Show
'frmRoomMDI.Enabled = True
End Sub
Private Sub lstSSH_Click()
On Error Resume Next
Dim sqlUpdate As String
Dim recUpdate As Recordset
Dim recMember As Recordset
Dim sqlMember As String
txtSSH = lstSSH.List(lstSSH.ListIndex)
'显示各框数字
sqlUpdate = "select * from room where ssh='" + Trim(txtSSH) + "'"
Set recUpdate = dbStudent.OpenRecordset(sqlUpdate, dbOpenSnapshot)
lstCY.Clear
txtZHF = ""
txtOne = ""
txtTwo = ""
txtThree = ""
txtFour = ""
txtFive = ""
txtSix = ""
txtSeven = ""
txtEight = ""
txtNine = ""
txtTen = ""
txtEleven = ""
txtTwelve = ""
If recUpdate.RecordCount <> 0 Then
If Not IsNull(recUpdate!one) Then
txtOne = recUpdate!one
Else
txtOne = ""
End If
If Not IsNull(recUpdate!two) Then
txtTwo = recUpdate!two
Else
txtTwo = ""
End If
If Not IsNull(recUpdate!three) Then
txtThree = recUpdate!three
Else
txtThree = ""
End If
If Not IsNull(recUpdate!four) Then
txtFour = recUpdate!four
Else
txtFour = ""
End If
If Not IsNull(recUpdate!five) Then
txtFive = recUpdate!five
Else
txtFive = ""
End If
If Not IsNull(recUpdate!six) Then
txtSix = recUpdate!six
Else
txtSix = ""
End If
If Not IsNull(recUpdate!seven) Then
txtSeven = recUpdate!seven
Else
txtSeven = ""
End If
If Not IsNull(recUpdate!eight) Then
txtEight = recUpdate!eight
Else
txtEight = ""
End If
If Not IsNull(recUpdate!nine) Then
txtNine = recUpdate!nine
Else
txtNine = ""
End If
If Not IsNull(recUpdate!ten) Then
txtTen = recUpdate!ten
Else
txtTen = ""
End If
If Not IsNull(recUpdate!eleven) Then
txtEleven = recUpdate!eleven
Else
txtEleven = ""
End If
If Not IsNull(recUpdate!twelve) Then
txtTwelve = recUpdate!twelve
Else
txtTwelve = ""
End If
If Not IsNull(recUpdate!ZHF) Then
txtZHF = recUpdate!ZHF
Else
txtZHF = ""
End If
End If
sqlMember = "select xm from zbqkb where ss='" + Trim(txtSSH) + "' "
Set recMember = dbStudent.OpenRecordset(sqlMember, dbOpenSnapshot)
If recMember.RecordCount <> 0 Then
recMember.MoveLast
recMember.MoveFirst
lstCY.AddItem "" + Trim(recMember!XM) + ""
For I = 1 To recMember.RecordCount - 1
recMember.MoveNext
lstCY.AddItem "" + Trim(recMember!XM) + ""
Next I
Else
lstCY.Clear
End If
End Sub
Private Sub MNUEXIT_Click()
On Error Resume Next
Call cmdExit_Click
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -