?? form1.frm
字號(hào):
Grid2.Column(2).CellType = cellComboBox
Set qy1 = cnn.Execute("select 課程名稱 from 課程")
Grid2.ComboBox(2).Clear
Do While Not qy1.EOF
Grid2.ComboBox(2).AddItem qy1.Fields(0)
qy1.MoveNext
Loop
End Sub
Private Sub asPopup9_Click(Cancel As Boolean)
End
End Sub
Private Sub c1_Click(Index As Integer) '提交內(nèi)容到函數(shù)執(zhí)行，4為當(dāng)前菜單（0-4），index是按鈕數(shù)組名稱
cmove 4, Index
End Sub
Private Sub cmove(s As Integer, i As Integer) '菜單智能移動(dòng)函數(shù)代碼
Dim j As Integer
Dim x, y, z, x1, y1 As Integer
x = s
y = s
z = s
x1 = s
j = 0
Do While s > 0
If je > i Then
Do While x > i
Do While y >= x
j = j + 360
y = y - 1
Loop
c1(x).Top = Fre1.Height - j
x = x - 1
Loop
Else
'-----------------向上代碼
For x = 0 To i
For y = 0 To x
j = j + 360
Next
c1(x).Top = j - 360
j = 0
Next
End If
s = s - 1
For y1 = 0 To x1
If y1 = i Then
Fre2(y1).Visible = True
Fre2(y1).Top = c1(y1).Top + c1(y1).Height
If y1 <> z Then
Fre2(y1).Height = c1(y1 + 1).Top - Fre2(y1).Top
Else
Fre2(y1).Height = Fre1.Height - c1(y1).Top - c1(y1).Height
End If
Else
Fre2(y1).Visible = False
End If
Next
Loop
je = i
End Sub
Private Sub cgdel_Click()
Call XPButton6_Click
End Sub
Private Sub cgedit_Click()
Call XPButton4_Click
End Sub
Private Sub delstudent_Click()
Call XPButton6_Click
End Sub
Private Sub editstudent_Click()
Call XPButton4_Click
End Sub
Private Sub findcg_Click()
If hang = 0 Then
Exit Sub
End If
Grid1.Visible = False
Grid2.Visible = True
tkbase = "學(xué)生與課程"
fnumber = 5
sql = "select * from 學(xué)生與課程 where 學(xué)號(hào)='" & Grid1.Cell(hang, 1).Text & "'"
gridpz2
datagrid
gridsave = False
gridedit = True
griddel = True
Grid2.Column(1).Locked = True
Grid2.Column(2).Locked = True
Grid2.Column(3).Locked = True
End Sub
Private Sub Grid1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then
PopupMenu student
End If
End Sub
Private Sub Grid1_RowColChange(ByVal Row As Long, ByVal Col As Long)
hang = Row
If gridsave = True And Col = 5 Then '確認(rèn)默認(rèn)年齡在20歲左右
If Row <> 0 Then
Grid1.Cell(Row, 5).Text = Date - 7300
End If
End If
End Sub
Private Sub Grid1_Validate(Cancel As Boolean) '設(shè)定TAB鍵切換
Dim nActiveRow As Long, nActiveCol As Long
Const VK_TAB = 9
If GetKeyState(VK_TAB) < 0 Then
nActiveRow = Grid1.ActiveCell.Row
nActiveCol = Grid1.ActiveCell.Col
If nActiveCol < Grid1.Cols - 1 Then
Grid1.Range(nActiveRow, nActiveCol + 1, _
nActiveRow, nActiveCol + 1).Selected
End If
Cancel = True
End If
End Sub
Private Sub Form_Load()
Label2.Caption = "歡迎使用xhlbwb作品，購(gòu)買完整源碼請(qǐng)加QQ342483870,此源碼20元，論文20元,去除注冊(cè)提示框,詳細(xì)功能請(qǐng)使用己注冊(cè)版的EXE文件"
XPFrame1.BackColor = RGB(84, 201, 134)
form1.BackColor = RGB(168, 217, 189)
With Grid1
.AllowUserResizing = True
.DisplayFocusRect = False
.ExtendLastCol = True
.Appearance = Flat
.FixedRowColStyle = Flat
.ScrollBarStyle = Flat
.DefaultFont.Name = "Tahoma"
.DefaultFont.SIZE = 8
.BackColorFixed = RGB(84, 201, 134)
.BackColorFixedSel = RGB(84, 201, 134)
.BackColorBkg = RGB(198, 229, 211)
.BackColorScrollBar = RGB(198, 229, 211)
.BackColor1 = RGB(231, 235, 247)
.BackColor2 = RGB(198, 229, 211)
.GridColor = RGB(148, 190, 231)
.Column(0).Width = 0
End With
With Grid2
.AllowUserResizing = True
.DisplayFocusRect = False
.ExtendLastCol = True
.Appearance = Flat
.FixedRowColStyle = Flat
.ScrollBarStyle = Flat
.AllowUserResizing = True
.DisplayFocusRect = False
.ExtendLastCol = True
.Appearance = Flat
.FixedRowColStyle = Flat
.ScrollBarStyle = Flat
.DefaultFont.Name = "Tahoma"
.DefaultFont.SIZE = 8
.BackColorFixed = RGB(84, 201, 134)
.BackColorFixedSel = RGB(84, 201, 134)
.BackColorBkg = RGB(198, 229, 211)
.BackColorScrollBar = RGB(198, 229, 211)
.BackColor1 = RGB(231, 235, 247)
.BackColor2 = RGB(198, 229, 211)
.GridColor = RGB(148, 190, 231)
.Column(0).Width = 0
End With
je = 4
Dim fr As Integer
Fre1.BackColor = RGB(168, 217, 189)
For fr = 0 To 4
Fre2(fr).Visible = False
Fre2(fr).BackColor = RGB(168, 217, 189)
Next
Grid2.Visible = False
Call c1_Click(0)
End Sub
Private Sub Grid2_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then
MsgBox "非完整源碼不支持鼠標(biāo)右鍵！"
End If
End Sub
Private Sub Grid2_RowColChange(ByVal Row As Long, ByVal Col As Long)
hang = Row
End Sub
Private Sub datagrid()
griddelete = True '允許刪除
gridedit = True
If tkbase = "學(xué)生信息" Then
If qy1.State = adStateOpen Then '表狀態(tài)
qy1.Close
End If
qy1.Open sql, cnn, adOpenStatic, adLockReadOnly, adCmdText
For i = 1 To fnumber
Grid1.Cell(0, i).Text = qy1.Fields(i - 1).Name
Next
qy1.PageSize = 20
nnum = qy1.PageCount
If qy1.PageCount = 0 Then
nnum = 1
End If
numpage = 1
Label1.Caption = "共" & nnum & "頁(yè) 第" & numpage & "頁(yè)"
Grid1.Rows = 1
Grid1.Rows = 21
If qy1.RecordCount = 0 Then
Exit Sub
End If
qy1.AbsolutePage = numpage
For i = 1 To qy1.PageSize '設(shè)定讀取行
For j = 1 To fnumber '設(shè)定讀取列
If qy1.EOF = True Then
Exit Sub
End If
If qy1.Fields(j - 1) <> noNull Then '空值的處理
Grid1.Cell(i, j).Text = qy1.Fields(j - 1)
Else
Grid1.Cell(i, j).Text = ""
End If
Next
If qy1.EOF = False Then
qy1.MoveNext '讀取下一記錄
Else
Exit Sub
End If
Next
ElseIf tkbase = "學(xué)生與課程" Then
If qy1.State = adStateOpen Then '表狀態(tài)
qy1.Close
End If
qy1.Open sql, cnn, adOpenStatic, adLockReadOnly, adCmdText
For i = 1 To fnumber
Grid2.Cell(0, i).Text = qy1.Fields(i - 1).Name
Next
qy1.PageSize = 20
nnum = qy1.PageCount
If qy1.PageCount = 0 Then
nnum = 1
End If
numpage = 1
Label1.Caption = "共" & nnum & "頁(yè) 第" & numpage & "頁(yè)"
Grid2.Rows = 1
Grid2.Rows = 21
If qy1.RecordCount = 0 Then
Exit Sub
End If
qy1.AbsolutePage = numpage
For i = 1 To qy1.PageSize '設(shè)定讀取行
For j = 1 To fnumber '設(shè)定讀取列
If qy1.EOF = True Then
Exit Sub
End If
If qy1.Fields(j - 1) <> noNull Then '空值的處理
Grid2.Cell(i, j).Text = qy1.Fields(j - 1)
Else
Grid2.Cell(i, j).Text = ""
End If
Next
If qy1.EOF = False Then
qy1.MoveNext '讀取下一記錄
Else
Exit Sub
End If
Next
End If
End Sub
Private Sub Grid2_Validate(Cancel As Boolean)
Dim nActiveRow As Long, nActiveCol As Long
Const VK_TAB = 9
If GetKeyState(VK_TAB) < 0 Then
nActiveRow = Grid1.ActiveCell.Row
nActiveCol = Grid1.ActiveCell.Col
If nActiveCol < Grid1.Cols - 1 Then
Grid1.Range(nActiveRow, nActiveCol + 1, _
nActiveRow, nActiveCol + 1).Selected
End If
Cancel = True
End If
End Sub
Private Sub renovate_Click()
Call asPopup1_Click(False)
End Sub
Private Sub returncg_Click()
Grid1.Visible = True
Grid2.Visible = False
End Sub
Private Sub savestudent_Click()
Call XPButton5_Click
End Sub
Private Sub XPButton1_Click()
MsgBox "非完整源碼只可顯示20條記錄！"
End Sub
Private Sub XPButton2_Click()
MsgBox "非完整源碼只可顯示20條記錄！"
End Sub
Private Sub XPButton4_Click()
If gridedit = False Then
MsgBox "當(dāng)前修改操作不被允許!", vbInformation, "非使用對(duì)象"
Exit Sub
End If
If hang = 0 Then
Exit Sub
End If
Dim delok As String
Select Case tkbase
Case "學(xué)生信息"
MsgBox "非完整源碼不可修改！"
Case "學(xué)生與課程"
MsgBox "非完整源碼不可修改！"
End Select
End Sub
Private Sub XPButton5_Click()
If tkbase = "" Then
MsgBox "表指向不明，請(qǐng)確認(rèn)", vbInformation, "提示"
Exit Sub
End If
If gridsave = False Then
MsgBox "當(dāng)前不允許保存！", vbInformation, "提示"
Exit Sub
End If
Select Case tkbase
Case "學(xué)生信息"
For i = 1 To 20 '處理重名數(shù)據(jù)
If Grid1.Cell(i, 1).Text <> "" Then
Set qy1 = cnn.Execute("select 學(xué)號(hào) from 學(xué)生信息 where 學(xué)號(hào)='" & Grid1.Cell(i, 1).Text & "'")
If qy1.EOF = False Then
MsgBox "第" & i & "行的學(xué)號(hào)在數(shù)據(jù)庫(kù)里出現(xiàn)重復(fù)，請(qǐng)檢查", vbInformation, "錯(cuò)誤"
Grid1.Cell(i, 1).SetFocus
Exit Sub
End If
End If
Next
For i = 1 To 20
For n = 1 To fnumber
Select Case n
Case 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12
If Grid1.Cell(i, 1).Text <> "" Then
If Grid1.Cell(i, n).Text = "" Then
MsgBox "第" & i & "行的--[" & Grid1.Cell(0, n).Text & "]--字段不允許為空!", vbInformation, "提示"
Grid1.Cell(i, n).SetFocus
Exit Sub
End If
End If
End Select
Next
If Grid1.Cell(i, 1).Text <> "" Then
sql = "insert into " & tkbase & " values('"
For j = 1 To fnumber - 1
sql = sql & Grid1.Cell(i, j).Text & "','"
Next
sql = sql & Grid1.Cell(i, fnumber).Text & "')"
Set qy1 = cnn.Execute(sql)
End If
Next
MsgBox "命令執(zhí)行完畢!", vbInformation, "完成"
Grid1.Rows = 1
Grid1.Rows = 21
Case "學(xué)生與課程"
MsgBox "非完整源碼不可保證學(xué)生與課程的記錄！"
End Select
gridsave = False
griddelete = False '拒絕刪除
gridedit = False
End Sub
Private Sub XPButton6_Click()
If griddelete = False Then
MsgBox "當(dāng)前刪除操作不被允許!", vbInformation, "非使用對(duì)象"
Exit Sub
End If
If hang = 0 Then
Exit Sub
End If
Dim delok As String
Select Case tkbase
Case "學(xué)生信息"
MsgBox "非完整源碼不可修改！"
Case "學(xué)生與課程"
If Grid2.Cell(hang, 1).Text = "" Then
Exit Sub
End If
delok = MsgBox("確認(rèn)刪除" & Grid2.Cell(hang, 3).Text & "的<" & Grid2.Cell(hang, 2).Text & ">成績(jī)嗎？？", vbQuestion + vbOKCancel, "注意:此操作將會(huì)將學(xué)生資料與成績(jī)資料完全清除")
If delok = vbOK Then
sql = "delete from " & tkbase & " where 學(xué)號(hào)='" & Grid2.Cell(hang, 3).Text & "' and 課程號(hào)='" & Grid2.Cell(hang, 1).Text & "'"
Set qy1 = cnn.Execute(sql)
MsgBox "目標(biāo)己刪除完成!", , "提示"
End If
End Select
End Sub
Private Sub XPButton8_Click(Index As Integer)
Call findcg_Click
End Sub
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -