发信人: gzwsh()
整理人: fishy(2000-09-05 10:36:40), 站内信件
|
需有控件Label、Picture1
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Lo
ng
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, B
yVal hdc As Long) As Long
Private Declare Function GetCapture Lib "user32" () As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVa
l x As Long, ByVal y As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAP
I) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long
, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByV
al cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const HWND_TOPMOST = -1
Private Const SWP_NOMOVE = &H2
Private Function getpixels() As Long
Dim dc As Long, rret As Long
Dim pos As POINTAPI
dc = GetDC(0)
rret = GetCursorPos(pos)
getpixels = GetPixel(dc, pos.x, pos.y)
rret = ReleaseDC(0, dc)
End Function
Private Sub Form_Load()
Dim NewPos As Long
Me.ScaleMode = vbPixels
NewPos = SetWindowPos(Me.hwnd, HWND_TOPMOST, Me.Width, Me.Height,
160, 250, SWP_NOMOVE)
End Sub
Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, x As
Single, y As Single)
Dim gret As Long
gret = GetCapture()
End Sub
Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, x As
Single, y As Single)
Dim colors As Long
If Button = vbLeftButton Then
colors = getpixels()
Picture1.BackColor = colors
End If
End Sub
Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, x As S
ingle, y As Single)
Dim rret As Long
rret = ReleaseCapture()
End Sub
--
※ 修改:．gzwsh 于 Aug 26 15:33:26 修改本文．[FROM: 202.104.71.4]
※ 来源:．月光软件站 http://www.moon-soft.com．[FROM: 202.104.71.4]
|
|