| 投稿日 | ： 2006/09/29(Fri) 00:30 |
| 投稿者 | ： Starfish |
| Ｅメール | ： |
| ＵＲＬ | ： |
| タイトル | ： Re: タイトルドラッグ移動で画面をプライマリモニタから「はみだし禁止」にしたい |
> 『サイズの小さい画面をタイトルをドラッグして、移動したときに、
> 画面の右端が消える位置まで来たら移動できないようにしたい』
> つまり、
> 『常にプライマリ画面の中に納まる位置を保持し、
> 画面全体が見えるようにしたい』
> のですが、後述のようにタイマーで、位置を戻す処理では
> いったりきたりで、ちらちらする状態になってしまいます
> APIなりなんなり、ちらつかずスマートに「はみだし禁止」
> にすることはできないでしょうか？
サブクラス化でよければ、こんなんで「はみ禁」を実現可能です。
もっといいやり方が、あるような気がするが．．．
'--------------------------------------------------------------------
' Form1
'--------------------------------------------------------------------
Option Explicit
Private Sub Form_Load()
glnglpOrg = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf MyWindowProc)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim lngReturnValue As Long
lngReturnValue = SetWindowLong(Me.hwnd, GWL_WNDPROC, glnglpOrg)
End Sub
'--------------------------------------------------------------------
' Module1
'--------------------------------------------------------------------
Option Explicit
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, _
ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const GWL_WNDPROC = (-4)
Public Const WM_WINDOWPOSCHANGING = &H46
Type WINDOWPOS
hwnd As Long
hWndInsertAfter As Long
x As Long
y As Long
cx As Long
cy As Long
flags As Long
End Type
Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public glnglpOrg As Long
Public Function MyWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim udtWindowPos As WINDOWPOS
If uMsg = WM_WINDOWPOSCHANGING Then
Call MoveMemory(udtWindowPos, ByVal lParam, Len(udtWindowPos))
With udtWindowPos
If .x < 0 Then .x = 0
If .y < 0 Then .y = 0
If .x > Form1.ScaleX((Screen.Width - Form1.Width), vbTwips, vbPixels) Then
.x = Form1.ScaleX((Screen.Width - Form1.Width), vbTwips, vbPixels)
End If
If .y > Form1.ScaleY((Screen.Height - Form1.Height), vbTwips, vbPixels) Then
.y = Form1.ScaleY((Screen.Height - Form1.Height), vbTwips, vbPixels)
End If
End With
Call MoveMemory(ByVal lParam, udtWindowPos, Len(udtWindowPos))
Else
MyWindowProc = CallWindowProc(glnglpOrg, hwnd, uMsg, wParam, lParam)
End If
End Function