VBでピクチャボックスの中に表示されるイメージの座標を取得してタイトルバーに表示する
VBでピクチャボックスの座標を取得するのは簡単にできますが、ピクチャボックスの中に表示されるイメージの座標を取得するのは分からなかったので教えてもらった技法をメモしておきます。
referencesource.microsoft.com で、C#ですがイメージのサイズとピクチャーボックスのクライアントサイズから描画先を決定している箇所での計算式を下記のVBコードで再現しています。
Public Class Form1 Public Shared flagMargin As Boolean = False Public Shared Function ImageRectangleFromSizeMode(pbox As PictureBox) As Rectangle Dim result As Rectangle = DeflateRect(pbox.ClientRectangle, pbox.Padding) If pbox.Image IsNot Nothing Then Select Case pbox.SizeMode Case PictureBoxSizeMode.Normal, PictureBoxSizeMode.AutoSize result.Size = pbox.Image.Size Case PictureBoxSizeMode.StretchImage Case PictureBoxSizeMode.CenterImage result.X += (result.Width - pbox.Image.Width) / 2 result.Y += (result.Height - pbox.Image.Height) / 2 result.Size = pbox.Image.Size Case PictureBoxSizeMode.Zoom Dim imageSize As Size = pbox.Image.Size Dim ratio As Single = Math.Min(pbox.ClientRectangle.Width / imageSize.Width, pbox.ClientRectangle.Height / imageSize.Height) If pbox.ClientRectangle.Width / imageSize.Width < pbox.ClientRectangle.Height / imageSize.Height Then flagMargin = True End If result.Width = imageSize.Width * ratio result.Height = imageSize.Height * ratio result.X = (pbox.ClientRectangle.Width - result.Width) / 2 result.Y = (pbox.ClientRectangle.Height - result.Height) / 2 End Select End If Return result End Function Private Shared Function DeflateRect(rect As Rectangle, padding As Padding) As Rectangle rect.X += padding.Left rect.Y += padding.Top rect.Width -= padding.Horizontal rect.Height -= padding.Vertical Return rect End Function Private Sub PictureBox1_LocationChanged(sender As Object, e As EventArgs) Handles PictureBox1.LocationChanged Dim pbox As PictureBox = DirectCast(sender, PictureBox) Func(pbox) Dim r As Rectangle = ImageRectangleFromSizeMode(pbox) Me.Text = RectangleToClient(pbox.RectangleToScreen(r)).ToString() FuncPictureBoxOverFix(RectangleToClient(pbox.RectangleToScreen(r))) End Sub <System.Runtime.InteropServices.DllImport("User32.dll")> Private Shared Function SendMessage(hWnd As IntPtr, uMsg As Integer, wParam As IntPtr, lParam As IntPtr) As IntPtr End Function <System.Runtime.InteropServices.DllImport("User32.dll")> Private Shared Function SetCapture(hwnd As Integer) As Boolean End Function <System.Runtime.InteropServices.DllImport("User32.dll")> Private Shared Function ReleaseCapture() As Boolean End Function Private Const WM_SYSCOMMAND As Integer = &H112 Private Const SC_MOVE As Integer = &HF010 Private Sub PictureBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseDown Dim pbox As PictureBox = DirectCast(sender, PictureBox) SetCapture(pbox.Handle) ReleaseCapture() SendMessage(pbox.Handle, WM_SYSCOMMAND, SC_MOVE Or 2, 0) End Sub Sub Func(pbox As PictureBox) Dim x As Integer = pbox.Left + pbox.Padding.Left + pbox.Margin.Left Dim y As Integer = pbox.Top + pbox.Padding.Top + pbox.Margin.Top TextBox1.Text = x TextBox2.Text = y End Sub Sub FuncPictureBoxOverFix(rect As Rectangle) End Sub Private Sub Form1_SizeChanged(sender As Object, e As EventArgs) Handles MyBase.SizeChanged Dim r As Rectangle = ImageRectangleFromSizeMode(Me.PictureBox1) FuncPictureBoxOverFix(RectangleToClient(PictureBox1.RectangleToScreen(r))) End Sub End Class