dim i, j, n as integer
dim sql as string
private declare function getkeystate lib "user32" _
(byval nvirtkey as long) as integer
public je as integer '记忆菜单上次数值，实现数据传送
private sub acg_click()
call aspopup7_click(false)
end sub
private sub addcg_click()
call aspopup6_click(false)
end sub
private sub addstudent_click()
call aspopup2_click(false)
end sub
private sub aspopup1_click(cancel as boolean)
grid1.visible = true
grid2.visible = false
tkbase = "学生信息"
fnumber = 13
sql = "select * from " & tkbase
grid1pz '执行grid1的分配空间任务
datagrid '按要求读取数据空间
end sub
private sub grid1pz()
grid1.cols = fnumber + 1
grid1.column(1).width = 120
grid1.column(2).width = 100
grid1.column(3).width = 80
grid1.column(4).width = 40
grid1.column(5).width = 80
grid1.column(6).width = 30
grid1.column(7).width = 100
grid1.column(8).width = 200
grid1.column(9).width = 60
grid1.column(10).width = 80
grid1.column(11).width = 100
grid1.column(12).width = 100
grid1.column(13).width = 100
grid1.column(4).celltype = cellcombobox
grid1.combobox(4).clear
grid1.combobox(4).additem "男"
grid1.combobox(4).additem "女"
grid1.column(5).celltype = cellcalendar
grid1.column(1).locked = true
end sub
private sub aspopup2_click(cancel as boolean)
grid1.visible = true
grid2.visible = false
tkbase = "学生信息"
fnumber = 13
set qy1 = cnn.execute("select * from " & tkbase)
grid1pz
for i = 1 to fnumber
grid1.cell(0, i).text = qy1.fields(i - 1).name
next
grid1.column(1).locked = false
grid1.rows = 1
grid1.rows = 21
gridsave = true '允许保存
griddelete = false '拒绝删除
gridedit = false
end sub
private sub aspopup3_click(cancel as boolean)
dim fo2 as ctranslucentform
set fo2 = new ctranslucentform
fo2.hwnd = form2.hwnd
fo2.alpha = 90 / 100 * 255
me.windowstate = vbminimized
load form2
form2.show 1
end sub
private sub aspopup4_click(cancel as boolean)
dim fo2 as ctranslucentform
set fo2 = new ctranslucentform
fo2.hwnd = form4.hwnd
fo2.alpha = 90 / 100 * 255
me.windowstate = vbminimized
load form4
form4.show 1
end sub
private sub aspopup5_click(cancel as boolean)
msgbox "非完整源码不可查询！"
end sub
private sub aspopup6_click(cancel as boolean)
grid1.visible = false
grid2.visible = true
tkbase = "学生与课程"
fnumber = 5
gridpz2
set qy1 = cnn.execute("select * from " & tkbase)
for i = 1 to fnumber
grid2.cell(0, i).text = qy1.fields(i - 1).name
next
grid2.rows = 1
grid2.rows = 21
gridsave = true
gridedit = false
griddel = false
grid2.column(1).locked = false
grid2.column(2).locked = false
grid2.column(3).locked = false
end sub
private sub aspopup7_click(cancel as boolean)
grid1.visible = false
grid2.visible = true
tkbase = "学生与课程"
fnumber = 5
sql = "select * from " & tkbase
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 gridpz2()
grid2.cols = 7
grid2.column(1).celltype = cellcombobox
set qy1 = cnn.execute("select 课程号 from 课程")
grid2.combobox(1).clear
do while not qy1.eof
grid2.combobox(1).additem qy1.fields(0)
qy1.movenext
loop
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) '提交内容到函数执行，4为当前菜单（0-4），index是按钮数组名称
cmove 4, index
end sub
private sub cmove(s as integer, i as integer) '菜单智能移动函数代码
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 = "学生与课程"
fnumber = 5
sql = "select * from 学生与课程 where 学号='" & 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 '确认默认年龄在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) '设定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 = "欢迎使用pp作品，购买完整源码请加qq649462944,此源码+程序+论文68元,去除注册提示框,详细功能请使用己注册版的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 "非完整源码不支持鼠标右键！"
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 = "学生信息" then
if qy1.state = adstateopen then '表状态
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 & "页 第" & numpage & "页"
grid1.rows = 1
grid1.rows = 21
if qy1.recordcount = 0 then
exit sub
end if
qy1.absolutepage = numpage
for i = 1 to qy1.pagesize '设定读取行
for j = 1 to fnumber '设定读取列
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 = "学生与课程" then
if qy1.state = adstateopen then '表状态
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 & "页 第" & numpage & "页"
grid2.rows = 1
grid2.rows = 21
if qy1.recordcount = 0 then
exit sub
end if
qy1.absolutepage = numpage
for i = 1 to qy1.pagesize '设定读取行
for j = 1 to fnumber '设定读取列
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 "当前修改操作不被允许!", vbinformation, "非使用对象"
exit sub
end if
if hang = 0 then
exit sub
end if
dim delok as string
end sub
private sub xpbutton5_click()
if tkbase = "" then
msgbox "表指向不明，请确认", vbinformation, "提示"
exit sub
end if
if gridsave = false then
msgbox "当前不允许保存！", vbinformation, "提示"
exit sub
end if
select case tkbase
case "学生信息"
for i = 1 to 20 '处理重名数据
if grid1.cell(i, 1).text <> "" then
set qy1 = cnn.execute("select 学号 from 学生信息 where 学号='" & grid1.cell(i, 1).text & "'")
if qy1.eof = false then
msgbox "第" & i & "行的学号在数据库里出现重复，请检查", vbinformation, "错误"
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 "命令执行完毕!", vbinformation, "完成"
grid1.rows = 1
grid1.rows = 21
case "学生与课程"
msgbox "非完整源码不可保证学生与课程的记录！"
end select
gridsave = false
griddelete = false '拒绝删除
gridedit = false
end sub
private sub xpbutton6_click()
if griddelete = false then
msgbox "当前删除操作不被允许!", vbinformation, "非使用对象"
exit sub
end if
if hang = 0 then
exit sub
end if
dim delok as string
select case tkbase
case "学生信息"
msgbox "非完整源码不可修改！"
case "学生与课程"
if grid2.cell(hang, 1).text = "" then
exit sub
end if
delok = msgbox("确认删除" & grid2.cell(hang, 3).text & "的<" & grid2.cell(hang, 2).text & ">成绩吗？？", vbquestion + vbokcancel, "注意:此操作将会将学生资料与成绩资料完全清除")
if delok = vbok then
sql = "delete from " & tkbase & " where 学号='" & grid2.cell(hang, 3).text & "' and 课程号='" & grid2.cell(hang, 1).text & "'"
set qy1 = cnn.execute(sql)
msgbox "目标己删除完成!", , "提示"
end if
end select
end sub
private sub xpbutton8_click(index as integer)
call findcg_click
end sub |
鲁公网安备 37120302000001号
