ピクチャボックスにjpeg画像を表示し、ピクチャボックス自体の大きさは変えずに、マウスホイールで拡大、縮小 マウスドラッグで画像の移動ができるようにしたいのです。拡大、縮小は何となくできましたが、移動がうまくいきません。
どこが悪いのでしょうか?
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'表示する画像を読み込む
If Not (currentImage Is Nothing) Then
currentImage.Dispose()
End If
currentImage = New Bitmap(写真ファイル)
'初期化
drawRectangle = New Rectangle (0, 0, PictureBox1.Width, .PictureBox1.Height)
zoomRatio = 1.0
'画像を表示する
PictureBox1.SizeMode = PictureBoxSizeMode.AutoSize
PictureBox1.Invalidate()
End Sub
Private Sub PictureBox1_Paint(ByVal sender As Object, ByVal e As PaintEventArgs) Handles PictureBox1.Paint
If Not (currentImage Is Nothing) Then
'画像を指定された位置、サイズで描画する
e.Graphics.DrawImage(currentImage, drawRectangle)
End If
End Sub
Private Sub PictureBox1_MouseWheel(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseWheel
If e.Delta > 0 Then
zoomRatio *= 1.2
Else
zoomRatio *= 0.8
End If
'倍率変更後の画像のサイズと位置を計算する
drawRectangle.Width = CInt(Math.Round(PictureBox1.Width * zoomRatio))
drawRectangle.Height = CInt(Math.Round(PictureBox1.Height * zoomRatio))
drawRectangle.X = 0
drawRectangle.Y = 0
' 画像を表示する
PictureBox1.Invalidate()
End Sub
Private Sub PictureBox1_MouseEnter(ByVal sender As Object, ByVal e As System.EventArgs) Handles PictureBox1.MouseEnter
PictureBox1.Select()
End Sub
Private Sub PictureBox1_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) _
Handles PictureBox1.MouseDown
If bDrag = False Then
bDrag = True
ptDrag = e.Location
End If
End Sub
Private Sub PictureBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
If bDrag Then
Dim pt As Point = PictureBox1.Parent.PointToClient (Cursor.Position)
PictureBox1.Location = pt - ptDrag
drawRectangle.X = PictureBox1.Location.X
drawRectangle.Y = PictureBox1.Location.Y
'画像を表示する
PictureBox1.Invalidate()
End If
End If
End Sub
Private Sub PictureBox1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp
bDrag = False
End Sub
どうにか自力で完成しつつあるのですが、
マウスホイールでの拡大、縮小を今は原点基準で行っていますが、マウスのカーソル位置を中心に拡大縮小したいと思っています。
カーソル位置の座標(ピクチャボックスの左上を(0,0)とした場合の)はどうやって取得すればよいのでしょうか?
これでどうでしょう?
MouseWheelとMouseMove以外省略してあります。
drawRectangleはRectangleFで定義してあります。
Private Sub PictureBox1_MouseWheel(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseWheel
Dim zoomRatio1 = zoomRatio
If e.Delta > 0 Then
zoomRatio *= 1.2!
Else
zoomRatio *= 0.8!
End If
'倍率変更後の画像のサイズと位置を計算する
drawRectangle.Width = PictureBox1.Width * zoomRatio
drawRectangle.Height = PictureBox1.Height * zoomRatio
drawRectangle.X = e.X - (e.X - drawRectangle.X) * zoomRatio / zoomRatio1
drawRectangle.Y = e.Y - (e.Y - drawRectangle.Y) * zoomRatio / zoomRatio1
' 画像を表示する
PictureBox1.Invalidate()
End Sub
Private Sub PictureBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
If bDrag Then
drawRectangle.Offset(e.X - ptDrag.X, e.Y - ptDrag.Y)
ptDrag = e.Location
'画像を表示する
PictureBox1.Invalidate()
End If
End Sub
shuさんありがとうございます。
うまくいきました。
返事が遅くなりすいません。
ツイート | ![]() |