跪求 VB 课程设计 高手

学生档案管理系统 vb

——————————————附录程序清单及注释
程序清单6.1
Option Explicit
Dim Fi
leName As String '文件名，用于打开、保存文件
Dim UndoString As String '用于 Undo 操作
Dim UndoNew As String '用于 Undo 操作

Private Sub ImgUndoDisable()
'禁用“Undo”按钮
UndoString = ""
UndoNew = ""
ImgUndo.Enabled = False
ImgUndo.Picture = ImageDisable.ListImages("Undo").Picture
End Sub

Private Sub ImgUndoEnable()
'有效“Undo”按钮
ImgUndo.Enabled = True
ImgUndo.Picture = ImageUp.ListImages("Undo").Picture
End Sub

Private Sub Check_ImgPaste()
'设置粘贴按钮
If Len(Clipboard.GetText) > 0 Then
ImgPaste.Enabled = True
ImgPaste.Picture = ImageUp.ListImages("Paste").Picture
Else
ImgPaste.Enabled = False
ImgPaste.Picture = ImageDisable.ListImages("Paste").Picture
End If
End Sub

Private Sub Check_ImgCutCopy()
'设置剪切、复制按钮
If Text1.SelLength > 0 Then
ImgCut.Enabled = True
ImgCut.Picture = ImageUp.ListImages("Cut").Picture
ImgCopy.Enabled = True
ImgCopy.Picture = ImageUp.ListImages("Copy").Picture
Else
ImgCut.Enabled = False
ImgCut.Picture = ImageDisable.ListImages("Cut").Picture
ImgCopy.Enabled = False
ImgCopy.Picture = ImageDisable.ListImages("Copy").Picture
End If
End Sub
Private Sub BackColor_Click()
CommonDialog1.ShowColor
Text1.BackColor = CommonDialog1.Color
End Sub

Private Sub Box_Click()
'显停工具栏
If Box.Checked Then
'将停显工具栏
Box.Checked = False
CoolBar1.Visible = False
Else
Box.Checked = True
CoolBar1.Visible = True[NextPage]

End If

Form_Resize '重新调整控件位置
End Sub

Private Sub Close_Click()
Dim FileNum As Integer

If Len(FileName) > 0 Then
'有输入文件名
FileNum = FreeFile() '获得可用文件号
Open FileName For Output As FileNum '打开输出文件
'如果无指定文件，则创建新文件
Print #FileNum, Text1.Text '输出文本
Close FileNum '关闭文件
End If

Text1.Text = ""
FileName = ""
End Sub

Private Sub ComboSize_Click()
Text1.FontSize = Val(ComboSize.Text)
End Sub

Private Sub ComboFont_Click()
Text1.FontName = ComboFont.Text
End Sub

Private Sub Copy_Click()
Clipboard.SetText Text1.SelText '复制文本到剪裁板
End Sub

Private Sub Cut_Click()
Clipboard.SetText Text1.SelText '复制文本到剪裁板
Text1.SelText = "" '清选择的文本
End Sub

Private Sub DataTime_Click()
Text1.SelText = Now
End Sub

Private Sub Delete_Click()
Text1.SelText = "" '清选择的文本
End Sub

Private Sub Edit_Click()
'当程序显示“编辑”子菜单前，触发该程序
If Text1.SelLength > 0 Then
'文本框中有选中的文本
Cut.Enabled = True
Copy.Enabled = True
Delete.Enabled = True
Else
Cut.Enabled = False
Copy.Enabled = False
Delete.Enabled = False
End If

If Len(Clipboard.GetText()) > 0 Then
'剪裁板中有文本数据
Paste.Enabled = True
Else
'没有可粘贴的文本
Paste.Enabled = False
End If
End Sub

Private Sub Exit_Click()
Unload Me
End Sub

Private Sub FindText_KeyPress(KeyAscii As Integer)
Dim BeginPos As Long

If KeyAscii = 13 Then
BeginPos = InStr(1, Text1.Text, FindText.Text, vbTextCompare)
If BeginPos > 0 Then
Text1.SelStart = BeginPos - 1
Text1.SelLength = Len(FindText.Text)
End If
End If
End Sub

Private Sub Fontcolor_Click()
CommonDialog1.ShowColor
Text1.ForeColor = CommonDialog1.Color
End Sub

Private Sub Form_Load()
Dim i As Integer

