新云软件园:请安心下载,绿色无病毒!

软件提交最近更新热门排行
您现在的位置:首页››编程教学››.NET编程››VB.NET语言

在MapX中响应滚轮放大缩小地图

2005-06-15 00:59作者:佚名来源:本站整理浏览:707 评论:0

’模块中

Option Explicit

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
   Select Case wMsg
       Case WM_MOUSEWHEEL
\t    Select Case wParam
\t        Case -7864320     '向下滚
\t\t    SetCurrentScale "ZoomOut", 2
\t        Case 7864320       '向上滚
\t\t    SetCurrentScale "ZoomIn", 2
\t  End Select
   End Select
   
   FlexScroll = CallWindowProc(Oldwinproc, hWnd, wMsg, wParam, lParam)
End Function



Private Sub SetCurrentScale(strINorOut As String, dScale As Double)
   If frmMain.Map1 Is Nothing Then Exit Sub
   
   If strINorOut = "ZoomIn" Then
       frmMain.Map1.Zoom = (frmMain.Map1.Zoom) * dScale
       frmMain.Map1.Refresh
   ElseIf strINorOut = "ZoomOut" Then
       frmMain.Map1.Zoom = (frmMain.Map1.Zoom) / dScale
       frmMain.Map1.Refresh
   End If
End Sub







Private Sub Form_Load()
\t
   Oldwinproc = GetWindowLong(Map1.hWnd, GWL_WNDPROC)
   SetWindowLong Map1.hWnd, GWL_WNDPROC, AddressOf FlexScroll

End Sub

Private Sub Form_Unload(Cancel As Integer)
   SetWindowLong Map1.hWnd, GWL_WNDPROC, Oldwinproc
End Sub
Tags:责任编辑:cvery
顶一下(62)
92.54%
    1. 中国地图20152015中国地图

      新云下载给大家提供的中国地图2015下载包含有中国地图全图大图高清版、中国地图全图各省高清版、中国地图全图2015、中国地图电子版2015、中国竖版地图2015等等,有这方面的需要的欢迎来新云网络下载!...

    1. 谷歌软件谷歌软件

      谷歌软件合集包含与谷歌相关大量实用软件,欢迎下载试用。

    文章评论 新云下载QQ群:① 7551827使用手机微信搜索 微信号:xinyunshouyou 关注我们 有更多惊喜!!

    请自觉遵守互联网相关政策法规,评论内容只代表网友观点,与本站立场无关!
      验证码:     登录   注册
    网友评论