The system of managing student file is a typical application of managing information system (know as MIS),which mainly includes building up data-base of back-end and developing the application interface of front-end. The former required consistency and integrality and security of data. The later should make the application powerful and easily used. By looking up lots of datum, we selected Visual Basic presented by Microsoft because of its objective tools in Win32. VB offered a series of ActiveX operating a data-base. It can give you a short-cut to build up a prototype of system application. The prototype could be modified and developed till users are satisfied with it.
附录程序清单及注释 程序清单6.1 Option Explicit Dim FileName 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 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
'加载系统字体 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 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 Integer, 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 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 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
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 '文件超长 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