'加载图像
ImgNew.Picture = ImageUp.ListImages("New").Picture
ImgOpen.Picture = ImageUp.ListImages("Open").Picture
ImgSave.Picture = ImageUp.ListImages("Save").Picture
ImgUndo.Picture = ImageDisable.ListImages("Undo").Picture
Check_ImgPaste
Check_ImgCutCopy

'加载系统字体
For i = 0 To Screen.FontCount - 1
ComboFont.AddItem Screen.Fonts(i)
Next i
End Sub

Private Sub Form_Resize()
Dim TextTop As Long

'修改工具条大小
CoolBar1.Top = Me.ScaleTop
Me.ScaleLeft
Text1.Width = Me.ScaleWidth
If Me.ScaleHeight > CoolBar1.Height Then
Text1.Height = Me.ScaleHeight - TextTop
Else
Text1.Height = 0
End If
End Sub

Private Sub ImgCopy_Click()
Copy_Click '复制
Check_ImgPaste
Check_ImgCutCopy
End Sub

Private Sub ImgCopy_MouseDown(Button As Integer, Shift As Integer,

X As Single, Y As Single)
'“按下”按钮
If Button = 1 Then
ImgCopy.Picture = ImageDown.ListImages("Copy").Picture
End If
End Sub

Private Sub ImgCopy_MouseMove(Button As Integer, Shift As Integer,

X As Single, Y As Single)
Label1 = "将选择的文本复制到剪裁板"

'判断鼠标位置,显示不同图像
If Button = 1 And (X > 0 And X < ImgNew.Width And Y > 0 And Y <

ImgNew.Height) Then
ImgCopy.Picture = ImageDown.ListImages("Copy").Picture[NextPage]

ElseIf Button = 1 Then
ImgCopy.Picture = ImageUp.ListImages("Copy").Picture
End If
End Sub
Private Sub ImgCopy_MouseUp(Button As Integer, Shift As Integer, X

As Single, Y As Single)
If Button = 1 Then
'“抬起”按钮
ImgCopy.Picture = ImageUp.ListImages("Copy").Picture
End If
End Sub

Private Sub ImgCut_Click()
'If Text1.SelLength > 0 Then
Cut_Click '剪切
Check_ImgPaste
Check_ImgCutCopy
'End If
End Sub

Private Sub ImgCut_MouseDown(Button As Integer, Shift As Integer,

X As Single, Y As Single)
If Button = 1 Then
'“按下”按钮
ImgCut.Picture = ImageDown.ListImages("Cut").Picture
End If
End Sub

Private Sub ImgCut_MouseMove(Button As Integer, Shift As Integer,

X As Single, Y As Single)
Label1 = "剪切选择的文字到剪裁板"

'判断鼠标位置,显示不同图像
If Button = 1 And (X > 0 And X < ImgNew.Width And Y > 0 And Y <

ImgNew.Height) Then
ImgCut.Picture = ImageDown.ListImages("Cut").Picture
ElseIf Button = 1 Then
ImgCut.Picture = ImageUp.ListImages("Cut").Picture
End If
End Sub

Private Sub ImgCut_MouseUp(Button As Integer, Shift As Integer, X

As Single, Y As Single)
If Button = 1 Then
'“抬起”按钮
ImgCut.Picture = ImageUp.ListImages("Cut").Picture
End If
End Sub

Private Sub ImgNew_Click()
New_Click
End Sub

Private Sub ImgNew_MouseDown(Button As Integer, Shift As Integer,

X As Single, Y As Single)
If Button = 1 Then
'“按下”按钮
ImgNew.Picture = ImageDown.ListImages("New").Picture
End If
End Sub

Private Sub ImgNew_MouseMove(Button As Integer, Shift As Integer,

X As Single, Y As Single)
Label1 = "创建新文件" '修改提示信息

'判断鼠标位置,显示不同图像
If Button = 1 And (X > 0 And X < ImgNew.Width And Y > 0 And Y <

ImgNew.Height) Then
ImgNew.Picture = ImageDown.ListImages("New").Picture
ElseIf Button = 1 Then
ImgNew.Picture = ImageUp.ListImages("New").Picture
End If
End Sub

Private Sub ImgNew_MouseUp(Button As Integer, Shift As Int
eger, X As Single, Y As Single)
If Button = 1 Then
'“抬起”按钮
ImgNew.Picture = ImageUp.ListImages("New").Picture
End If
End Sub

Private Sub ImgOpen_Click()
Open_Click
End Sub

