实现在PPT演示过程中，用鼠标拖动图片.doc

实现在ppt演示过程中，用鼠标拖动图片1新建一个ppt空白文档。2点击菜单：“工具宏宏”，出现对话框。3对话框中“宏名”写：drop（其他也可以），再点“创建”，就进入代码模式。4“sub drop() 宏由番茄花园创建，日期 2010-4-8。end sub”，类似的三句全删掉。把下面的代码全拷贝进去。option explicitdeclare function getkeystate lib user32 (byval nvirtkey as long) as integerprivate declare function windowfrompoint lib user32 (byval xpoint as long, byval ypoint as long) as longprivate declare function getwindowrect lib user32 (byval hwnd as long, lprect as rect) as longprivate declare function getcursorpos lib user32 (lppoint as pointapi) as longprivate declare function setcursorpos lib user32 (byval x as long, byval y as long) as longpublic declare function monitorfrompoint lib user32.dll (byval x as long, byval y as long, byval dwflags as long) as longprivate declare function getsystemmetrics lib user32 (byval nindex as long) as longprivate const sm_screenx = 0private const sm_screeny = 1private const sigproc = drag & droppublic const vk_shift = &h10public const vk_ctrl = &h11public const vk_alt = &h12private type pointapi x as long y as longend typepublic type rect left as long top as long right as long bottom as longend typepublic mpoint as pointapi, dpoint as pointapipublic activeshape as shapedim dragmode as booleandim dx as double, dy as doublesub draganddrop(sh as shape) dragmode = not dragmode if dragmode then drag shend subprivate sub drag(sh as shape)dim i as integer, sx as integer, sy as integerdim mwnd as long, wr as rectdx = getsystemmetrics(sm_screenx): dpoint.x = dxdy = getsystemmetrics(sm_screeny): dpoint.y = dygetcursorpos mpointwith activepresentation.slideshowwindow mwnd = windowfrompoint(mpoint.x, mpoint.y) getwindowrect mwnd, wr sx = wr.left sy = wr.top dx = (wr.right - wr.left) / activepresentation.pagesetup.slidewidth dy = (wr.bottom - wr.top) / activepresentation.pagesetup.slideheightend withif dx dy then sx = sx + (dx - dy) * activepresentation.pagesetup.slidewidth / 2 dx = dyend ifif dy dx then sy = sy + (dy - dx) * activepresentation.pagesetup.slideheight / 2 dy = dxend ifwhile dragmode getcursorpos mpoint sh.left = (mpoint.x - sx) / dx - sh.width / 2 sh.top = (mpoint.y - sy) / dy - sh.height / 2 doevents i = i + 1: if i 2000 then dragmode = false: exit subwendend sub5点击保存后，关闭代码模式，回到ppt设计页面。在你需要拖动的图片上点右键，选择“动作设置单击鼠标运行宏确定”。然后就看效果吧。option explicit 声明模块中将要使用的 win32的 api 函数private declare function getdc lib user32 (byval hwnd as long) as longprivate declare function releasedc lib user32 ( _byval hwnd as long, _byval hdc as long) as longprivate declare function getdevicecaps lib gdi32 ( _byval hdc as long, _byval nindex as long) as longprivate declare function settimer lib user32 ( _byval hwnd as long, _byval nidevent as long, _byval uelapse as long, _byval lptimerfunc as long) as longprivate declare function killtimer lib user32 ( _byval hwnd as long, _byval nidevent as long) as longprivate declare function getcursorpos lib user32 (lppoint as point) as long声明 point类型，将用来定义存储位置坐标的变量type pointx as longy as longend type 定义函数及过程中要使用的常量private const logpixelsx = 88让 getdevicecaps 函数返回像素/逻辑英寸（水平）private const logpixelsy = 90让 getdevicecaps 函数返回像素/逻辑英寸（垂直）private const twipsperinch = 1440 每英寸约等于 1440 twip（缇）定义相关变量private xpixelsperinch as long 存储每逻辑英寸对应的水平像素点数private ypixelsperinch as long 存储每逻辑英寸对应的水平像素点数private ratio as single 存储窗口或屏幕的缩放比率private moving as boolean 存储判断移动是否正在进行的标志private dragshp as shape 存储被拖移的形状对象private timerid as long 存储计时器标识符private origshpleft as single 存储形状被拖动前的水平坐标private origshptop as single 存储形状被拖动前的垂直坐标private origmouselocation as point 存储鼠标点击形并开始拖动形状时的坐标点定义移动形状的过程sub moveshape(byval shp as shape)dim hdc as long 定义用于存储设备场景的变量on error resume nextif slideshowwindows.count 0 then 只有当幻灯片放映时才进行处理if moving then 如果 moving为 true则停止移动endmoveshapeelse moving 为 false 则让形状跟随鼠标移动hdc = getdc(0) 获取整个屏幕的设备场景（程序窗口外），dc 即：device context。xpixelsperinch = getdevicecaps(hdc, logpixelsx) 取得每逻辑英寸 对应的水平像素点数ypixelsperinch = getdevicecaps(hdc, logpixelsy) 取得每逻辑英寸 对应的垂直像素点数releasedc 0, hdc 释放整个屏幕的设备场景ratio = shp.parent.parent.slideshowwindow.view.zoom / 100# 取得 放映窗口的缩放比率set dragshp = shp 获取当前将要被拖动的形状origshpleft = shp.left 保存形状的初始水平坐标origshptop = shp.top 保存形状的初始垂直坐标getcursorpos origmouselocation 获取鼠标的当前位置starttimer 调用启动计时器的过程moving = true 设置移动正在进行的标志为trueend ifend ifend sub 定义结束形状移动的过程sub endmoveshape()on error resume nextmoving = false 设置移动正在进行的标志为falsestoptimer 终止计时器set dragshp = nothing 清除定义的对象变量end sub 启动计时器的过程private sub starttimer()on error resume next 启动计时器，并调用 timerproc 过程来实现形状对鼠标的跟随timerid = settimer(0, 0, 10, addressof timerproc)end sub 停止计时器的过程private sub stoptimer()on error resume nextkilltimer 0, timerid 销毁计时器，释放系统资源end sub 在计时器过程中被调用来处理鼠标位置及移动形状的过程private sub timerproc(byval hwnd as long, _byval umsg as long, _byval wparam as long, _byval lparam as long)dim curmouselocation as point 存储鼠标的当前位置dim deltax as single 存储鼠标水平移动的距离dim deltay as single 存储鼠标垂直移动的距离on error resume nextif moving then 移动正在进行的标志为真时进行处理getcursorpos curmouselocation 获取鼠标的当前坐标deltax = (curmouselocation.x - origmouselocation.x) * _twipsperinch / 20 / xpixelsperinch