欢迎光临
我们一直在努力

用VB编写一个屏幕颜色拾取器-.NET教程,VB.Net语言

建站超值云服务器,限时71元/月

设计状态下窗口中添加两个frame控件做为容器,加入二个picturebox控件,一个pictureclip控件(其中装入一个设计好的鼠标指针mask图片),两个文本框控件,几个label控件,两个command控件,一个checkbox控件。

代码如下:

option explicit

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

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

private declare function bitblt lib "gdi32" (byval hdestdc as long, byval x as long, byval y as long, byval nwidth as long, byval nheight as long, byval hsrcdc as long, byval xsrc as long, byval ysrc as long, byval dwrop as long) as long

private declare function stretchblt lib "gdi32" (byval hdc as long, byval x as long, byval y as long, byval nwidth as long, byval height as long, byval hsrcdc as long, byval xsrc as long, byval ysrc as long, byval nsrcwidth as long, byval nsrcheight as long, byval dwrop as long) as long

private declare function getpixel lib "gdi32" (byval hdc as long, byval x as long, byval y as long) as long

private declare sub setwindowpos lib "user32" (byval hwnd as long, byval hwndinsertafter as long, byval x as long, byval y as long, byval cx as long, byval cy as long, byval wflags as long)

private declare function getasynckeystate lib "user32" (byval vkey as long) as integer

private const hwnd_topmost = -1

private const hwnd_notopmost = -2

private const swp_nosize = &h1

private const swp_nomove = &h2

private const swp_noactivate = &h10

private const swp_showwindow = &h40

private type pointapi

x as long

y as long

end type

private const srccopy = &hcc0020

private const srcand = &h8800c6

private const srcpaint = &hee0086

dim mousepos as pointapi

dim oldmousepos as pointapi

private sub check1_click()

设置顶层窗口

if check1.value = 1 then

setwindowpos me.hwnd, hwnd_topmost, 0, 0, 0, 0, swp_noactivate or swp_showwindow or swp_nomove or swp_nosize

else

setwindowpos me.hwnd, hwnd_notopmost, 0, 0, 0, 0, swp_noactivate or swp_showwindow or swp_nomove or swp_nosize

end if

end sub

private sub command1_click()

开始停止捕捉屏幕

if command1.caption = "停止" then

command1.caption = "开始"

timer1.enabled = false

else

command1.caption = "停止"

timer1.enabled = true

end if

end sub

private sub command2_click()

退出程序

unload me

end sub

private sub form_activate()

程序启动后自动设置顶层窗口

check1.value = 1

end sub

private sub timer1_timer()

dim windowdc as long

dim color as long

dim r as integer, b as integer, g as integer

getcursorpos mousepos 获取鼠标当前坐标

if mousepos.x = oldmousepos.x and mousepos.y = oldmousepos.y then exit sub 若未移动则返回

frame1.caption = "坐标(" & mousepos.x & "," & mousepos.y & ")"

oldmousepos = mousepos

windowdc = getwindowdc(0) 获取屏幕的设备场景

color = getpixel(windowdc, mousepos.x, mousepos.y) 获取鼠标所指点的颜色

分解rgb颜色值

r = (color mod 256)

b = (int(color \ 65536))

g = ((color – (b * 65536) – r) \ 256)

label1.backcolor = rgb(r, g, b)

text1.text = r & "," & g & "," & b

text2.text = webcolor(r, g, b)

将以鼠标位置为中心的9*9的屏幕图像放大

stretchblt picture1.hdc, 0, 0, 73, 73, windowdc, mousepos.x – 4, mousepos.y – 4, 9, 9, srccopy

将一个鼠标指针用mask的方法透明的画到放大的图像中

picture2.picture = pictureclip1.graphiccell(1)

bitblt picture1.hdc, 37, 37, 12, 21, picture2.hdc, 0, 0, srcand

picture2.picture = pictureclip1.graphiccell(0)

bitblt picture1.hdc, 37, 37, 12, 21, picture2.hdc, 0, 0, srcpaint

获得是否按了热键f12

if getasynckeystate(vbkeyf12) <> 0 then

timer1.enabled = false

command1.caption = "开始"

end if

end sub

private function webcolor(r as integer, g as integer, b as integer) as string

将10进制rgb值转为web颜色值

webcolor = "#" & int2hex(r) & int2hex(g) & int2hex(b)

end function

private function int2hex(value as integer) as string

10进制转16进制

int2hex = hex(value)

if len(int2hex) = 1 then

int2hex = "0" & int2hex

end if

end function

赞(0)
版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com 特别注意:本站所有转载文章言论不代表本站观点! 本站所提供的图片等素材,版权归原作者所有,如需使用,请与原作者联系。未经允许不得转载:IDC资讯中心 » 用VB编写一个屏幕颜色拾取器-.NET教程,VB.Net语言
分享到: 更多 (0)

相关推荐

  • 暂无文章