请教,如何用vb实现模拟鼠标中键滚动！

2024-05-17 21:02

1. 请教,如何用vb实现模拟鼠标中键滚动！

用API函数mouse_event可以做到   
  函数及常数声明：   
    
  Public   Declare   Sub   mouse_event   Lib   "user32"   (ByVal   dwFlags   As   Long,   ByVal   dx   As   Long,   ByVal   dy   As   Long,   ByVal   cButtons   As   Long,   ByVal   dwExtraInfo   As   Long)   
  Public   Const   MOUSEEVENTF_ABSOLUTE   =   &H8000   '     absolute   move   
  Public   Const   MOUSEEVENTF_LEFTDOWN   =   &H2   '     left   button   down   
  Public   Const   MOUSEEVENTF_LEFTUP   =   &H4   '     left   button   up   
  Public   Const   MOUSEEVENTF_MIDDLEDOWN   =   &H20   '     middle   button   down   
  Public   Const   MOUSEEVENTF_MIDDLEUP   =   &H40   '     middle   button   up   
  Public   Const   MOUSEEVENTF_MOVE   =   &H1   '     mouse   move   
  Public   Const   MOUSEEVENTF_RIGHTDOWN   =   &H8   '     right   button   down   
  Public   Const   MOUSEEVENTF_RIGHTUP   =   &H10   '     right   button   up   
  Public   Const   MOUSEEVENTF_WHEEL   =   &H800   
    
  测试代码:建立一个窗体，加一个按钮和一个timer   
  Option   Explicit   
    
  Private   Sub   Command1_Click()   
          Timer1.Interval   =   5000   
          Timer1.Enabled   =   True   
  End   Sub   
    
  Private   Sub   Timer1_Timer()   
  Dim   i   As   Integer   
  For   i   =   0   To   100   
          DoEvents   
          mouse_event   MOUSEEVENTF_WHEEL,   0,   0,   10,   0   
  Next   
  For   i   =   0   To   100   
          DoEvents   
          mouse_event   MOUSEEVENTF_WHEEL,   0,   0,   -10,   0   
  Next   
    
  End   Sub

请教,如何用vb实现模拟鼠标中键滚动！

2. vb中datagrid随鼠标滚动

