ここから本文です

MouseMoveイベントについて、質問です。

yaj********さん

2014/7/1610:59:33

MouseMoveイベントについて、質問です。

ユーザーフォーム上にFrame1があり、その中にImage1がある場合で、
マウスの位置を取得するのにAPIを使ったプログラムですが、色々教えていただき、下記のようにプログラムを組みました。

'カーソルの位置を取得するAPI
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
'左ボタンを押した位置
Dim x0 As Single '
Dim y0 As Single

Dim PicFile As String
Dim filename As String
Dim pic As Object
Private Sub cmbPicLoad_Click()
'***** ファイルを開く *****
PicFile = Application.GetOpenFilename(FileFilter:="Jpeg, *.jpg,Bitmap, *.bmp")
If VarType(PicFile) = vbBoolean Then Cancel = True: Exit Sub
Set pic = LoadPicture(PicFile)
Image1.Picture = pic
With Frame1
Image1.Height = pic.Height * 0.0285
Image1.Width = pic.Width * 0.0285
.ScrollHeight = Image1.Height
.ScrollWidth = Image1.Width
End With
End Sub

Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
Dim p As POINTAPI
GetCursorPos p
x0 = p.x
y0 = p.y
End Sub

Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
If Button And 1 = 1 Then
Dim p As POINTAPI
GetCursorPos p
Frame1.ScrollLeft = x0 - p.x
Frame1.ScrollTop = y0 - p.y
End If
End Sub


frameサイズよりも大きい画像を開いた場合、
1回目のドラッグで、frame中心と画像中心が合う位置に画像を移動して、マウス(ボタン)から手を離し、
2回目のドラッグをしようとすると、Scrollや画像が中心から左上に戻ってしまいます。

次のドラッグで左上に戻らず、
ドラッグで移動した位置から、再度ドラッグで画像を動かす(正確に言うとScrollbarを動かす)ように
したいのですが、どのようにすれば良いでしょうか?

ご教授頂ければ、幸いです。よろしくお願い致します。

閲覧数:
99
回答数:
1
お礼:
100枚

違反報告

ベストアンサーに選ばれた回答

TageSPさん

2014/7/2113:53:58

こんにちは

早速ですが、再度ドラッグの際に、
画像が、左上に戻ってしまうのは、
MouseDownイベント直後に、
MouseMoveイベントが発生して、
x0 - p.xが、いつも、0近くになるためだと思われます。

そこで、
横槍を入れて、さらに、
ご希望の内容と異なれば、申し訳ないのですが、
以下のように、コードを追加させていただきました。
+++++++++++++++++
'カーソルの位置を取得するAPI
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
'左ボタンを押した位置
Dim x0 As Single '
Dim y0 As Single

'前回移動した位置を記憶'←■追加
Dim xs As Single '←■追加
Dim ys As Single '←■追加
Dim Mouse_Down_Flg As Boolean '←■追加

Dim PicFile As String
Dim filename As String
Dim pic As Object
Private Sub cmbPicLoad_Click()
'***** ファイルを開く *****
PicFile = Application.GetOpenFilename(FileFilter:="Jpeg, *.jpg,Bitmap, *.bmp")
' If VarType(PicFile) = vbBoolean Then Cancel = True: Exit Sub

Set pic = LoadPicture(PicFile)
Image1.Picture = pic
With Frame1
Image1.Height = pic.Height * 0.0285
Image1.Width = pic.Width * 0.0285
.ScrollHeight = Image1.Height
.ScrollWidth = Image1.Width
End With
xs = 0: ys = 0 '初期化
Mouse_Down_Flg = False
End Sub

Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim p As POINTAPI
GetCursorPos p
x0 = p.X
y0 = p.Y
Mouse_Down_Flg = True 'MouseMove誤作動防止用フラグ
End Sub

Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If (Button And 1 = 1) And Mouse_Down_Flg Then
Dim p As POINTAPI
GetCursorPos p
'+ xsがないと、MouseDownで、x0が定まった直後にここで、p.Xが取得され。
'実質、x0=p.Xとなり。左端に位置がリセットされる。
Frame1.ScrollLeft = x0 - p.X + xs '←■追加
Frame1.ScrollTop = y0 - p.Y + ys '←■追加
End If
End Sub
'■追加--ここから--------------------------
Private Sub Image1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'マウスのボタンを離したとき、今回移動した位置を記憶
xs = Frame1.ScrollLeft
ys = Frame1.ScrollTop
Mouse_Down_Flg = False
End Sub
'■追加--ここまで--------------------------
+++++++++++++++++

以上ですが、
私は、Excel2003しかもっていないため、
他の環境での動作は、保障しかねますので、
何卒、ご了承頂けると幸いでございます。

また、不躾なから、
Frame1.ScrollLeft/Topで、画像を移動させる方法と別に
Image1.Left /Topで、画像を移動させる方法も、完全に蛇足ながら
併せて、併記させて頂きます。
+++++++++++++++++
Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If (Button And 1 = 1) And Mouse_Down_Flg Then
Dim p As POINTAPI
GetCursorPos p
Image1.Left = p.X - x0 + xs
Image1.Top = p.Y - y0 + ys
End If
End Sub
Private Sub Image1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
xs = Image1.Left
ys = Image1.Top
Mouse_Down_Flg = False
End Sub
+++++++++++++++++
どういった機能をご要望になられているのか、
把握しきれず、出すぎた事をしてしまい、
失礼いたしました。

以上
ありがとうございました。

質問した人からのコメント

2014/7/22 12:15:53

感謝 oyk3865b3702d3rさん

こんにちは

ご教授いただき、ありがとうございました。
やりたいことが出来ました!
本当にありがとうございました。

あわせて知りたい

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる