tagCANDY CGI VBレスキュー(花ちゃん) - VBレスキュー(花ちゃん)の投稿サンプル用掲示板 - Visual Basic 6.0 VB2005 VB2010
VB2005用トップページへVBレスキュー(花ちゃん)のトップページVB6.0用のトップページ
VBレスキュー(花ちゃん)の投稿サンプル用掲示板
     サンプル投稿用掲示板  VB2005 〜 用トップページ  VB6.0 用 トップページ
タイトルドラッグで画面をモニタからはみだし禁止に(VB6.0) ( No.0 )  [親スレッドへ]
日時: 2009/12/26 22:50
名前: 花ちゃん

***********************************************************************************
* カテゴリー:[フォーム][自アプリ関係][]                                          *
* キーワード:ウィンドウ,画面,移動,,,                                            *
***********************************************************************************

元質問:タイトルドラッグ移動で画面をプライ... - シーモア 2006/09/28-16:49 No.7371

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

-----------------------------------------------------------------------------------
Re: タイトルドラッグ移動で画面をプライマ.. - Starfish  2006/09/29-00:30 No.7373
-----------------------------------------------------------------------------------
 サブクラス化でよければ、こんなんで「はみ禁」を実現可能です。
もっといいやり方が、あるような気がするが...

'--------------------------------------------------------------------
' 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



 [スレッド一覧へ] [親スレッドへ]