跪求 VB 课程设计 高手

学生档案管理系统 vb

——————————————附录程序清单及注释

程序清单61

Option Explicit

Dim Fi

leName As String '文件名，用于打开、保存文件

Dim UndoString As String '用于 Undo *** 作

Dim UndoNew As String '用于 Undo *** 作

Private Sub ImgUndoDisable()

'禁用“Undo”按钮

UndoString = ""

UndoNew = ""

ImgUndoEnabled = False

ImgUndoPicture = ImageDisableListImages("Undo")Picture

End Sub

Private Sub ImgUndoEnable()

'有效“Undo”按钮

ImgUndoEnabled = True

ImgUndoPicture = ImageUpListImages("Undo")Picture

End Sub

Private Sub Check_ImgPaste()

'设置粘贴按钮

If Len(ClipboardGetText) > 0 Then

ImgPasteEnabled = True

ImgPastePicture = ImageUpListImages("Paste")Picture

Else

ImgPasteEnabled = False

ImgPastePicture = ImageDisableListImages("Paste")Picture

End If

End Sub

Private Sub Check_ImgCutCopy()

'设置剪切、复制按钮

If Text1SelLength > 0 Then

ImgCutEnabled = True

ImgCutPicture = ImageUpListImages("Cut")Picture

ImgCopyEnabled = True

ImgCopyPicture = ImageUpListImages("Copy")Picture

Else

ImgCutEnabled = False

ImgCutPicture = ImageDisableListImages("Cut")Picture

ImgCopyEnabled = False

ImgCopyPicture = ImageDisableListImages("Copy")Picture

End If

End Sub

Private Sub BackColor_Click()

CommonDialog1ShowColor

Text1BackColor = CommonDialog1Color

End Sub

Private Sub Box_Click()

'显停工具栏

If BoxChecked Then

'将停显工具栏

BoxChecked = False

CoolBar1Visible = False

Else

BoxChecked = True

CoolBar1Visible = 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, Text1Text '输出文本

Close FileNum '关闭文件

End If

Text1Text = ""

FileName = ""

End Sub

Private Sub ComboSize_Click()

Text1FontSize = Val(ComboSizeText)

End Sub

Private Sub ComboFont_Click()

Text1FontName = ComboFontText

End Sub

Private Sub Copy_Click()

ClipboardSetText Text1SelText '复制文本到剪裁板

End Sub

Private Sub Cut_Click()

ClipboardSetText Text1SelText '复制文本到剪裁板

Text1SelText = "" '清选择的文本

End Sub

Private Sub DataTime_Click()

Text1SelText = Now

End Sub

Private Sub Delete_Click()

Text1SelText = "" '清选择的文本

End Sub

Private Sub Edit_Click()

'当程序显示“编辑”子菜单前，触发该程序

If Text1SelLength > 0 Then

'文本框中有选中的文本

CutEnabled = True

CopyEnabled = True

DeleteEnabled = True

Else

CutEnabled = False

CopyEnabled = False

DeleteEnabled = False

End If

If Len(ClipboardGetText()) > 0 Then

'剪裁板中有文本数据

PasteEnabled = True

Else

'没有可粘贴的文本

PasteEnabled = 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, Text1Text, FindTextText, vbTextCompare)

If BeginPos > 0 Then

Text1SelStart = BeginPos - 1

Text1SelLength = Len(FindTextText)

End If

End If

End Sub

Private Sub Fontcolor_Click()

CommonDialog1ShowColor

Text1ForeColor = CommonDialog1Color

End Sub

Private Sub Form_Load()

Dim i As Integer

'加载图像

ImgNewPicture = ImageUpListImages("New")Picture

ImgOpenPicture = ImageUpListImages("Open")Picture

ImgSavePicture = ImageUpListImages("Save")Picture

ImgUndoPicture = ImageDisableListImages("Undo")Picture

Check_ImgPaste

Check_ImgCutCopy

'加载系统字体

For i = 0 To ScreenFontCount - 1

ComboFontAddItem ScreenFonts(i)

Next i

End Sub

Private Sub Form_Resize()

Dim TextTop As Long

'修改工具条大小

CoolBar1Top = MeScaleTop

MeScaleLeft

Text1Width = MeScaleWidth

If MeScaleHeight > CoolBar1Height Then

Text1Height = MeScaleHeight - TextTop

Else

Text1Height = 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

ImgCopyPicture = ImageDownListImages("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 < ImgNewWidth And Y > 0 And Y <

ImgNewHeight) Then

ImgCopyPicture = ImageDownListImages("Copy")Picture[NextPage]

ElseIf Button = 1 Then

