K 外设
008 发现拖(Drap)过来的信息 98-9-12
要让您的程序支持从其他程序 (如: 资源管理器或浏览器)中拖过来的信息,
首先要找到拖过来数据的Format 和组织情况,
以下的代码可以让您迈出第一步:
设置 FORM 的 OLEDropMode 为自动:
Private Sub Form_OLEDragOver(Data As DataObject, Effect As Long, Button As
Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
For i = 1 To 255 ' 如果在该范围内没有, 可以扩大范围!
If Data.GetFormat(i) Then
Debug.Print Data.GetData(i) '数据内容
Debug.Print I 'Format 编号
End If
Next
End Sub
然后拖几个东东到 FORM 中去。
可以发现, 超连接的有关信息 Format 为 1,
而文件的 Format 为 15。。。
007 显示和隐藏鼠标 98-7-14
声明:
Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
显示鼠标:
lReturned = ShowCursor (1)
隐藏鼠标:
lReturned = ShowCursor (0)
006 取得并设置双击间隔时间 98-7-05
取得双击间隔时间:
Declare Function GetDoubleClickTime Lib "user32" Alias
"GetDoubleClickTime" () As Long
使用:
返回千分之一秒的时间间隔数。
设置双击间隔时间:
Declare Function SetDoubleClickTime Lib "user32" Alias
"SetDoubleClickTime" (ByVal wCount As Long) As Long
使用:
wCount 为千分之一秒的时间间隔数。
005 交换鼠标按钮 98-7-05
声明:
Declare Function SwapMouseButton Lib "user32" Alias "SwapMouseButton"
(ByVal bSwap As Long) As Long
使用:
bSwsp 值为 True , 为交换状态,即左手习惯。
bSwsp 值为 False, 为正常状态,即右手习惯。
004 得到鼠标位置
声明:
Private Type POINTAPI
x As Long
y As Long
End Type
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
例子:
Dim p As POINTAPI
Call GetCursorPos( p )
' ( p.x, p.y )为鼠标位置
003 设定鼠标位置
声明:
Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As
Long
例子:
ret = SetCursorPos( X, Y) '(X,Y)为坐标,单位为 Pixel(像素)
002 捕捉 MouseExit 事件 98-6-05
MouseDown、MouseUp、MouseMove。VB 似乎提供了很好的 Mouse
事件。但好象还缺少什么!对!还差 MouseExit(鼠标移出)事件。在
VB 中,我们要捕捉 MouseExit 事件,必须用 API 函数:
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
然后,我们可以在控件(以 Picture1 为例)的 MouseMove
事件上加上以下代码:
With Picture1 'Change this to the name of the control
If Button = 0 Then
If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
'Mouse pointer is outside button, so let other controls receive
'mouseevents too:
ReleaseCapture
' 放入鼠标离开的代码
Else
' Mouse pointer is over button, so we'll capture it, thus
' we'll receive mouse messages even if the mouse pointer is
' not over the button
SetCapture .hwnd
' 放入鼠标进入的代码
End If 
001 显示动画鼠标图标
声明:
Public Const GCL_HCURSOR = -12
Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Any) As Long
Declare Function LoadCursorFromFile Lib "user32" Alias
"LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Declare Function SetClassLong Lib "user32" Alias "SetClassLongA"
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetClassLong Lib "user32" Alias "GetClassLongA"
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
使用:
Dim mhBaseCursor As Long, mhAniCursor As Long
Dim lResult As Long
mhAniCursor = LoadCursorFromFile("c:\windows\cursors\appstart.ani")
lResult = SetClassLong((hwnd), GCL_HCURSOR, mhAniCursor)
|