[リストへもどる]   [VBレスキュー(花ちゃん)]
一括表示

投稿時間:2006/09/28(Thu) 16:49
投稿者名:シーモア
Eメール:
URL :
タイトル:
タイトルドラッグ移動で画面をプライマリモニタから「はみだし禁止」にしたい
『サイズの小さい画面をタイトルをドラッグして、移動したときに、
画面の右端が消える位置まで来たら移動できないようにしたい』
つまり、
『常にプライマリ画面の中に納まる位置を保持し、
画面全体が見えるようにしたい』
のですが、後述のようにタイマーで、位置を戻す処理では
いったりきたりで、ちらちらする状態になってしまいます
APIなりなんなり、ちらつかずスマートに「はみだし禁止」
にすることはできないでしょうか?


Private Sub Timer1_Timer()
        Dim mRect       As RECT
        Dim lngRet      As Long
        Dim lngAzoomTop      As Long
        lngRet = GetWindowRect(Me.hwnd, mRect)
        If mRect.Left < 0 Or mRect.Top < 0 Or mRect.Right > G_MonitorW Or mRect.Bottom > G_MonitorH Then
            If mRect.Left < 0 Then
                FrmAZoom.Left = 0
            End If
            If mRect.Top < 0 Then
                FrmAZoom.Top = 0
            End If
            If mRect.Right > G_MonitorW Then
                FrmAZoom.Left = (G_MonitorW * Screen.TwipsPerPixelX) - FrmAZoom.Width
            End If
            If mRect.Bottom > G_MonitorH Then
                lngAzoomTop = mRect.Bottom - G_MonitorH
                FrmAZoom.Top = FrmAZoom.Top - lngAzoomTop * Screen.TwipsPerPixelY
            End If
        End If
End Sub

投稿時間: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

投稿時間:2006/09/29(Fri) 09:55
投稿者名:シーモア
Eメール:
URL :
タイトル:
解決とお礼
ソースコードをいただきましてありがとうございます
実行しましたところスムーズに動作しています!
この動作で十分目的を達成できます
Starfish さん ありがとうございました

> > 『サイズの小さい画面をタイトルをドラッグして、移動したときに、
> > 画面の右端が消える位置まで来たら移動できないようにしたい』
> > つまり、
> > 『常にプライマリ画面の中に納まる位置を保持し、
> > 画面全体が見えるようにしたい』
> > のですが、後述のようにタイマーで、位置を戻す処理では
> > いったりきたりで、ちらちらする状態になってしまいます
> > 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