RGB取得

' 標準モジュールに追加
Declare PtrSafe Function GetCursorPos Lib "user32" (ByRef lpPoint As POINTAPI) As Long
Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal hdc As LongPtr, ByVal x As Long, ByVal y As Long) As Long
Declare PtrSafe Function GetWindowDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long

Type POINTAPI
    x As Long
    y As Long
End Type

Sub GetMousePositionColor()
    Dim pt As POINTAPI
    Dim wst As Worksheet
    Dim lngColor As Long
    Dim lngRowOutput As Long
    Dim hdc As LongPtr
    Dim strRGB As String

    ' マウスの現在位置を取得
    GetCursorPos pt

    ' デスクトップのデバイスコンテキストを取得
    hdc = GetWindowDC(0&)

    ' マウスの位置にある色を取得
    lngColor = GetPixel(hdc, pt.x, pt.y)

    ' RGB値をメッセージボックスに表示
    strRGB = "RGB(" & lngColor Mod 256 & ", " & (lngColor \ 256) Mod 256 & ", " & (lngColor \ 65536) Mod 256 & ")"
    
    Set wst = Worksheets("色取得")
    lngRowOutput = wst.Range("A1").CurrentRegion.Rows.Count + 1
    wst.Range("A" & lngRowOutput).Value = strRGB
    
    ' デバイスコンテキストの解放
    ReleaseDC 0&, hdc
End Sub

コメント