让您的文字框有 Undo / Redo 的功能
很多软件都有提供 Undo / Redo 的功能,Microsoft 的产品都可以提供多次 Undo 反悔,功能更强大!
在 VB 的程序中,我们也可以提供这样的功能!不过只能 Undo / Redo 一次
’在声明区中加入以下声明: ’32位元 ’Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long ’Const EM_UNDO = &HC7 ’16位元 Private Declare Function SendMessage Lib "User" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long Const WM_USER = &H400 Const EM_UNDO = WM_USER + 23 ’在程序中使用的方式如下: ( Undo Text1 中的输入 ) Private Sub Command1_Click() Dim UndoResult As Long UndoResult = SendMessage(Text1.hwnd, EM_UNDO, 0, 0) ’传回值 UndoResult = -1 表示 Undo 不成功 End Sub ’使用以上的方法,第一次是 Undo ,第二次就等于是 Redo |
Private Sub Command1_Click() Dim i As Integer, A As Integer, B As Integer, C As String A = InputBox("请输入年份", "某年每个月的第一天是星期几") Form1.Cls For i = 1 To 12 C = A & "-" & i & "-1" B = Weekday(C) Select Case B Case vbSunday Print A & "年" & i & "月1日是 星期日" Case vbMonday Print A & "年" & i & "月1日是 星期一" Case vbTuesday Print A & "年" & i & "月1日是 星期二" Case vbWednesday Print A & "年" & i & "月1日是 星期三" Case vbThursday Print A & "年" & i & "月1日是 星期四" Case vbFriday Print A & "年" & i & "月1日是 星期五" Case vbSaturday Print A & "年" & i & "月1日是 星期六" End Select Next i End Sub |
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Const SWP_HIDEWINDOW = &H80 ’隐藏视窗 Const SWP_SHOWWINDOW = &H40 ’显示视窗 ’在程序中若要隐藏任务栏 Private Sub Command1_Click() Dim Thwnd As Long Thwnd = FindWindow("Shell_traywnd", "") Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_HIDEWINDOW) End Sub ’在程序中若要再显示任务栏 Private Sub Command2_Click() Dim Thwnd As Long Thwnd = FindWindow("Shell_traywnd", "") Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_SHOWWINDOW) End Sub |
模拟 Windows 的资源回收站!
您现在将屏幕上所有的视窗全部缩小,找到资源回收站,按鼠标右键,选择【属性】,便会出现【资源回收站】的属性问话框。
其中有几个选项如下:
1、不要将文件移到资源回收站,删除时立即移除文件。
2、显示删除确认对话框?
根据以上之状况,文件之删除有三种情形:
1、删除文件,出现确认对话框,文件移到资源回收站。
2、删除文件,出现确认对话框,文件不移到资源回收站。
3、删除文件,不出现确认对话框,文件也不移到资源回收站。
模拟程序如下:
’在模组的声明区中加入以下声明: Public Type SHFILEOPSTRUCT hwnd As Long wFunc As Long pFrom As String pTo As String fFlags As Integer fAnyOperationsAborted As Long hNameMappings As Long lpszProgressTitle As Long End Type Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long Public Const FO_DELETE = &H3 Public Const FOF_ALLOWUNDO = &H40 ’可以还原 Public Const FOF_NOCONFIRMATION = &H10 ’不出现确认对话框 Public Const FOF_SILENT = &H4 ’在程序中之使用方法如下: ’以下之例子会出现确认对话框,文件也会移到资源回收站。 Private Sub Command1_Click() Dim SHop As SHFILEOPSTRUCT Dim strFile As String ’要删除的文件(含全路径) strFile = "c:\test.txt" With SHop .wFunc = FO_DELETE .pFrom = strFile .fFlags = FOF_ALLOWUNDO End With SHFileOperation SHop End Sub ’若要调整,只要更改 fFlags 之值即可,如下: .fFlags = FOF_SILENT ’删除文件,出现确认对话框,文件不移到资源回收站。 .fFlags = FOF_NOCONFIRMATION ’删除文件,不出现确认对话框,文件也不移到资源回收站。 |
Dim sFilePath As String sFilePath = "C:\Windows\System\sytem.dll" Dim lGetLen As Long, lNum As Long Dim sGetFile As String, sTemp As String lGetLen = Len(sFilePath) ’得到文件路径长度 sTemp = lGetLen For lNum = 1 To lGetLen If Left(sGetFile, 1) = "\" Then Exit For sGetFile = Mid(sFilePath, sTemp, lNum) sTemp = sTemp - 1 Next lNum sGetFile = Mid(sGetFile, 2) ’得到文件名 MsgBox sGetFile |
Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long Public Const SPI_SCREENSAVERRUNNING = 97 Public Sub Disable_Ctrl_Alt_Del() ’让 CTRL+ALT+DEL 失效 Dim AyW As Integer Dim TurFls As Boolean AwY = SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, TurFls, 0) End Sub Public Sub Enable_Ctrl_Alt_Del() ’让 CTRL+ALT+DEL 恢复功能 Dim AwY As Integer Dim TurFls As Boolean AwY = SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, TurFls, 0) End Sub ’实际使用时,在 Form 中加入以下程序码: Private Sub Form_Load() Disable_Ctrl_Alt_Del End Sub Private Sub Form_Unload(Cancel As Integer) Enable_Ctrl_Alt_Del End Sub |
’在表单的声明区中加入以下声明及常数: Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As String, ByVal fuWinIni As Long) As Long Const SPI_SETDESKWALLPAPER = 20 Const SPIF_UPDATEINIFILE = &H1 Const SPIF_SENDWININICHANGE = &H2 ’在表单上加入一个 CommandButton (Command1) 来移除桌面底图,程序码如下: Private Sub Command1_Click() Dim X As Long X = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0&, "(None)", SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE) MsgBox "桌面底图 (Wallpaper) 已经被移除" End Sub ’在表单上加入另一个 CommandButton (Command2) 来更改桌面底图,程序码如下: Private Sub Command2_Click() Dim FileName As String Dim X As Long FileName = "c:\windows\test.bmp" X = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0&, FileName, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE) MsgBox "桌面底图 (Wallpaper) 已经被更改" End Sub |
’新建标准EXE,加入一个TextBox控件,一个公共对话框,两个菜单。 ’打开 Private Sub mnuOpen_Click() CommonDialog1.Filter = "文档文件(*.txt)|*.txt|所有文件(*.*)|*.*" CommonDialog1.ShowOpen Open CommonDialog1.FileName For Input As #1 Text1.Text = StrConv(InputB$(LOF(1), 1), vbUnicode) Close #1 End Sub ’保存 Private Sub mnuSave_Click() On Error Resume Next CommonDialog1.Filter ="文档文件(*.txt)|*.txt|所有文件(*.*)|*.*" CommonDialog1.ShowSave Open CommonDialog1.FileName For Output As #1 Print #1, Text1.Text Close 1 End Sub |
Private Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" (ByVal lpszFile As String, ByVal lpszTitle As String, ByVal cbBuf As Integer) As Integer Private Function HasExtension(sFileName As String) As Long Dim sTemp As String Dim lTemp As Long sTemp = String(1, 0) lTemp = GetFileTitle(sFileName, sTemp, Len(sTemp)) If lTemp < 0 Then HasExtension = -1: Exit Function sTemp = String(lTemp, 0) Call GetFileTitle(sFileName, sTemp, Len(sTemp)) If (Left$(Right$(Left$(sTemp, lTemp - 1), 4), 1)) = "." Then HasExtension = 1 Else HasExtension = 0 End If End Function |
摘自:网络整理
相关文章参考:
★VB取得TextBox、RichTextBox光标所在的行和列(支持汉字)
★VB取得TextBox、RichTextBox光标所在的行和列(支持汉字)
★VB根据窗体自动调整窗体内控件大小 注:实用,可以直接引用
★Visual Basic编程常见问题及解答(1)
★Visual Basic编程常见问题及解答(2)
★Visual Basic编程常见问题及解答(3)
★VisualBasic变量、常数和数据类型及过程概述
★VB6的后期绑定和前期绑定
★VB 计算自己程序段所用时间
★VB 获取路径名各部分 (获取文件路径,获取文件名,获取文件扩展名)自编
★VB 在浏览器中打开指定网址
评论