form1.frm

本文件包含200个visual baisc实例

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "获取鼠标任意位置的颜色值"
   ClientHeight    =   2160
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3540
   LinkTopic       =   "Form1"
   ScaleHeight     =   2160
   ScaleWidth      =   3540
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton Command1 
      Caption         =   "退出"
      Height          =   450
      Left            =   675
      TabIndex        =   3
      Top             =   1590
      Width           =   2010
   End
   Begin VB.Timer Timer1 
      Interval        =   50
      Left            =   225
      Top             =   1185
   End
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   960
      Left            =   2295
      ScaleHeight     =   930
      ScaleWidth      =   930
      TabIndex        =   0
      Top             =   285
      Width           =   960
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      Caption         =   "RGB颜色值:"
      Height          =   180
      Left            =   630
      TabIndex        =   2
      Top             =   330
      Width           =   900
   End
   Begin VB.Label label2 
      Alignment       =   2  'Center
      Height          =   255
      Left            =   225
      TabIndex        =   1
      Top             =   585
      Width           =   1755
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'API函数声明
Option Explicit
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 GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd 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 Type POINTAPI    '创建用户自定义的类型
    x As Long    '定义X的数据类型
    y As Long    '定义Y的数据类型
End Type

Private Sub Timer1_Timer()
  Dim P1 As POINTAPI, h As Long, h1 As Long, r1 As Long
  GetCursorPos P1
  h1 = GetDC(h)
  r1 = GetPixel(h1, P1.x, P1.y)
  If r1 = -1 Then
     BitBlt Picture1.hdc, 0, 0, 1, 1, h1, P1.x, P1.y, vbSrcCopy
     r1 = Picture1.Point(0, 0)
   Else
     Picture1.PSet (0, 0), r1
  End If
  label2.Caption = Hex$(r1)
  Picture1.BackColor = r1
End Sub

Private Sub Command1_Click()
  End
End Sub