- 日時： 2010/03/08 21:06
- 名前： 魔界の仮面弁士
- ***********************************************************************************
* カテゴリー：[コントロール共通][マウス][] *
* キーワード：PictureBox,移動,サイズ変更,幅を変更, *
***********************************************************************************
WM_NCHITTEST メッセージを処理して、コントロールのサイズを可変にしてみました。
コントロール周辺を掴むとドラッグ可能です。
Public Class Form1
Private WithEvents PictureBox1 As PictureBox
Private Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load
PictureBox1 = New ResizablePictureBox()
PictureBox1.SetBounds(15, 20, 276, 110)
PictureBox1.SizeMode = PictureBoxSizeMode.StretchImage
Controls.Add(PictureBox1)
PictureBox1.LoadAsync("http://www.google.co.jp/intl/ja_jp/images/logo.gif")
End Sub
End Class
Public Class ResizablePictureBox
Inherits PictureBox
Const WM_NCHITTEST As Integer = &H84
Protected Overrides Sub WndProc(ByRef m As Message)
MyBase.WndProc(m)
If m.Msg = WM_NCHITTEST Then
Dim xy As Point = PointToClient(New Point(m.LParam.ToInt32()))
Dim Border As Size = SystemInformation.FrameBorderSize
Const BoxSize As Integer = 16
m.Result = New IntPtr(HitTest.Caption) 'ドラッグ移動可能
'm.Result = New IntPtr(HitTest.Client) 'ドラッグ移動不可
Dim rect As Rectangle = Me.DisplayRectangle
If xy.X <= Border.Width Then
m.Result = New IntPtr(HitTest.Left)
If xy.Y <= BoxSize Then
m.Result = New IntPtr(HitTest.TopLeft)
ElseIf xy.Y + BoxSize >= ClientRectangle.Height Then
m.Result = New IntPtr(HitTest.BottomLeft)
End If
ElseIf xy.X + Border.Width >= ClientRectangle.Width Then
m.Result = New IntPtr(HitTest.Right)
If xy.Y <= BoxSize Then
m.Result = New IntPtr(HitTest.TopRight)
ElseIf xy.Y + BoxSize >= ClientRectangle.Height Then
m.Result = New IntPtr(HitTest.BottomRight)
End If
ElseIf xy.Y <= Border.Height Then
m.Result = New IntPtr(HitTest.Top)
If xy.X <= BoxSize Then
m.Result = New IntPtr(HitTest.TopLeft)
ElseIf xy.X + BoxSize >= ClientRectangle.Width Then
m.Result = New IntPtr(HitTest.TopRight)
End If
ElseIf xy.Y + Border.Height >= ClientRectangle.Height Then
m.Result = New IntPtr(HitTest.Bottom)
If xy.X <= BoxSize Then
m.Result = New IntPtr(HitTest.BottomLeft)
ElseIf xy.X + BoxSize >= ClientRectangle.Width Then
m.Result = New IntPtr(HitTest.BottomRight)
End If
End If
End If
End Sub
Enum HitTest
[Error] = -2 'デスクトップ上にあり、警告音を鳴らす
Transparent = -1 '同じスレッドの別のウィンドウの下にある
NoWhere = 0 'デスクトップ上にある
Client = 1 'クライアント領域内にある
Caption = 2 'キャプションバー上にある
SysMenu = 3 'システムメニュー内にある
Size = 4 'サイズボックス内にある
GrowBox = Size
Menu = 5 'メニューバー内にある
HScroll = 6 '水平スクロールバー内にある
VScroll = 7 '垂直スクロールバー内にある
MinButton = 8 'アイコン化ボタン上にある
MaxButton = 9 '最大化ボタン上にある
Left = 10 '可変枠の左辺境界線上にある
Right = 11 '可変枠の右辺境界線上にある
Top = 12 '可変枠の上辺境界線上にある
TopLeft = 13 '可変枠の左上隅にある
TopRight = 14 '可変枠の右上隅にある
Bottom = 15 '可変枠の下辺境界線上にある
BottomLeft = 16 '可変枠の左下隅にある
BottomRight = 17 '可変枠の右下隅にある
Border = 18 '可変枠を持たない境界線上にある
End Enum
End Class
|
ピクチャーボックスのサイズをマウスのドラッグで変更する(VB.NET)