ImgCopyPicture = ImageUpListImages("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

'“抬起”按钮

ImgCopyPicture = ImageUpListImages("Copy")Picture

End If

End Sub

Private Sub ImgCut_Click()

'If Text1SelLength > 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

'“按下”按钮

ImgCutPicture = ImageDownListImages("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 < ImgNewWidth And Y > 0 And Y <

ImgNewHeight) Then

ImgCutPicture = ImageDownListImages("Cut")Picture

ElseIf Button = 1 Then

ImgCutPicture = ImageUpListImages("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

'“抬起”按钮

ImgCutPicture = ImageUpListImages("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

'“按下”按钮

ImgNewPicture = ImageDownListImages("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 < ImgNewWidth And Y > 0 And Y <

ImgNewHeight) Then

ImgNewPicture = ImageDownListImages("New")Picture

ElseIf Button = 1 Then

ImgNewPicture = ImageUpListImages("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

'“抬起”按钮

ImgNewPicture = ImageUpListImages("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

ImgOpenPicture = ImageDownListImages("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 < ImgNewWidth And Y > 0 And Y <

ImgNewHeight) Then

ImgOpenPicture = ImageDownListImages("Open")Picture

ElseIf Button = 1 Then

ImgOpenPicture = ImageUpListImages("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

'“抬起”按钮

ImgOpenPicture = ImageUpListImages("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

'“按下”按钮

ImgPastePicture = ImageDownListImages("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 < ImgNewWidth And Y > 0 And Y <

ImgNewHeight) Then

ImgPastePicture = ImageDownListImages("Paste")Picture

ElseIf Button = 1 Then

ImgPastePicture = ImageUpListImages("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, Text1Text '输出文本

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

ImgSavePicture = ImageDownListImages("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 < ImgNewWidth And Y > 0 And Y <

ImgNewHeight) Then

ImgSavePicture = ImageDownListImages("Save")Picture

ElseIf Button = 1 Then

ImgSavePicture = ImageUpListImages("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 < ImgNewWidth And Y > 0 And Y <

ImgNewHeight) Then

ImgUndoPicture = ImageDownListImages("Undo")Picture

ElseIf Button = 1 Then

ImgUndoPicture = ImageUpListImages("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

'“抬起”按钮

ImgUndoPicture = ImageUpListImages("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 '文件最大长度

CommonDialog1ShowOpen '显示"打开文件"对话框

If Len(CommonDialog1FileName) > 0 Then

'有输入文件名

FileName = CommonDialog1FileName '保存文件名

FileSize = FileLen(FileName) '获得文件长度

If FileSize > MaxLen Then[NextPage]

'文件超长

MsgBox "该文件过大，只能显示部分文本", , "警告"

Exit Sub

End If

ScreenMousePointer = 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 功能

Text1Text = buffer '显示文本

UndoNew = buffer '保存文本

buffer = "" '释放内存

buffer1 = ""

ScreenMousePointer = 0 '恢复鼠标指针

MeCaption = "记事本 - " + FileName '修改标题显示

End If

End Sub

Private Sub Paste_Click()

Text1SelText = ClipboardGetText

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 Picture1Width > Label1Left Then

Label1Width = Picture1ScaleWidth - Label1Left

End If

End Sub

Private Sub Save_Click()

Dim FileNum As Integer '文件句柄号

CommonDialog1ShowSave '显示保存对话框

If Len(CommonDialog1FileName) > 0 Then

'有输入文件名

FileName = CommonDialog1FileName '保存文件名

FileNum = FreeFile() '获得可用文件号

Open FileName For Output As FileNum '打开输出文件

'如果无指定文件，则创建新文件

Print #FileNum, Text1Text '输出文本

Close FileNum '关闭文件

MeCaption = "记事本 - " + FileName '修改标题显示

ImgUndoDisable

End If

End Sub

Private Sub Text1_Change()

If Not ImgUndoEnabled 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

'“抬起”按钮

ImgSavePicture = ImageUpListImages("Save")Picture

End If

End Sub

Private Sub ImgUndo_Click()

Text1Text = UndoString

End Sub

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

X As Single, Y As Single)

If Button = 1 Then

'“按下”按钮

ImgUndoPicture = ImageDownListImages("Undo")Picture

End If

End Sub

当然是把自己遇到的问题写出来，然后再把如何解决的方法写进去，一般就行了~

比如说，你写到某处，在调试的时候出错，然后把具体出错的情况记录下来，再找找相关资料，看看这个出错的原因，把问题解决后，总结一个小方案写下来啊！

非常简单，你看插图，一切都在图中。代码如下：

在窗体中添加一个Label1、两个默认command1和command2。一切属性默认、不用修改。

Private Sub Command1_Click()

If Command1Caption = "有边框" Then

Label1BorderStyle = 1

Command1Caption = "无边框"

Else

Label1BorderStyle = 0

Command1Caption = "有边框"

End If

End Sub

Private Sub Command2_Click()

If Command2Caption = "不透明" Then

Label1BackStyle = 1

Command2Caption = "透明"

Else

Label1BackStyle = 0

Command2Caption = "不透明"

End If

End Sub

Private Sub Form_Load()

Label1Caption = "Visual Basic 程序设计教程"

Label1FontSize = 36

Command1Caption = "有边框"

Command2Caption = "不透明"

Label1BorderStyle = 0

Label1BackStyle = 0

End Sub

回答

1 在资源管理器中，双击工程中的“Project1vbp”（即扩展名为vbp的文件）可以正确打开工程。

2 在保存文件之后，如果发现文件名错了，不能在Windows中直接修改工程中的文件名。

可以做，相当于WINDOES的记事本程序，但是又比WINDOES的记事本程序复杂的多。既然是文档，那么包括的内容就多得多，例如：txt、doc、xls、ppt、gif、jpg、bmp等等等等，不是100个百度分能够解决问题的。

以上就是关于跪求 VB 课程设计 高手全部的内容，包括:跪求 VB 课程设计 高手、vb设计计算器要求实验报告 其中“可能遇到的问题 及 解决方案”可以怎么写、VB 程序设计问题等相关内容解答，如果想了解更多相关内容，可以关注我们，你们的支持是我们更新的动力！