#403 イメージコントロール上のカーソル位置のRGB値を取得する方法 フォーム、API

フォーム上に配置されたイメージコントロールに写真などの画像が表示されている状態で、その上でマウスを移動させたとき、マウスカーソルのある位置の画像の色(RGB値)を取得する方法です。カーソル位置やその色の取得には、Windows APIを使っています。

以下のコードをすべてフォームのモジュールに記述します。この例では、"imgPhoto"という名前のイメージコントロール上でマウスが移動したとき(MouseMoveイベント発生時)、"txtColorInfo"という名前のテキストボックスにそのポイントの位置やRGB値を表示するとともに、そのテキストボックスの背景色もその色に変更しています。

Option Compare Database
Option Explicit

Private Type POINT
  x As Long
  y As Long
End Type

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINT) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, _
  ByVal x As Long, ByVal y As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
  ByVal hdc As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long


Private Sub imgPhoto_MouseMove(Button As Integer, _
  Shift As Integer, x As Single, y As Single)

  Dim lngScrnhDC As Long
  Dim pt As POINT
  Dim pc As Long
  Dim bytR As Byte, bytG As Byte, bytB As Byte
  Static sngPrevX As Single
  Static sngPrevY As Single

  'マウスの位置が前回と同じなら何もしない
  '(マウスが動かなくてもイベント発生して画面がチカチカするのを防止)
  If x = sngPrevX And y = sngPrevY Then Exit Sub

  'マウスの位置をStatic変数に保存
  sngPrevX = x: sngPrevY = y

  'デバイスコンテキストを取得
  lngScrnhDC = GetDC(0&)
  'マウスをキャプチャ
  SetCapture Me.hwnd
  'スクリーン座標を取得
  GetCursorPos pt
  'その座標の色を取得
  pc = GetPixel(lngScrnhDC, pt.x, pt.y)
  '取得された色の値をRGBに分解
  bytR = CByte(pc And &HFF)
  bytG = CByte((pc \ 256) And &HFF)
  bytB = CByte((pc \ 65536) And &HFF)
  '取得された情報をテキストボックスに表示
  txtColorInfo.BackColor = pc
  txtColorInfo = "座標:" & pt.x & "," & pt.y & "   " & _
                  "RGB値 = " & bytR & "," & bytG & "," & bytB
  'デバイスコンテキストを解放
  ReleaseDC 0&, lngScrnhDC
  'マウスキャプチャを解放
  ReleaseCapture

End Sub


実行結果:
実行結果
実行結果
| Index | Prev | Next |

この情報は参考になりましたか?、問題は解決しましたか?、もしまだなら......
T'sWareのワンポイトテクニカルアドバイスをご利用ください。3000円/件〜でご支援します。
スタンドアロンからSQL Server対応まで、オーダーメイドのシステムを短納期・安価でお届けします
 

Copyright © T'sWare All rights reserved