MainFrm.frm

VB鼠标钩子与屏幕取色

最新推荐文章于 2022-09-27 16:15:27 发布

最新推荐文章于 2022-09-27 16:15:27 发布 · 127 阅读

VERSION 5.00 Begin VB.Form MainFrm Caption = "Form1" ClientHeight = 7800 ClientLeft = 16620 ClientTop = 1350 ClientWidth = 1965 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 7800 ScaleWidth = 1965 Begin VB.Timer Timer1 Interval = 300 Left = 0 Top = 0 End Begin VB.CommandButton Command1 Caption = "Command1" Height = 495 Left = 360 TabIndex = 0 Top = 4440 Width = 1215 End Begin VB.Label Lab_XY Height = 855 Left = 120 TabIndex = 1 Top = 240 Width = 1695 End End Attribute VB_Name = "MainFrm" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit '为什么只能放到这里？ Public WithEvents VBHook As cSystemHook Attribute VBHook.VB_VarHelpID = -1 Private Sub Command1_Click() Call INI_Write("POSITON", "X", Me.Left) Call INI_Write("POSITON", "Y", Me.Top) Call INI_Write("POSITON", "HEIGHT", Me.Height) Call INI_Write("POSITON", "WIDTH", Me.Width) End Sub Private Sub Form_Load() Call Main_Init '应该放这里的！ '设置全局钩子,引用vb_hook.dll文件 Set VBHook = New cSystemHook VBHook.SetHook End Sub Private Sub Form_Paint() Call AlwaysOnTop(Me.hWnd, True) '修正最顶层问题！ End Sub '存在问题! Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) '如果程序不同意关机 ,Cancel 设定为 True 'Cancel = True Select Case UnloadMode Case 0: '窗体右上角的X号关闭窗体 Case 1: '程序代码关闭窗体，例如Unload Me Case 2: '关闭Windows关闭窗体 Case 3: '在任务管理器中关闭窗体 Case 4: 'MDI窗体被卸载时关闭窗体 End Select Call Shell_NotifyIcon(NIM_DELETE, nfIconData) '释放全局钩子 VBHook.RemoveHook Set VBHook = Nothing End End Sub Private Sub Timer1_Timer() 'Timer的Interval值设为300吧 Call QQHiden(Me) End Sub '鼠标钩子 Private Sub VBHook_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) '获得RGB,分解RGB颜色值 '颜色分解有问题！和系统颜色有点差 Dim R As Integer, G As Integer, B As Integer, Color As Long Color = GetColorFromPoint(x, y) R = (Color Mod 256) B = (Int(Color / 65536)) G = ((Color - (B * 65536) - R) / 256) Lab_XY.Caption = "X坐标:" & x & vbCrLf & "Y坐标:" & y & vbCrLf & "R:" & R & " G:" & G & " B:" & B Lab_XY.BackColor = RGB(R, G, B) End Sub

Private Sub Command1_Click()
Call INI_Write("POSITON", "X", Me.Left)
Call INI_Write("POSITON", "Y", Me.Top)
Call INI_Write("POSITON", "HEIGHT", Me.Height)
Call INI_Write("POSITON", "WIDTH", Me.Width)

End Sub

Private Sub Form_Load()
Call Main_Init '应该放这里的！
'设置全局钩子,引用vb_hook.dll文件
Set VBHook = New cSystemHook
VBHook.SetHook
End Sub

Private Sub Form_Paint()
Call AlwaysOnTop(Me.hWnd, True) '修正最顶层问题！
End Sub

'存在问题!
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'如果程序不同意关机 ,Cancel 设定为 True
'Cancel = True

Select Case UnloadMode
Case 0:
'窗体右上角的X号关闭窗体
Case 1:
'程序代码关闭窗体，例如Unload Me
Case 2:
'关闭Windows关闭窗体
Case 3:
'在任务管理器中关闭窗体
Case 4:
'MDI窗体被卸载时关闭窗体
End Select
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)

'释放全局钩子
VBHook.RemoveHook
Set VBHook = Nothing
End
End Sub

Private Sub Timer1_Timer() 'Timer的Interval值设为300吧
Call QQHiden(Me)
End Sub

'鼠标钩子
Private Sub VBHook_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
'获得RGB,分解RGB颜色值
'颜色分解有问题！和系统颜色有点差
Dim R As Integer, G As Integer, B As Integer, Color As Long
Color = GetColorFromPoint(x, y)
R = (Color Mod 256)
B = (Int(Color / 65536))
G = ((Color - (B * 65536) - R) / 256)
Lab_XY.Caption = "X坐标:" & x & vbCrLf & "Y坐标:" & y & vbCrLf & "R:" & R & " G:" & G & " B:" & B
Lab_XY.BackColor = RGB(R, G, B)
End Sub