vb.net取屏幕颜色 vb设置窗体颜色

VB.NET:绘图后,如何才能取得所绘图形的颜色值?

加入一个TextBox控件,一个Command控件

成都创新互联公司长期为上千多家客户提供的网站建设服务,团队从业经验10年,关注不同地域、不同群体,并针对不同对象提供差异化的产品和服务;打造开放共赢平台,与合作伙伴共同营造健康的互联网生态环境。为深泽企业提供专业的网站设计制作、做网站深泽网站改版等技术服务。拥有十余年丰富建站经验和众多成功案例,为您定制开发。

代码:

Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long

Private Sub Command1_Click()

Dim Color As Long

WindowDC = GetWindowDC(0) '获取屏幕的设备场景

Color = GetPixel(WindowDC, 500, 100) '获指定点的颜色

'分解RGB颜色值

R = (Color Mod 256) '红色

b = (Int(Color \ 65536)) '蓝色

G = ((Color - (b * 65536) - R) \ 256) '绿色

Text1.BackColor = RGB(R, G, b)

End Sub

vb.net 对固定坐标取色

Using b As New Bitmap(1, 1)

Using g As Graphics = Graphics.FromImage(b)

g.CopyFromScreen(New Point(300, 300), New Point, New Size(1, 1))

PictureBox1.BackColor = b.GetPixel(0, 0)

End Using

End Using

复制当前屏幕左上角位置(300,300)的一个点,取其颜色

VB.NET当鼠标停在屏幕任意地方,得到该点的颜色

我有个笨办法,先用API抓图到内存里,然后再在根据你点鼠标的屏幕工作区坐标,去那图里取色。

-----------------------

'抓图所需的API

Private Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hDC As Integer) As Integer

Private Declare Function CreateCompatibleBitmap Lib "GDI32" (ByVal hDC As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer) As Integer

Private Declare Function SelectObject Lib "GDI32" (ByVal hDC As Integer, ByVal hObject As Integer) As Integer

Private Declare Function BitBlt Lib "GDI32" (ByVal srchDC As Integer, ByVal srcX As Integer, ByVal srcY As Integer, ByVal srcW As Integer, ByVal srcH As Integer, ByVal desthDC As Integer, ByVal destX As Integer, ByVal destY As Integer, ByVal op As Integer) As Integer

Private Declare Function DeleteDC Lib "GDI32" (ByVal hDC As Integer) As Integer

Private Declare Function DeleteObject Lib "GDI32" (ByVal hObj As Integer) As Integer

Declare Function GetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Integer) As Integer

Const SRCCOPY As Integer = HCC0020

'抓图的部分

Dim hDC, hMDC As Integer

Dim hBMP, hBMPOld As Integer

Dim sw, sh As Integer

hDC = GetDC(0)

hMDC = CreateCompatibleDC(hDC)

sw = Screen.PrimaryScreen.Bounds.Width

sh = Screen.PrimaryScreen.Bounds.Height

hBMP = CreateCompatibleBitmap(hDC, sw, sh)

hBMPOld = SelectObject(hMDC, hBMP)

BitBlt(hMDC, 0, 0, sw, sh, hDC, 0, 0, SRCCOPY)

hBMP = SelectObject(hMDC, hBMPOld)

Dim bmp As Bitmap = Image.FromHbitmap(New IntPtr(hBMP))

DeleteDC(hDC)

DeleteDC(hMDC)

DeleteObject(hBMP)

......

'取点的颜色

bmp.GetPixel(e.X, e.Y)

----------------------------

关键就是这些你自己组合吧,你分给的太少了,很麻烦,恕我不帮你改全了。如果要仔细帮你改,请另开高分贴,不要用新马甲来

VB如何获取屏幕上的颜色值呢

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

MsgBox "你选取的颜色是" Hex(Point(X, Y))

End Sub

VB如何快速获取屏幕所有坐标的颜色值,是全部每一个点,保存在二维数组里面。

Private Type RGBQUAD

rgbBlue As Byte

rgbGreen As Byte

rgbRed As Byte

rgbAlpha As Byte '透明通道

End Type

Private Type BITMAPINFOHEADER

biSize As Long '位图大小

biWidth As Long

biHeight As Long

biPlanes As Integer

biBitCount As Integer '信息头长度

biCompression As Long '压缩方式

biSizeImage As Long

biXPelsPerMeter As Long

biYPelsPerMeter As Long

biClrUsed As Long

biClrImportant As Long

End Type

Private Type BITMAPINFO

bmiHeader As BITMAPINFOHEADER

bmiColors As RGBQUAD

End Type

Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long

Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function BitBlt Lib "gdi32" (ByVal hDCDest As Long, ByVal XDest As Long, ByVal YDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hDCSrc As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Sub Command1_Click()

Dim hDCMemory As Long, hBmp As Long, hBmpPrev As Long, r As Long, hDCSrc As Long, hPal As Long, hPalPrev As Long

Dim LeftSrc As Long, TopSrc As Long, WidthSrc As Long, HeightSrc As Long, bytDataOut() As Byte, lngOut() As Long

Dim BitInfo As BITMAPINFO

Dim i As Long, j As Long

'修改下面4个参数就可以调整画面范围

LeftSrc = 0

TopSrc = 0

WidthSrc = 1024

HeightSrc = 768

hDCSrc = GetWindowDC(0) '(hWndSrc)

hDCMemory = CreateCompatibleDC(hDCSrc)

hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)

hBmpPrev = SelectObject(hDCMemory, hBmp)

r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy)

ReDim bytDataOut(2, WidthSrc - 1, HeightSrc - 1)

ReDim lngOut(WidthSrc - 1, HeightSrc - 1)

With BitInfo.bmiHeader

.biBitCount = 24

.biCompression = 0

.biPlanes = 1

.biSize = Len(BitInfo.bmiHeader)

.biWidth = WidthSrc

.biHeight = -HeightSrc

End With

GetDIBits hDCMemory, hBmp, 0, HeightSrc, bytDataOut(0, 0, 0), BitInfo, 0

hBmp = SelectObject(hDCMemory, hBmpPrev)

r = DeleteDC(hDCMemory)

r = ReleaseDC(hWndSrc, hDCSrc)

DeleteObject hBmp

For i = LeftSrc To WidthSrc - 1

For j = TopSrc To HeightSrc - 1

lngOut(i, j) = RGB(bytDataOut(0, i, j), bytDataOut(1, i, j), bytDataOut(2, i, j))

Next

Next

MsgBox "数据已存放在lngOut数组里面" lngOut(5, 5)

End Sub

修改了下,这次没问题啦

VBNET怎么获取控件颜色的RGB值,又怎么用RGB将颜色赋给控件颜色。

R/G/B值最小是0最大是255属Byte值类型

Dim cr As Color = 控件.BackColor '获取控件背景色

Dim alpha As Byte = cr.A '透明度

Dim R As Byte = cr.R 'R值

Dim G As Byte = cr.G 'G值

Dim B As Byte = cr.B 'B值

Dim outAcr As Color = Color.FromArgb(alpha, R, G, B) '创建带有透明通道的ARGB颜色

Dim outcr As Color = Color.FromArgb(R, G, B) '创建不透明的RGB颜色


本文题目:vb.net取屏幕颜色 vb设置窗体颜色
本文链接:http://lszwz.com/article/hjdssd.html

其他资讯

售后响应及时

7×24小时客服热线

数据备份

更安全、更高效、更稳定

价格公道精准

项目经理精准报价不弄虚作假

合作无风险

重合同讲信誉,无效全额退款