Private Sub ImgOpen_MouseDown(Button As Integer, Shift As Integer,

X As Single, Y As Single)
'“按下”按钮
If Button = 1 Then
ImgOpen.Picture = ImageDown.ListImages("Open").Picture
End If
End Sub
Private Sub ImgOpen_MouseMove(Button As Integer, Shift As Integer,

X As Single, Y As Single)
Label1 = "选择文件名并打开文件"

'判断鼠标位置,显示不同图像
If Button = 1 And (X > 0 And X < ImgNew.Width And Y > 0 And Y <

ImgNew.Height) Then
ImgOpen.Picture = ImageDown.ListImages("Open").Picture
ElseIf Button = 1 Then
ImgOpen.Picture = ImageUp.ListImages("Open").Picture
End If
End Sub

Private Sub ImgOpen_MouseUp(Button As Integer, Shift As Integer, X

As Single, Y As Single)
If Button = 1 Then
'“抬起”按钮
ImgOpen.Picture = ImageUp.ListImages("Open").Picture
End If
End Sub

Private Sub ImgPaste_Click()
Paste_Click '粘贴
End Sub

Private Sub ImgPaste_MouseDown(Button As Integer, Shift As

Integer, X As Single, Y As Single)
If Button = 1 Then
'“按下”按钮
ImgPaste.Picture = ImageDown.ListImages("Paste").Picture[NextPage]

End If
End Sub

Private Sub ImgPaste_MouseMove(Button As Integer, Shift As

Integer, X As Single, Y As Single)
Label1 = "粘贴文本到当前光标位置"

'判断鼠标位置,显示不同图像
If Button = 1 And (X > 0 And X < ImgNew.Width And Y > 0 And Y <

ImgNew.Height) Then
ImgPaste.Picture = ImageDown.ListImages("Paste").Picture
ElseIf Button = 1 Then
ImgPaste.Picture = ImageUp.ListImages("Paste").Picture
End If
End Sub

Private Sub ImgPaste_MouseUp(Button As Integer, Shift As Integer,

X As Single, Y As Single)
If Button = 1 Then

eName For Output As FileNum '打开输出文件
'如果无指定文件，则创建新文件
Print #FileNum, Text1.Text '输出文本
Close FileNum '关闭文件
ImgUndoDisable
Else
MsgBox "不能保存无名文件" + Chr(13) + Chr(10) + "请选择“文件”菜单

的“保存”项", , "警告"
End If
End Sub

Private Sub ImgSave_MouseDown(Button As Integer, Shift As Integer,

X As Single, Y As Single)
If Button = 1 Then
ImgSave.Picture = ImageDown.ListImages("Save").Picture
End If
End Sub

Private Sub ImgSave_MouseMove(Button As Integer, Shift As Integer,

X As Single, Y As Single)
Label1 = "保存当前文件"

'判断鼠标位置,显示不同图像
If Button = 1 And (X > 0 And X < ImgNew.Width And Y > 0 And Y <

ImgNew.Height) Then
ImgSave.Picture = ImageDown.ListImages("Save").Picture
ElseIf Button = 1 Then
ImgSave.Picture = ImageUp.ListImages("Save").Picture
End If

Private Sub ImgUndo_MouseMove(Button As Integer, Shift As Integer,

X As Single, Y As Single)
Label1 = "取消当前操作"

'判断鼠标位置,显示不同图像
If Button = 1 And (X > 0 And X < ImgNew.Width And Y > 0 And Y <

ImgNew.Height) Then
ImgUndo.Picture = ImageDown.ListImages("Undo").Picture
ElseIf Button = 1 Then
ImgUndo.Picture = ImageUp.ListImages("Undo").Picture
End If
End Sub

Private Sub ImgUndo_MouseUp(Button As Integer, Shift As Integer, X

As Single, Y As Single)
If Button = 1 Then
'“抬起”按钮
ImgUndo.Picture = ImageUp.ListImages("Undo").Picture
End If
End Sub
Private Sub New_Click()
FileName = ""
Text1 = ""
ImgUndoDisable
End Sub

Private Sub Open_Click()
Dim FileNum As Integer
Dim buffer As String
Dim buffer1 As String
Dim FileSize As Long
Dim MaxLen As Long

MaxLen = 32768 '文件最大长度

CommonDialog1.ShowOpen '显示"打开文件"对话框

If Len(CommonDialog1.FileName) > 0 Then
'有输入文件名
FileName = CommonDialog1.FileName '保存文件名
FileSize = FileLen(FileName) '获得文件长度
If FileSize > MaxLen Then[NextPage]

'文件超长
MsgBox "该文件过大，只能显示部分文本", , "警告"
Exit Sub
End If

