开发工具:
文件大小: 53kb
下载次数: 0
上传时间: 2011-07-17
详细说明： ----------------------- 'False_VB教程：VB制作带撤销功能的记事本 QQ:5333784 '应网友要求，今天给大家带来一个用VB做带有撤销功能的记事本 'VB写记事本网上已经有很多教程了 '但是却很少有撤销功能的 '今天我就给大家做一个 '我们开始吧 '编辑菜单 '好了， '下面我们添加一个模块 '代码我已经测试好了 '也会给大家打包的 '下面来写入代码 '好了，这些是记事本最基本的应用 '希望大家可以写出一个属于自己的更多功能的记事本 '今天的教程就到这里了 '我们下次见 '以下是代码： '----------------------------------华丽的分割线------------------------------------------------- Dim sFind As String'生命查找变量 Dim FileType, FiType As String '----------------------------------华丽的分割线------------------------------------------------- Pu blic Property Get UndoType() As ERECUndoTypeConstants UndoType = SendMessageLong(rtfText.hwnd, EM_GETUNDONAME, 0, 0) End Property Public Property Get RedoType() As ERECUndoTypeConstants RedoType = SendMessageLong(rtfText.hwnd, EM_GETREDONAME, 0, 0) End Property Public Property Get CanPaste() As Boolean CanPaste = SendMessageLong(rtfText.hwnd, EM_CANPASTE, 0, 0) End Property Public Property Get CanCopy() As Boolean If rtfText.SelLength > 0 Then CanCopy = True End If End Property Public Property Get CanUndo() As Boolean CanUndo = SendMessageLong(rtfText.hwnd, EM_CANUNDO, 0, 0) End Property Public Property Get CanRedo() As Boolean CanRedo = SendMessageLong(rtfText.hwnd, EM_CANREDO, 0, 0) End Property '----------------------------------华丽的分割线------------------------------------------------- Private Sub Form_Load()'窗体加载时 Dim lStyle As Long lStyle = TM_RICHTEXT Or TM_MULTILEVELUNDO Or TM_MULTICODEPAGE SendMessageLong rtfText.hwnd, EM_SETTEXTMODE, lStyle, 0 End Sub '----------------------------------华丽的分割线------------------------------------------------- Private Function TranslateUndoType(ByVal eType As ERECUndoTypeConstants) As String Select Case eType Case ercUID_UNKNOWN TranslateUndoType = "Last Action" Case ercUID_TYPING TranslateUndoType = "Typing" Case ercUID_PASTE TranslateUndoType = "Paste" Case ercUID_DRAGDROP TranslateUndoType = "Drag Drop" Case ercUID_DELETE TranslateUndoType = "Delete" Case ercUID_CUT TranslateUndoType = "Cut" End Select End Function '----------------------------------华丽的分割线------------------------------------------------- '----------------------------------多了个华丽的分割线------------------------------------------- '新建文件 rtfText.Text = "" '清空文本框 FileName = "未命名" Me.Caption = FileName '----------------------------------华丽的分割线------------------------------------------------- '打开文件 CommonDialog1.Filter = "文本文档(*.txt)|*.txt|RTF文档(*.rtf)|*.rtf|所有文件(*.*)|*.*" CommonDialog1.ShowOpen rtfText.Text = "" '清空文本框 FileName = CommonDialog1.FileName rtfText.LoadFile FileName Me.Caption = "个人专用记事本：" & FileName '----------------------------------华丽的分割线------------------------------------------------- '保存文件 Open App.Path & "\False_VB教程.txt" For Append As #1 Print #1, rtfText.Text Close #1 '----------------------------------华丽的分割线------------------------------------------------- '另保存文件 CommonDialog1.Filter = "文本文档(*.txt)|*.txt|RTF文档(*.rtf)|*.rtf|所有文件(*.*)|*.*" CommonDialog1.ShowSave FileType = CommonDialog1.FileTitle FiType = LCase(Right(FileType, 3)) FileName = CommonDialog1.FileName Select Case FiType Case "txt" rtfText.SaveFile FileName, rtfText Case "rtf" rtfText.SaveFile FileName, rtfRTF Case "*.*" rtfText.SaveFile FileName End Select Me.Caption = "个人专用记事本：" & FileName '----------------------------------华丽的分割线------------------------------------------------- '撤销 SendMessageLong rtfText.hwnd, EM_UNDO, 0, 0 End Sub '----------------------------------华丽的分割线------------------------------------------------- '重做 SendMessageLong rtfText.hwnd, EM_REDO, 0, 0 '----------------------------------华丽的分割线------------------------------------------------- '复制 SendMessageLong rtfText.hwnd, WM_COPY, 0, 0 '----------------------------------华丽的分割线------------------------------------------------- '粘贴 SendMessageLong rtfText.hwnd, WM_PASTE, 0, 0 '----------------------------------华丽的分割线------------------------------------------------- '清除 rtfText.SelText = Empty '----------------------------------华丽的分割线------------------------------------------------- '剪切 SendMessageLong rtfText.hwnd, WM_CUT, 0, 0 '----------------------------------华丽的分割线------------------------------------------------- '全选 rtfText.SelStart = 0 rtfText.SelLength = Len(rtfText.Text) '----------------------------------华丽的分割线------------------------------------------------- '时间日期 rtfText.Text = rtfText.Text & " " & Now '----------------------------------华丽的分割线------------------------------------------------- '查找 sFind = InputBox("请输入要查找的字、词：", "查找内容", sFind) rtfText.Find sFind '----------------------------------华丽的分割线------------------------------------------------- '继续查找 rtfText.SelStart = rtfText.SelStart + rtfText.SelLength + 1 rtfText.Find sFind, , Len(rtfText) '----------------------------------华丽的分割线------------------------------------------------- '关于 MsgBox "作者QQ：1302938783 QQ群：26891547 E-mail:falsevb@163.com 欢迎喜欢VB的朋友加入我的QQ群，大家一起讨论，请那些所谓的什么什么黑客要盗什么什么QQ的人自重，这个群只是喜欢VB的朋友一起交流和讨论，了解吗？", 64, "关于" '----------------------------------华丽的分割线------------------------------------------------- '防止在切换输入法时字体自变 Private Sub rtfText_KeyUp(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeySpace Then rtfText.SelFontName = CommonDialog1.FontName End If End Sub '----------------------------------华丽的分割线------------------------------------------------- '模块 Public Enum ERECViewModes ercDefault = 0 ercWordWrap = 1 ercWYSIWYG = 2 End Enum '// Undo Types Public Enum ERECUndoTypeConstants ercUID_UNKNOWN = 0 ercUID_TYPING = 1 ercUID_DELETE = 2 ercUID_DRAGDROP = 3 ercUID_CUT = 4 ercUID_PASTE = 5 End Enum '// Text Modes Public Enum TextMode TM_PLAINTEXT = 1 TM_RICHTEXT = 2 ' /* default behavior */ TM_SINGLELEVELUNDO = 4 TM_MULTILEVELUNDO = 8 ' /* default behavior */ TM_SINGLECODEPAGE = 16 TM_MULTICODEPAGE = 32 ' /* default behavior */ End Enum Public Const WM_COPY = &H301 Public Const WM_CUT = &H300 Public Const WM_PASTE = &H302 Public Const WM_USER = &H400 Public Const EM_SETTEXTMODE = (WM_USER + 89) Public Const EM_UNDO = &HC7 Public Const EM_REDO = (WM_USER + 84) Public Const EM_CANPASTE = (WM_USER + 50) Public Const EM_CANUNDO = &HC6& Public Const EM_CANREDO = (WM_USER + 85) Public Const EM_GETUNDONAME = (WM_USER + 86) Public Const EM_GETREDONAME = (WM_USER + 87) Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long '----------------------------------结束华丽的分割线-------------------------------------------- ...展开收缩
(系统自动生成,下载前可以参看下载内容)
下载文件列表
相关说明
- 本站资源为会员上传分享交流与学习,如有侵犯您的权益,请联系我们删除.
- 本站是交换下载平台，提供交流渠道，下载内容来自于网络，除下载问题外，其它问题请自行百度。
- 本站已设置防盗链，请勿用迅雷、QQ旋风等多线程下载软件下载资源，下载后用WinRAR最新版进行解压.
- 如果您发现内容无法下载，请稍后再次尝试；或者到消费记录里找到下载记录反馈给我们.
- 下载后发现下载的内容跟说明不相乎，请到消费记录里找到下载记录反馈给我们，经确认后退回积分.
- 如下载前有疑问，可以通过点击"提供者"的名字，查看对方的联系方式，联系对方咨询.