Public Const GWL_WNDPROC = (-4)
          Public Const WM_COMMAND = &H111
          Public Const WM_MBUTTONDOWN = &H207
          Public Const WM_MBUTTONUP = &H208
          Public Const WM_MOUSEWHEEL = &H20A
            
          Public Oldwinproc     As Long
          Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, _
                                                          ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
            
          Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
                                                          ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
            
          Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, _
                                                          ByVal nIndex As Long) As Long
  Public Function FlexScroll(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  '支持滚轮的滚动   Yu   2004-5-10   15:33
          Select Case wMsg
          Case WM_MOUSEWHEEL
                  Select Case wParam
                  Case -7864320       '向下滚
                          SendKeys "{PGDN}"
                  Case 7864320         '向上滚
                          SendKeys "{PGUP}"
                  End Select
                                      
          End Select
          FlexScroll = CallWindowProc(Oldwinproc, hWnd, wMsg, wParam, lParam)
  End Function

3. VB中msflexgrid如何加鼠标滚动？

在窗口上放两个Lable,两个Botton.


'1.窗口风格的设置
'在窗口声明部分加入
Dim HVisible as Boolean,VVisible as Boolean


Private Sub Form_Load()
Dim OldStyle As Long
Dim hsWidth As Integer
'保存旧风格
OldStyle = SetWindowLong(hWnd, GWL_STYLE, 0)
'设置新风格
Call SetWindowLong(hWnd, GWL_STYLE, OldStyle Or WS_VSCROLL Or WS_HSCROLL)
Command1.Caption = "隐藏垂直滚动条"
Command2.Caption = "隐藏水平滚动条"
Label1 = "垂直滚动条的值"
Label2 = "水平滚动条的值"
'得到水平滚动条的宽度
hsWidth = GetSystemMetrics(SM_CXVHSCROLL)
'改变窗口宽度与高度
Width = Width + hsWidth
Height = Height + hsHeight
VVisible = True
HVisible = True
'怎么样,滚动条显示出来了没有?没有?那么是我眼花了?@_@


'2.滚动范围的设置
yMin = 0: yMax = 100
xMin = 0: xMax = 100
SetScrollRange hWnd, SB_HORZ, xMin, xMax, True
SetScrollRange hWnd, SB_VERT, yMin, yMax, True
'建立子类窗口
SubClass Me
End Sub'End Of Form_Load


'3.滚动条的显示与隐藏
Private Sub Command1_Click()
If VVisible Then
Command1.Caption = "显示垂直滚动条"
ShowScrollBar hWnd, SB_VERT, False
VVisible = False
Else
Command1.Caption = "隐藏垂直滚动条"
ShowScrollBar hWnd, SB_VERT, True
VVisible = True
End If
End Sub


'4.子类窗口的撤消
Private Sub Form_Unload(Cancel As Integer)
UnSubClass Me
End Sub


'从1.窗口风格的设置直到此处都可以直接COPY到窗口代码中


'5.消息响应机制
'添加一个公共模块,在模块中加入以下代码和声明
Public Const SM_CXHSCROLL = 21
Public Const GWL_STYLE = (-16)
Public Const WS_HSCROLL = &H100000
Public Const WS_VSCROLL = &H200000
Public Const SB_BOTH = 3
Public Const SB_HORZ = 0
Public Const SB_VERT = 1
'以下以SB_开头的是用户的滚动请求
Public Const SB_LINEDOWN = 1
Public Const SB_LINELEFT = 0
Public Const SB_LINERIGHT = 1
Public Const SB_LINEUP = 0
Public Const SB_PAGERIGHT = 3
Public Const SB_PAGELEFT = 2
Public Const SB_PAGEDOWN = 3
Public Const SB_PAGEUP = 2
Public Const SB_ENDSCROLL = 8
Public Const SB_THUMBPOSITION = 4
Public Const SB_THUMBTRACK = 5
Public Const GWL_WNDPROC = (-4)
Public Const WM_HSCROLL = &H114
Public Const WM_VSCROLL = &H115
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Declare Function ShowScrollBar Lib "user32" (ByVal hWnd As Long, ByVal wBar As Long, ByVal bShow As Long) As Long
Declare Function SetScrollPos Lib "user32" (ByVal hWnd As Long, ByVal nBar As Long, ByVal nPos As Long, ByVal bRedraw As Long) As Long
Declare Function SetScrollRange Lib "user32" (ByVal hWnd As Long, ByVal nBar As Long, ByVal nMinPos As Long, ByVal nMaxPos As Long, ByVal bRedraw As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public preWndProc As Long
Public xMin As Integer, xMax As Integer
Public yMin As Integer, yMax As Integer
Public xPos As Integer, yPos As Integer


Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
Dim xInc As Integer, yInc As Integer
Select Case uMsg
Case WM_VSCROLL'垂直滚动条消息
Select Case LoWord(wParam)
Case SB_LINEUP, SB_LINEDOWN
If LoWord(wParam) Then
yInc = 1
Else
yInc = -1
End If
Case SB_PAGEUP, SB_PAGEDOWN
If LoWord(wParam) = SB_PAGEUP Then
yInc = -10
Else
yInc = 10
End If


Case SB_THUMBTRACK
yInc = HiWord(wParam) - yPos
End Select
yPos = yPos + yInc
If yPos < yMin Then yPos = yMin
If yPos > yMax Then yPos = yMax
SetScrollPos hWnd, SB_VERT, yPos, True
Form1.Label1 = yPos
Case WM_HSCROLL'垂直水平条消息
Select Case LoWord(wParam)
Case SB_LINELEFT, SB_LINERIGHT
If LoWord(wParam) Then
xInc = 1
Else
xInc = -1
End If
Case SB_PAGELEFT, SB_PAGERIGHT
If LoWord(wParam) = SB_PAGELEFT Then
xInc = -10
Else
xInc = 10
End If
Case SB_THUMBTRACK
xInc = HiWord(wParam) - xPos
End Select
xPos = xPos + xInc
If xPos < xMin Then xPos = xMin
If xPos > xMax Then xPos = xMax
SetScrollPos hWnd, SB_HORZ, xPos, True
Form1.Label2 = xPos
End Select
WindowProc = CallWindowProc(preWndProc, hWnd, uMsg, wParam, lParam)
End Function
Public Sub SubClass(frm As Form)
preWndProc = SetWindowLong(frm.hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub UnSubClass(frm As Form)
Call SetWindowLong(frm.hWnd, GWL_WNDPROC, preWndProc)
End Sub
'The function below is much useful in API development.
Private Function LoWord(num As Long) As Integer
LoWord = num Mod &H10000
End Function
Private Function HiWord(num As Long) As Integer
HiWord = (num And &HFFFF0000) / &H10000
End Function
说明:
此程序调试比较困难,应注意不要用VB工具栏中的"结束"按钮来结束该程序,只能通过窗口上的"关闭"按钮,而且在程序中不能出错,否则VB就当掉了.以后我可能会将此程序做成一个控件,或是一个ActiveX DLL,那就方便多了

VB中msflexgrid如何加鼠标滚动？

4. vb转换股票数据的问题

大智慧股票数据 
每个记录40 byte 
格式 
long Date 0'相对开头偏移量 byte 
long Open=4 
long High=8 
long Low=12 
long Close=16 
long Volume=20 

不是二进制方式，使用随机方式 Random 读取， 读取以后 价格 /1000 就行了 

定义类型
Private Type ddzh
Date As Long
Open As Long
High As Long
Low As Long
Close As Long
Volume As Long
End1 As Long
End2 As Long
End3 As Long
End4 As Long
End Type

Private Type dzh
Date As Long
Open As Single
High As Single
Low As Single
Close As Single
Volume As Long
End Type

用 Get 读取记录到 就可以了

ReDim ddzh(1 To 1) As ddzh
ReDim dzh(1 To 1) As dzh
Open "000001.day" For Random As #1 Len= Len(ddzh(1))
ReDim ddzh(1 To Lof(1)/Len(ddzh(1))) As ddzh
For i = 1 To ReadToTal
 Get #1, i, ddzh(i)
Next i
Close #1

读取以后转换到
dzh里就可以了

大福星数据比较好用，分中图都可以读取

5. 我用vb做了个图片浏览器，请问如何实现图片的旋转效果？？

VB6.0实现图片旋转

使用过ACDSEE的朋友一定对它的JPG图片旋转功能记忆犹新，其实我们利用VB6的先进功能，可以对任意格式的图片文件（包括JPG、GIF、BMP、ICO等）进行45度、180度旋转，确实可以和ACDSEE一较高下。
  启动vb6建立一个标准exe工程，首先添加两个图片框（picture1和picture2），添加三个命令按钮command1（caption=“正常显示”）、command2（caption=“180度倒立”）、command3（caption=“45度旋转”），双击窗体，写入以下代码：
PrivateConstSRCCOPY=&HCC0020
PrivateConstPi=3.14 
PrivateDeclareFunctionSetPixelLib"gdi32"(ByValhdcAsLong, ByValxAsLong,ByValyAsLong,ByValcrColorAsLong)AsLong
PrivateDeclareFunctionGetPixelLib"gdi32"(ByValhdcAsLong, ByValxAsLong,ByValyAsLong)AsLong

PrivateDeclareFunctionStretchBltLib"gdi32"(ByValhdcAsLong, ByValxAsLong,ByValyAsLong,ByValnWidthAsLong,ByValnHeightAsLong, ByValhSrcDCAsLong,ByValxSrcAsLong,ByValySrcAsLong,ByValnSrcWidth AsLong,ByValnSrcHeightAsLong,ByValdwRopAsLong)AsLong

privateSubbmp_rotate(pic1AsPictureBox,pic2AsPictureBox,ByValtheta)‘45度旋转 
  Dimc1xAsInteger,c1yAsInteger
  Dimc2xAsInteger,c2yAsInteger
  DimaAsSingle
  Dimp1xAsInteger,p1yAsInteger
  Dimp2xAsInteger,p2yAsInteger
  DimnAsInteger,rAsInteger

  c1x=pic1.ScaleWidth\2
  c1y=pic1.ScaleHeight\2
  c2x=pic2.ScaleWidth\2
  c2y=pic2.ScaleHeight\2
  Ifc2x<c2yThenn=c2yElsen=c2x
   n=n-1
   pic1hDC=pic1.hdc
   pic2hDC=pic2.hdc
   Forp2x=0Ton
   Forp2y=0Ton
  Ifp2x=0Thena=Pi/2Elsea=Atn(p2y/p2x)
   r=Sqr(1&*p2x*p2x+1&*p2y*p2y)
   p1x=r*Cos(a+theta)
   p1y=r*Sin(a+theta)
   c0&=GetPixel(pic1hDC,c1x+p1x,c1y+p1y)
   c1&=GetPixel(pic1hDC,c1x-p1x,c1y-p1y)
   c2&=GetPixel(pic1hDC,c1x+p1y,c1y-p1x)
   c3&=GetPixel(pic1hDC,c1x-p1y,c1y+p1x)
   Ifc0&-1ThenSetPixelpic2hDC,c2x+p2x,c2y+p2y,c0
   Ifc1&-1ThenSetPixelpic2hDC,c2x-p2x,c2y-p2y,c1
   Ifc2&-1ThenSetPixelpic2hDC,c2x+p2y,c2y-p2x,c2
   Ifc3&-1ThenSetPixelpic2hDC,c2x-p2y,c2y+p2x,c3
   Next
   Next
EndSub

PrivateSubCommand1_Click()‘正常复制
 Picture2.Cls
 px=Picture1.ScaleWidth
 py=Picture1.ScaleHeight
 StretchBltPicture2.hdc,px,0,-px,py,Picture1.hdc,0,0,px,py,SRCCOPY
EndSub

PrivateSubCommand2_Click()‘180度倒立
 Picture2.Cls
 px=Picture1.ScaleWidth
 py=Picture1.ScaleHeight
 StretchBltPicture2.hdc,0,py,px,-py,Picture1.hdc,0,0,px,py,SRCCOPY
EndSub

PrivateSubCommand3_Click()‘45旋转
 Picture2.Cls
 Callbmp_rotate(Picture1,Picture2,3.14/4)
EndSub

PrivateSubForm_Load()
 onErrorResumeNext
 Me.Caption=App.Title"添加应用程序标题
 Me.Left=(Screen.Width-Me.Width)/2
 Me.Top=(Screen.Height-Me.Height)/2"窗体具中
 Picture1.ScaleMode=3
 Picture2.ScaleMode=3
EndSub

我用vb做了个图片浏览器，请问如何实现图片的旋转效果？？

6. VB的鼠标事件

在通过声明区加入以下代码：
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4

加入按钮的CLICK事件
Private Sub Command1_Click()
    Dim x As Long ‘想单击区域的X坐标，以像素为单位
    Dim y As Long‘想单击区域的Y坐标，以像素为单位

    x = 10
    y = 10
        SetCursorPos x, y
        mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub

7. vb程序编辑区为什么鼠标的滚动键没用，怎么设置可以滚动？

vb6太老旧，估计那时还没滚轮呢，在网上找个插件。我这里有一个叫vbWheel，顺便给你捎上。

vb程序编辑区为什么鼠标的滚动键没用，怎么设置可以滚动？

8. VB怎么实现滚动条对鼠标中轴的响应啊？

VB可以使用子类化处理鼠标滚轮消息。
新建工程
在窗体中添加滚动条VScroll1
 
'窗体代码
Private Sub Form_Load()
    '取得控件的句柄
    hwndVS = VScroll1.hwnd
    '保存smMap控件的默认窗口消息处理函数地址
    OldWindowProc = GetWindowLong(VScroll1.hwnd, GWL_WNDPROC)
    '将smMap控件的消息处理函数指定为自定义函数NewWindowProc
    Call SetWindowLong(VScroll1.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
End Sub
 
添加一模块：

Option Explicit
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_WNDPROC = -4&
Public Const WM_MOUSEWHEEL = &H20A
 
Public OldWindowProc As Long '用来保存系统默认的窗口消息处理函数的地址
Public hwndVS As Long  '用来保存控件的句柄
'自定义的消息处理函数
Public Function NewWindowProc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error Resume Next
    If msg = WM_MOUSEWHEEL Then
        
        '则对鼠标滚轮事件进行处理
        If wParam = -7864320 Then '向下滚动
            Form1.VScroll1.Value = Form1.VScroll1.Value + 1
        ElseIf wParam = 7864320 Then '向上滚动
            Form1.VScroll1.Value = Form1.VScroll1.Value - 1
        End If
    Else
        '调用默认窗口消息处理函数
        NewWindowProc = CallWindowProc(OldWindowProc, hwnd, msg, wParam, lParam)
    End If
End Function
最新文章
热门文章
推荐阅读