質問です。よろしくお願いします。
画像をファイルから読み込んで、その画像のx軸(またはy軸)を指定(x=3のように)して、その軸上のRGBを読み取り、R,G,Bそれぞれの値を(折れ線)グラフとして、表示したいと考えています。
まず、画像をファイルから読み込ませ、表示させるこはできました。
しかし、軸上のRGBの読み方は、pointメソッドを使うのかな?そして、Loopで回すのかな?まずが、画像における座標の設定もいるのかな?と思っているのですが、うまくいきません。
どなたか、良い方法をお教えください。
ちなみに折れ線グラフの表示の仕方は、たぶん習得しましたので、
画像の指定軸上のRGB読み取り方を教えてください。
よろしくお願いします。
うまくいかなかった
ソースを公開してみては?
>>あんさん
ご指摘ありがとうございます.
まず、ソースを公開します.
'****************
'***グラフ表示***
'****************
Private Sub Command6_Click()
Dim xjiku, xjiku1, xjiku2, yjiku, yjiku1, yjiku2, R, R1, R2, R3, R4 As Single
xjiku = Val(Text6.Text) 'x軸を指定する場合の数値(ex.x=3etc...)
yjiku = Val(Text7.Text) 'y軸を指定する場合の数値
'***フォームの設定***
Picture3.Scale (0, 255)-(401, 0)
'**座標軸表示***
If xjiku <> 0 Then
Text8.Text = " x = " & Text6.Text
Else
Text8.Text = " y = " & Text7.Text
End If
'***グラフ表示***
Picture3.Line (0, 0)-(400, 255), RGB(0, 0, 0), B
xjiku1 = Val(xjiku)
yjiku1 = Val(yjiku)
If xjiku1 <> 0 Then
yjiku1 = 0
R1 = Picture1.POINT(xjiku1, yjiku1) 'Picutre1の画像における座標の読み取り
R2 = R1 - 256 ^ 2 - 256
Do While yjiku2 = yjiku1 + 1
R3 = Picture1.POINT(xjiku1, yjiku2)
R4 = R3 - 256 * 256 - 256
Picture3.Line (xjiku1, R2)-(xjiku1, R4), RGB(255, 0, 0)
'Picture3にグラフを表示したい
yjiku1 = yjiku2
Loop
Else
xjiku1 = 0
R1 = Picture1.POINT(xjiku1, yjiku1)
R2 = R1 - 256 * 256 - 256
Do While xjiku2 = xjiku1 + 1
R3 = Picture1.POINT(xjiku2, yjiku1)
R4 = R3 - 256 * 256 - 256
Picture3.Line (yjiku1, R2)-(yjiku2, R4), RGB(255, 0, 0)
xjiku1 = xjiku2
Loop
End If
End Sub
私がわからないこと.
・まず、読み込もうとしている画像は、PictureBoxで表示しているのですが、
機能として、マウスでクリックした場所の座標表示/RGB表示をすでに組み込みました.そして、そのPictureBoxの四隅の座標をクリックすると,原点となる(0,0)が存在せず,(85,104),(408,104),(408,348),(88,348)となっていてる.
・そのため、画像の軸を指定したとしても、RGBを読み取れないていないのかと考えています.
途中で送信してしまいました.
以上のようなソースを書き込んでいます.
よろしくお願いします.
>マウスでクリックした場所の座標表示/RGB表示をすでに組み込みました.
このソースは?
>>あんさん
再び、すいません。
以下が、ソース全文です。
'***構造体の定義***
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 ReleaseDC Lib "user32" (ByVal hwnd As _
Long, ByVal hdc As Long) As Long
'***マウスカーソルの座標を,スクリーン座標で取得***
Private Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINT) As Long
'***指定されたウィンドウにマウスキャプチャする***
Private Declare Function SetCapture Lib "user32" _
(ByVal hwnd As Long) As Long
'--------------引数----------------
'(hwnd) マウスをジャプチャするウィンドウハンドル
'-----------------戻り値-------------------
'その前にキャプチャされていたウィンドウのハンドルを返す
'そういったウィンドウがなければ0を返す
'***キャプチャの解放***
Private Declare Function ReleaseCapture Lib "user32" () _
As Long
'--------------------戻り値--------------------------
'関数が成功すると0 以外の値が返り
'関数が失敗すると0が返る
'***指定座標カラーの取得***
Private Declare Function GetPixel Lib "gdi32" (ByVal _
hdc As Long, ByVal x As Long, ByVal Y As Long) As Long
'---------------------引数---------------------------
'(hdc) 対象のデバイスコンテキスト
'(x) 色を取得するx座標
'(y) 色を取得するy座標
'--------------------戻り値--------------------------
'RGB値を返す
'スクリーン座標の格納
Dim p As POINT
'スクリーンのデバイスコンテキスト
Dim ScreenhDC As Long
'********************
'***モノクロ画像表示***
'********************
Private Sub Command1_Click()
'***画像出力***
CommonDialog1.ShowOpen
Picture1.PaintPicture LoadPicture(CommonDialog1.FileName), 0, 0, Picture1.Width, Picture1.Height, 0, 0
'***ファイル名保存・表示***
Title = CommonDialog1.FileTitle
Text1.Text = Title
End Sub
'*******************
'***赤外線画像表示***
'*******************
Private Sub Command2_Click()
'***画像出力***
CommonDialog2.ShowOpen
Picture2.PaintPicture LoadPicture(CommonDialog2.FileName), 0, 0, Picture1.Width, Picture1.Height, 0, 0
'***ファイル名保存・表示***
Title = CommonDialog2.FileTitle
Text2.Text = Title
End Sub
'*******************************
'***モノクロ画像座標点指定/RGB取得***
'*******************************
'***RBG取得***
Private Sub Command3_Click()
Command3.Enabled = False
Command4.Enabled = True
ScreenhDC = GetDC(0&)
SetCapture Me.hwnd
End Sub
'***RBG取得完了
Private Sub Command4_Click()
'デバイスコンテキストの解放
ReleaseDC 0&, ScreenhDC
ReleaseCapture
Command3.Enabled = True
Command4.Enabled = False
End Sub
'****************
'***グラフ表示***
'****************
Private Sub Command6_Click()
Dim xjiku, xjiku1, xjiku2, yjiku, yjiku1, yjiku2, R, R1, R2, R3, R4 As Single
xjiku = Val(Text6.Text)
yjiku = Val(Text7.Text)
'***フォームの設定***
Picture3.Scale (0, 255)-(401, 0)
'**座標軸表示***
If xjiku <> 0 Then
Text8.Text = " x = " & Text6.Text
Else
Text8.Text = " y = " & Text7.Text
End If
'***グラフ表示***
Picture3.Line (0, 0)-(400, 255), RGB(0, 0, 0), B
xjiku1 = Val(xjiku)
yjiku1 = Val(yjiku)
If xjiku1 <> 0 Then
yjiku1 = 0
R1 = Picture1.POINT(xjiku1, yjiku1)
R2 = R1 - 256 ^ 2 - 256
Do While yjiku2 = yjiku1 + 1
R3 = Picture1.POINT(xjiku1, yjiku2)
R4 = R3 - 256 * 256 - 256
Picture3.Line (xjiku1, R2)-(xjiku1, R4), RGB(255, 0, 0)
yjiku1 = yjiku2
Loop
Else
xjiku1 = 0
R1 = Picture1.POINT(xjiku1, yjiku1)
R2 = R1 - 256 * 256 - 256
Do While xjiku2 = xjiku1 + 1
R3 = Picture1.POINT(xjiku2, yjiku1)
R4 = R3 - 256 * 256 - 256
Picture3.Line (yjiku1, R2)-(yjiku2, R4), RGB(255, 0, 0)
xjiku1 = xjiku2
Loop
End If
End Sub
Private Sub Form_Load()
Command3.Enabled = True
Command4.Enabled = False
End Sub
'***スクリーン座標/RBG取得***
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, _
x As Single, Y As Single)
'GetPixelで取得した色
Dim pc As Long
'GetPixelで取得した色を分解したもの
Dim R As Long, g As Long, b As Long
'スクリーン座標を得る
GetCursorPos p
'その座標の色を得る
pc = GetPixel(ScreenhDC, p.x, p.Y)
R = CByte(pc And &HFF) '3バイト目を得る
g = CByte((pc \ 256&) And &HFF) '2バイト目を得る
b = CByte((pc \ 65536) And &HFF) '1バイト目を得る
Text3.BackColor = pc
Text3.Text = "座標 : " & "(" & p.x & "," & p.Y & ")" _
& " " & "RGB値 = " & _
"(" & R & "," & g & "," & b & ")"
'デバイスコンテキストの解放
ReleaseDC 0&, ScreenhDC
'キャプチャの解放
ReleaseCapture
Command1.Enabled = True
Command2.Enabled = False
End Sub
今、試行錯誤して、色々いじっているのですが、
やはり、指定した軸のRGBのグラフは表示されません。
>機能として、マウスでクリックした場所の座標表示/RGB表示をすでに組み込>みました.そして、そのPictureBoxの四隅の座標をクリックすると,原点とな>る(0,0)が存在せず,(85,104),(408,104),(408,348),(88,348)となっていてる.
スクリーン座標だからウインドウが左隅になかったらそれで正しいような。。
>ちなみに折れ線グラフの表示の仕方は、たぶん習得しましたので
見直したほうがいいかと。。
>>あんさん
ありがとうございます。
今、スクリーン座標からクライアント座標への変換が成功して、
出力もうまくされました.
しかし、座標とそのRGB値を表示しようとしているのですが、
座標はうまく表示されるのですが、明らかに、白の部分をクリックしているのに、
水色や黒色などがRGB値として表示されてしまっています。
ぜひ、どこが悪いのかご指摘いただきたいです。
ソースは以下です。
'***構造体の定義***
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 ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
'***マウスカーソルの座標を,スクリーン座標で取得***
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINT) As Long
'hwnd ウィンドウのハンドルを指定、このクライアント座標が変換される
'スクリーン座標で指定された点の座標を、クライアント座標に変換
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINT) As Long
'***指定されたウィンドウにマウスキャプチャする***
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
'--------------引数----------------
'(hwnd) マウスをジャプチャするウィンドウハンドル
'-----------------戻り値-------------------
'その前にキャプチャされていたウィンドウのハンドルを返す
'そういったウィンドウがなければ0を返す
'***キャプチャの解放***
Private Declare Function ReleaseCapture Lib "user32" () _
As Long
'--------------------戻り値--------------------------
'関数が成功すると0 以外の値が返り
'関数が失敗すると0が返る
'***指定座標カラーの取得***
Private Declare Function GetPixel Lib "gdi32" (ByVal _
hdc As Long, ByVal x As Long, ByVal y As Long) As Long
'---------------------引数---------------------------
'(hdc) 対象のデバイスコンテキスト
'(x) 色を取得するx座標
'(y) 色を取得するy座標
'--------------------戻り値--------------------------
'RGB値を返す
'スクリーン座標の格納
Dim p As POINT
'スクリーンのデバイスコンテキスト
Dim ClienthDC As Long
'********************
'***モノクロ画像表示***
'********************
Private Sub Command1_Click()
'***画像出力***
CommonDialog1.ShowOpen
Picture1.PaintPicture LoadPicture(CommonDialog1.FileName), 0, 0, Picture1.Width, Picture1.Height, 0, 0
'***ファイル名保存・表示***
Title = CommonDialog1.FileTitle
Text1.Text = Title
End Sub
'*******************
'***赤外線画像表示***
'*******************
Private Sub Command2_Click()
'***画像出力***
CommonDialog2.ShowOpen
Picture2.PaintPicture LoadPicture(CommonDialog2.FileName), 0, 0, Picture1.Width, Picture1.Height, 0, 0
'***ファイル名保存・表示***
Title = CommonDialog2.FileTitle
Text2.Text = Title
End Sub
'*******************************
'***モノクロ画像座標点指定/RGB取得***
'*******************************
'***RBG取得***
Private Sub Command3_Click()
Command3.Enabled = False
Command4.Enabled = True
ClienthDC = GetDC(0&)
SetCapture Me.hwnd
End Sub
'***RBG取得完了
Private Sub Command4_Click()
'デバイスコンテキストの解放
ReleaseDC 0&, ClienthDC
ReleaseCapture
Command3.Enabled = True
Command4.Enabled = False
End Sub
'****************
'***グラフ表示***
'****************
Private Sub Command6_Click()
Dim xjiku, xjiku1, xjiku2, yjiku, yjiku1, yjiku2, R, R1, R2, R3, R4 As Single
xjiku = Val(Text6.Text)
yjiku = Val(Text7.Text)
'**座標軸表示***
If xjiku <> 0 Then
Text8.Text = " x = " & Text6.Text
Else
Text8.Text = " y = " & Text7.Text
End If
'***グラフ表示***
Dim x, y1 As Single
Picture3.Line (0, 1000)-(10000, 1000), RGB(0, 0, 0)
For x = 0 To 10000
y1 = 500 * Sin(x / 30)
Picture3.PSet (x, y1 + 1000), QBColor(9)
Next x
End Sub
'If xjiku1 <> 0 Then
' yjiku1 = 0
' For yjiku1 = 0 To 10000
' R1 = Picture1.POINT(xjiku1, yjiku1)
' Picture3.PSet (yjiku1, R1), RGB(255, 0, 0)
' Next yjiku1
'Else
'xjiku1 = 0
' For xjiku1 = 0 To 10000
' R2 = Picture1.POINT(xjiku1, yjiku1)
' Picture3.PSet (xjiku1, R2), RGB(255, 0, 0)
' Next xjiku1
'End If
'End Sub
Private Sub Form_Load()
Command3.Enabled = True
Command4.Enabled = False
End Sub
'***スクリーン座標/RBG取得***
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'GetPixelで取得した色
Dim pc As Long
'スクリーン座標を得る
GetCursorPos p
'スクリーン座標からクライアント座標へ変換
ret = ScreenToClient(Me.hwnd, p)
'指定ピクセルの色を取得
'pc = GetPixel(ClienthDC, p.x, p.y)
pc = Picture1.POINT(p.x, p.y)
Text3.BackColor = pc
Text3.Text = "座標 : " & "(" & p.x & "," & p.y & ")" & " " & "RGB値 = " & pc
'デバイスコンテキストの解放
ReleaseDC 0&, ClienthDC
'キャプチャの解放
ReleaseCapture
Command1.Enabled = True
Command2.Enabled = False
End Sub
>>グラフにつきまして、以上のソースに、仮として練習したものをコメント文として、書いてあります.グラフは、表示されました。
よろしくお願いします.
実行を繰り返していると、
座標取得の時は、クライアント領域できちんと行っているようですが、
カラー取得の時に、上記のクライアント領域で得た座標は、スクリーン領域における座標として、スクリーン座標でのカラーを表示しているようです。
ここを改善したいと考えているのですが、ご指摘よろしくお願いします.
ScreenToClientで取得してるのが
Formの座標だから少しずれるとか?・・
WinAPIで取得したXYと
PictureでのXYの座標系(単位)がいっしょか
確認してみてください。
>PictureでのXYの座標系(単位)がいっしょか
ビンゴですね
正しく座標とれてるか
Picture1.PSET(px,p.y),0
で描画してみるとか
>>あんさん
遅れました。
本日、解決しました。
座標系(単位)を計算して合わせた結果、解決しました。
ありがとうございました。
ツイート | ![]() |