實現(xiàn)在PPT演示過程中用鼠標拖動圖片

1、實現(xiàn)在ppt演示過程中，用鼠標拖動圖片1新建一個ppt空白文檔。2點擊菜單：“工具宏宏”，出現(xiàn)對話框。3對話框中“宏名”寫：drop（其他也可以），再點“創(chuàng)建”，就進入代碼模式。4“sub drop() 宏由番茄花園創(chuàng)建，日期 2010-4-8。end sub”，類似的三句全刪掉。把下面的代碼全拷貝進去。option explicitdeclare function getkeystate lib user32 (byval nvirtkey as long) as integerprivate declare function windowfrompoint lib user32 (byva

2、l 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 lon

3、g) 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 &

4、 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

5、 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_sc

6、reeny): 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.slid

7、eheightend 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.

8、y - sy) / dy - sh.height / 2 doevents i = i + 1: if i 2000 then dragmode = false: exit subwendend sub5點擊保存后，關(guān)閉代碼模式，回到ppt設(shè)計頁面。在你需要拖動的圖片上點右鍵，選擇“動作設(shè)置單擊鼠標運行宏確定”。然后就看效果吧。option explicit 聲明模塊中將要使用的 win32的 api 函數(shù)private declare function getdc lib user32 (byval hwnd as long) as longprivate declare function

9、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 lpti

10、merfunc 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 定義函數(shù)及過程中要使用的常量private const logpixelsx

11、 = 88讓 getdevicecaps 函數(shù)返回像素/邏輯英寸（水平）private const logpixelsy = 90讓 getdevicecaps 函數(shù)返回像素/邏輯英寸（垂直）private const twipsperinch = 1440 每英寸約等于 1440 twip（緹）定義相關(guān)變量private xpixelsperinch as long 存儲每邏輯英寸對應(yīng)的水平像素點數(shù)private ypixelsperinch as long 存儲每邏輯英寸對應(yīng)的水平像素點數(shù)private ratio as single 存儲窗口或屏幕的縮放比率private moving

12、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 定義用于存儲設(shè)備場景

13、的變量on error resume nextif slideshowwindows.count 0 then 只有當幻燈片放映時才進行處理if moving then 如果 moving為 true則停止移動endmoveshapeelse moving 為 false 則讓形狀跟隨鼠標移動hdc = getdc(0) 獲取整個屏幕的設(shè)備場景（程序窗口外），dc 即：device context。xpixelsperinch = getdevicecaps(hdc, logpixelsx) 取得每邏輯英寸 對應(yīng)的水平像素點數(shù)ypixelsperinch = getdevicecaps(hdc

14、, logpixelsy) 取得每邏輯英寸 對應(yīng)的垂直像素點數(shù)releasedc 0, hdc 釋放整個屏幕的設(shè)備場景ratio = shp.parent.parent.slideshowwindow.view.zoom / 100# 取得 放映窗口的縮放比率set dragshp = shp 獲取當前將要被拖動的形狀origshpleft = shp.left 保存形狀的初始水平坐標origshptop = shp.top 保存形狀的初始垂直坐標getcursorpos origmouselocation 獲取鼠標的當前位置starttimer 調(diào)用啟動計時器的過程moving = true

15、 設(shè)置移動正在進行的標志為trueend ifend ifend sub 定義結(jié)束形狀移動的過程sub endmoveshape()on error resume nextmoving = false 設(shè)置移動正在進行的標志為falsestoptimer 終止計時器set dragshp = nothing 清除定義的對象變量end sub 啟動計時器的過程private sub starttimer()on error resume next 啟動計時器，并調(diào)用 timerproc 過程來實現(xiàn)形狀對鼠標的跟隨timerid = settimer(0, 0, 10, addressof tim

16、erproc)end sub 停止計時器的過程private sub stoptimer()on error resume nextkilltimer 0, timerid 銷毀計時器，釋放系統(tǒng)資源end sub 在計時器過程中被調(diào)用來處理鼠標位置及移動形狀的過程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