Screen.MousePointer = 11 '设置鼠标为沙漏

FileNum = FreeFile() '获得可用文件号
Open FileName For Input As FileNum '以顺序输入方式打开文件

Do While Not EOF(FileNum) And Len(buffer) < MaxLen '读必须文本小于

32K
Line Input #FileNum, buffer1 '读一行文字
buffer = buffer + buffer1 + Chr(13) + Chr(10) '加入回车换行符
Loop '循环体

Close FileNum '关闭文件

ImgUndoDisable '取消 Undo 功能

Text1.Text = buffer '显示文本
UndoNew = buffer '保存文本
buffer = "" '释放内存
buffer1 = ""
Screen.MousePointer = 0 '恢复鼠标指针
Me.Caption = "记事本 - " + FileName '修改标题显示
End If
End Sub

Private Sub Paste_Click()
Text1.SelText = Clipboard.GetText
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As

Integer, X As Single, Y As Single)
Label1 = "工具栏"
End Sub

Private Sub Picture1_Resize()
If Picture1.Width > Label1.Left Then
Label1.Width = Picture1.ScaleWidth - Label1.Left
End If
End Sub

Private Sub Save_Click()
Dim FileNum As Integer '文件句柄号

CommonDialog1.ShowSave '显示保存对话框
If Len(CommonDialog1.FileName) > 0 Then
'有输入文件名
FileName = CommonDialog1.FileName '保存文件名
FileNum = FreeFile() '获得可用文件号
Open FileName For Output As FileNum '打开输出文件
'如果无指定文件，则创建新文件
Print #FileNum, Text1.Text '输出文本
Close FileNum '关闭文件
Me.Caption = "记事本 - " + FileName '修改标题显示
ImgUndoDisable
End If
End Sub

Private Sub Text1_Change()
If Not ImgUndo.Enabled Then
'使“Undo”按钮可用
ImgUndoEnable
End If
UndoString = UndoNew
UndoNew = Text1
End Sub

Private Sub Text1_Click()
Check_ImgCutCopy
End Sub

Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
Check_ImgCutCopy
End sub
End Sub

Private Sub ImgSave_MouseUp(Button As Integer, Shift As Integer, X

As Single, Y As Single)
If Button = 1 Then
'“抬起”按钮
ImgSave.Picture = ImageUp.ListImages("Save").Picture
End If
End Sub

Private Sub ImgUndo_Click()
Text1.Text = UndoString
End Sub

Private Sub ImgUndo_MouseDown(Button As Integer, Shift As Integer,

X As Single, Y As Single)
If Button = 1 Then
'“按下”按钮
ImgUndo.Picture = ImageDown.ListImages("Undo").Picture
End If
End Sub

——————————————附录程序清单及注释
程序清单6.1
Option Explicit
Dim Fi
leName As String '文件名，用于打开、保存文件
Dim UndoString As String '用于 Undo 操作
Dim UndoNew As String '用于 Undo 操作

Private Sub ImgUndoDisable()
'禁用“Undo”按钮
UndoString = ""
UndoNew = ""
ImgUndo.Enabled = False
ImgUndo.Picture = ImageDisable.ListImages("Undo").Picture
End Sub

Private Sub ImgUndoEnable()
'有效“Undo”按钮
ImgUndo.Enabled = True
ImgUndo.Picture = ImageUp.ListImages("Undo").Picture
End Sub

Private Sub Check_ImgPaste()
'设置粘贴按钮
If Len(Clipboard.GetText) > 0 Then
ImgPaste.Enabled = True
ImgPaste.Picture = ImageUp.ListImages("Paste").Picture
Else
ImgPaste.Enabled = False
ImgPaste.Picture = ImageDisable.ListImages("Paste").Picture
End If
End Sub

Private Sub Check_ImgCutCopy()
'设置剪切、复制按钮
If Text1.SelLength > 0 Then
ImgCut.Enabled = True
ImgCut.Picture = ImageUp.ListImages("Cut").Picture
ImgCopy.Enabled = True
ImgCopy.Picture = ImageUp.ListImages("Copy").Picture
Else
ImgCut.Enabled = False
ImgCut.Picture = ImageDisable.ListImages("Cut").Picture
ImgCopy.Enabled = False
ImgCopy.Picture = ImageDisable.ListImages("Copy").Picture
End If
End Sub
Private Sub BackColor_Click()
CommonDialog1.ShowColor
Text1.BackColor = CommonDialog1.Color
End Sub

希望没有人做枪手!
因为你不是在帮人,而是在害人!