頂級高手!來!VB如何在螢幕上畫紅色邊框並隨滑鼠移動

2022-02-06 06:59:30 字數 5123 閱讀 4207

1樓:匿名使用者

'在窗體上加入控制項timer1,然後複製下面**,執行即可。

option explicit

private declare function selectobject lib "gdi32" (byval hdc as long, byval hobject as long) as long

private declare function deleteobject lib "gdi32" (byval hobject as long) as long

private declare function createpen lib "gdi32" (byval npenstyle as long, byval nwidth as long, byval crcolor as long) as long

private declare function rectangle lib "gdi32" (byval hdc as long, byval x1 as long, byval y1 as long, byval x2 as long, byval y2 as long) as long

private declare function ellipse lib "gdi32" (byval hdc as long, byval x1 as long, byval y1 as long, byval x2 as long, byval y2 as long) as long

private declare function getdc lib "user32" (byval hwnd as long) as long

private declare function getcursorpos lib "user32" (lppoint as pointapi) as long

private declare function releasedc lib "user32" (byval hwnd as long, byval hdc as long) as long

private declare function setrop2 lib "gdi32.dll" (byval hdc as long, byval ndrawmode as long) as long

private const r2_xorpen as long = 7

private const r2_black as long = 1

private const r2_not as long = 6

private const ps_solid as long = 0

private const ps_dash as long = 1

private type pointapi

x as long

y as long

end type

dim deskdc as long

dim oldx as pointapi

dim hpen as long, holdpen as long

private sub form_load()

hpen = createpen(ps_solid, 2, rgb(255, 0, 0))

deskdc = getdc(0)

holdpen = selectobject(deskdc, hpen)

end sub

private sub form_unload(cancel as integer)

selectobject deskdc, holdpen

deleteobject hpen

deskdc = releasedc(0, deskdc)

end sub

private sub timer1_timer()

dim p as pointapi

getcursorpos p

if p.x <> oldx.x and p.y <> oldx.y then

setrop2 deskdc, r2_not

rectangle deskdc, oldx.x, oldx.y, oldx.x - 10, oldx.y - 10

oldx.x = p.x: oldx.y = p.y

rectangle deskdc, p.x, p.y, p.x - 10, p.y - 10

end if

end sub

2樓:記憶中有你

1樓的**,最好是在視窗滑鼠的move事件中重繪比較好,這樣才比較符合樓主的問題啊,隨滑鼠移動,用timer會有延時的效果,不過就是可能會比較占用資源,頻繁重繪的結果,還有,如果你要畫邊框,我覺得,你繪製乙個矩形框的游標就可以了,完全不用自己重繪,那樣是最快的!windows硬體級別的切換,會很流暢的跟隨你的滑鼠移動,又不會占用太多資源,隨便找個圖示編輯器就可以實現了,沒有必要那麼麻煩的,呵呵,是吧~!

vb 如何在螢幕上 畫乙個紅色邊框 並隨滑鼠移動? 25

3樓:匿名使用者

把窗體的圖象整個儲存在乙個bitmap裡或者直接儲存在視訊記憶體裡,然後滑鼠移動時先用bitmap畫窗體,再畫框,這樣是占用資源最少的。用.net的system.

drawing裡的畫圖功能或者directx去做這件事情。

實際上所謂的擦除就是重新畫一張背景,然後再背景上畫移動的東西,和我們平時寫字然後搽掉的概念不同的,顯示卡顯示的方式都是一塊一塊的圖案往上貼而已。就是說實際上擦除只是在後台把背景畫一次,然後再上面再畫移動的東西,然後再把這個畫好的合成圖案再畫到前台顯示出來

4樓:匿名使用者

這是按鈕隨滑鼠移動的**,你可以修改一下就可以了。

private sub form_mousemove(button as integer, shift as integer, x as single, y as single)

command1.left = x

command1.top = y

end sub

5樓:匿名使用者

'在窗體上加入控制項timer1,然後複製下面**,執行即可。

option explicit

private declare function selectobject lib "gdi32" (byval hdc as long, byval hobject as long) as long

private declare function deleteobject lib "gdi32" (byval hobject as long) as long

private declare function createpen lib "gdi32" (byval npenstyle as long, byval nwidth as long, byval crcolor as long) as long

private declare function rectangle lib "gdi32" (byval hdc as long, byval x1 as long, byval y1 as long, byval x2 as long, byval y2 as long) as long

private declare function ellipse lib "gdi32" (byval hdc as long, byval x1 as long, byval y1 as long, byval x2 as long, byval y2 as long) as long

private declare function getdc lib "user32" (byval hwnd as long) as long

private declare function getcursorpos lib "user32" (lppoint as pointapi) as long

private declare function releasedc lib "user32" (byval hwnd as long, byval hdc as long) as long

private declare function setrop2 lib "gdi32.dll" (byval hdc as long, byval ndrawmode as long) as long

private const r2_xorpen as long = 7

private const r2_black as long = 1

private const r2_not as long = 6

private const ps_solid as long = 0

private const ps_dash as long = 1

private type pointapi

x as long

y as long

end type

dim deskdc as long

dim oldx as pointapi

dim hpen as long, holdpen as long

private sub form_load()

hpen = createpen(ps_solid, 2, rgb(255, 0, 0))

deskdc = getdc(0)

holdpen = selectobject(deskdc, hpen)

end sub

private sub form_unload(cancel as integer)

selectobject deskdc, holdpen

deleteobject hpen

deskdc = releasedc(0, deskdc)

end sub

private sub timer1_timer()

dim p as pointapi

getcursorpos p

if p.x <> oldx.x and p.y <> oldx.y then

setrop2 deskdc, r2_not

rectangle deskdc, oldx.x, oldx.y, oldx.x - 10, oldx.y - 10

oldx.x = p.x: oldx.y = p.y

rectangle deskdc, p.x, p.y, p.x - 10, p.y - 10

end if

end sub

VB的問題,請高手來

要在picture控制項或form裡使用print時.需將 autoredraw 屬性設定為true 或者將事件寫入 picture1 paint 事件中均可 private type student xm as string 4 bysj as date ksfs as single end ty...

如何在VB中使用keypress

按下和鬆開copy乙個ansi鍵是將發生keypress事件,該事件可用於窗體 核取方塊 組合框 列表框 命令按鈕 框和文字框等大多數控制項。當乙個控制項或窗體具有焦點時,該控制項或窗體將接受從鍵盤上輸入的資訊 keypress事件過程的一般格式為 private sub 物件名 keypress ...

如何在excel中使用VB刪除比較行

sub aa with sheet1 dim i,k as integer i 1 do while cells i,1 i i 1 loop for k 1 to i if cells k,1 cells k 1,1 then if cells k,4 cells k 1,4 then range...