not2.frm

vb6.0编程实例详解,很详细的介绍,对学习VB有帮助

        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
    CoolBar1.Left = Me.ScaleLeft
    CoolBar1.Width = Me.ScaleWidth
    
    '修改文本框大小
    If CoolBar1.Visible Then
    '工具栏可见
        TextTop = CoolBar1.Height '计算文本区起使位置
    Else
        TextTop = 0
    End If
    Text1.Top = Me.ScaleTop + TextTop
    Text1.Left = 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
    '“抬起”按钮
        ImgPaste.Picture = ImageUp.ListImages("Paste").Picture
    End If
End Sub

Private Sub ImgSave_Click()
    Dim FileNum As Integer '文件句柄号
    
    If Len(FileName) > 0 Then
    '有文件名
        FileNum = FreeFile() '获得可用文件号
        Open FileName 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