标题: VB经验技巧 [打印本页]
作者: 噯伱╅詠吥變 时间: 2008-6-21 15:32 标题: VB经验技巧
记载Windows使用的时间
怎样关闭一个正在运行的程序
我怎样确定我的程序是否在运行?
怎样延迟一个VB程序?
怎样改变双击鼠标的时间间隔?
怎样找到鼠标指针的XY坐标?
怎样捕捉窗体的鼠标?
怎样使我的程序总处于屏幕最前方?(Always on top)
怎样得到文本框(TextBox)中的文本行数?
怎样使程序的标题条闪烁?
在程序设计中,我们经常遇见这样或那样的问题,即使是“身经百战”的编程老手,对于一些过于具体、细微的问题有时也会不知所措,以下是我从外文网站上摘取的一些VB经验技巧,并对它们进行的翻译整理,希望对你会有所帮助,有疏漏之处请大家指正,谢谢!
记载Windows使用的时间
有时候你需要记下每次Windows开启和关闭的时间,下面这个小程序就可以完成这个功能,你可以把它放在Windows开始菜单的“启动”文件夹里面,这样当你进入Windows时,这个小程序就会自动启动(不可见),并在你指定的文件中写下当时的时间,在你推出Windows系统时,小程序会关闭并记下离开的时间,并关闭记录文件。
- Private Sub Form_Load()
- Left = -10000
- Top = -10000
- Open "c:\apps\log.txt" For Append As #1
- Print #1, "On: " & CStr(Now)
- Close #1
- End Sub
- Private Sub Form_Unload(Cancel As Integer)
- Open "c:\apps\log.txt" For Append As #1
- Print #1, "Off:" & CStr(Now)
- Close #1
- End
- End Sub
复制代码
怎样关闭一个正在运行的程序
你可以使用API函数FindWindow和PostMessage去寻找指定的窗口,并关闭它。下面的例子教给你怎样找到并关掉一个Caption为“Caluclator”的程序。
- Dim winHwnd As Long
- Dim RetVal As Long
- winHwnd = FindWindow(vbNullString, "Calculator")
- Debug.Print winHwnd
- If winHwnd <> 0 Then
- RetVal = PostMessage(winHwnd, WM_CLOSE, 0&, 0&)
- If RetVal = 0 Then
- MsgBox "置入消息错误!"
- End If
- Else
- MsgBox "Calculator没有打开!"
- End If
- 为了让以上的代码工作,你必须在模块文件中什么以下API函数:
- Declare Function FindWindow Lib "user32" Alias _
- "FindWindowA" (ByVal lpClassName As String, _
- ByVal lpWindowName As String) As Long
- Declare Function PostMessage Lib "user32" Alias _
- "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
- ByVal wParam As Long, lParam As Any) As Long
- Public Const WM_CLOSE = &H10
复制代码
我怎样确定我的程序是否在运行?
把以下代码放在第一个窗体的Form_Load事件中:
- If App.PrevInstance = True Then
- Call MsgBox("这个程序正在运行!",_
- vbExclamation)
- End
- End If
复制代码
怎样延迟一个VB程序?
延迟在VB中非常有意义!举个例子,有时你需要等待一个额外的过程完成,才能运行程序下面的代码。延迟使程序摆脱了CPU的运算速度对程序运行速度的影响,但是在VB中却没有延迟这个很多语言都有的现成函数,所以还要依靠API函数,请看以下的代码:
- Declare Sub Sleep Lib "kernel32" _
- (ByVal dwMilliseconds As Long)
- '延迟1秒
- Call Sleep(1000)
复制代码
怎样改变双击鼠标的时间间隔?
在较短时间里连续的点击两次鼠标就会造成鼠标双击事件。你可以调用API函数SetDoubleClickTime改变鼠标双击所需要的时间,它只有一个参数,并可精确到毫秒级。
- Declare Function SetDoubleClickTime _
- Lib "user32" Alias "SetDoubleClickTime" _
- (ByVal wCount As Long) As Long
复制代码
提示:这种改变将影响到整个操作系统。
怎样找到鼠标指针的XY坐标?
在很多的作图软件中都有一个小的区域显示当前屏幕上的光标位置,这利用API函数非常容易做到,下面的例子将演示使用代码如何返回当前光标的XY的坐标值。
步骤:
在VB5中建立一个新项目文件,Form1使用默认设置.
选择菜单的“Project/add Module”,建立一个新的模块文件“Moudule1”。
输入以下代码声明API函数。
Option Explicit
Type POINTAPI ' Declare types
x As Long
y As Long
End Type
Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long ' Declare API
把焦点移到Form1,添加两个标签对象(Label)和一个计时器对象(Timer1),把计时器的Interval属性设为1,然后双击Form1的任何区域,在代码窗口中输入:
Option Explicit
Dim z As POINTAPI ' 声明变量
Private Sub Timer1_Timer()
GetCursorPos z ' 得到坐标
Label1 = "x: " & z.x ' 得到X坐标
Label2 = "y: " & z.y ' 得到Y坐标
End Sub
5、按F5运行程序,移动鼠标注意观察两个标签对象的变化。
怎样捕捉窗体的鼠标?
这个技巧将向您展示如何使用捕捉光标的API函数阻止鼠标指针移出窗体。
注意!:如果窗体的BorderStyle属性被设为sizeable(2或5),则当你改变窗体的大小时鼠标就会“逃脱”程序的监控!因此你最好把BorderStyle设为0、1、3或4。
步骤:
- 1、把以下代码添加如模块:
- Option Explicit
- Type RECT
- Left As Long
- Top As Long
- Right As Long
- Bottom As Long
- End Type
- Declare Function ClipCursor Lib "user32" _
- (lpRect As Any) As Long
- Public Sub DisableTrap(CurForm As Form)
- Dim erg As Long
- '声明过程变量
- '设置新坐标
- Dim NewRect As RECT
- CurForm.Caption = "释放鼠标"
- With NewRect
- .Left = 0&
- .Top = 0&
- .Right = Screen.Width / Screen.TwipsPerPixelX
- .Bottom = Screen.Height / Screen.TwipsPerPixelY
- End With
- erg& = ClipCursor(NewRect)
- End Sub
- Public Sub EnableTrap(CurForm As Form)
- Dim x As Long, y As Long, erg As Long
- '声明过程变量
- '设置新坐标
- Dim NewRect As RECT
- '得到TwipsperPixel
- '窗体的ScaleMode必须设为Twips!!!
- x& = Screen.TwipsPerPixelX
- y& = Screen.TwipsPerPixelY
- CurForm.Caption = "捕捉鼠标"
- '设置光标的范围
- With NewRect
- .Left = CurForm.Left / x&
- .Top = CurForm.Top / y&
- .Right = .Left + CurForm.Width / x&
- .Bottom = .Top + CurForm.Height / y&
- End With
- erg& = ClipCursor(NewRect)
- End Sub
- 2、在窗体上添加两个命令按钮(Command Button)。
- 3、把以下代码添加如Form1。
- Private Sub Command1_Click()
- EnableTrap Form1
- End Sub
- Private Sub Command2_Click()
- DisableTrap Form1
- End Sub
- Private Sub Form_Unload(Cancel As Integer)
- '程序结束时释放鼠标。
- DisableTrap Form1
- End Sub
复制代码
怎样使我的程序总处于屏幕最前方?(Always on top)
如果你想让你的程序处于前方,可以使用以下代码:
Form1.ZOrder
配合计时器使用,每隔一段很小的时间间隔调用这种方法可以使窗体Form1处于屏幕前方,但是用户还是可能使别的窗体在短暂的时间里处于Form1的上方。所以这种方法并不能使窗体真正的实现Always on top,而要真正的Always on top可以使用API函数SetWindowPos,代码如下:
- '声明函数:
- Declare Function SetWindowPos Lib "user32" _
- (ByVal h%, ByVal hb%, ByVal x%, ByVal y%, _
- ByVal cx%,ByVal cy%,ByVal f%) As Integer
- Global Const SWP_NOMOVE = 2
- Global Const SWP_NOSIZE = 1
- Global Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
- Global Const HWND_TOPMOST = -1
- Global Const HWND_NOTOPMOST = -2
- '把窗体放在最前面:
- res% = SetWindowPos (Form1.hWnd, HWND_TOPMOST, _
- 0, 0, 0, 0, FLAGS)
- '如果res%=0, 就产生错误
- '使窗体恢复普通模式:
- res% = SetWindowPos (Form1.hWnd, HWND_NOTOPMOST, _
- 0, 0, 0, 0, FLAGS)
复制代码
怎样得到文本框(TextBox)中的文本行数?
计算文本框中输入文本的行数可以使用SendMessage函数返回,当一行文字发生环绕时,它将被当作新的一行,而被非简单的计算文本中的换行符个数。
把以下API函数的声明添入模块文件的general declarations区域,如果您使用的是VB4-32或VB5,也可以把此声明添入
- Form1的general declarations中,并把所有的“Public”更换为“Private”。
- Option Explicit
- 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 Const EM_GETLINECOUNT = &HBA
- Form Code
- Sub Text1_Change()
- Dim lineCount as Long
- On Local Error Resume Next
- '得到/显示文本行数
- lineCount = SendMessageLong(Text1.hwnd, EM_GETLINECOUNT, 0&, 0&)
- Label1 = Format$(lineCount, "##,###")
- End Sub
- 注释:
- 为了使本程序成功,请在设计阶段把文本框的Multiline属性设为True。[code]
-
-
- 怎样使程序的标题条闪烁?
- 建立新的项目文件,添加模块文件,并填写如下代码:
-
- [code]Public Declare Function FlashWindow _
- Lib "user32" (ByVal hwnd As Long, _
- ByVal bInvert As Long) As Long
- 在窗体中添加两个按钮和一个计时器,并用设置以下属性:
- command1.caption="开始"
- command2.caption="停止"
- timer1.interval=500 '每0.5秒闪烁一次
- timer1.enabled=false
- Private Sub Timer1_Timer()
- a& = FlashWindow(Me.hwnd, 1)
- End Sub
- Private Sub Command1_Click()
- Timer1.Enabled = True
- End Sub
- Private Sub Command2_Click()
- Timer1.Enabled = False
- End Sub
复制代码
欢迎光临 【3.A.S.T】网络安全爱好者 (http://3ast.com./) |
Powered by Discuz! 7.2 |