投稿時間:2006/09/29(Fri) 00:30 投稿者名:Starfish
Eメール:
URL :
タイトル: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
|