サンプル投稿用掲示板 VB2005 〜 用トップページ VB6.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
 |
