Unngå å flytte programmet "ut av skjermen"

[Atmozpheric]

Lurer på om det finnes ein API for å begrense programmets flytte område. Eg vil at programmet mitt ikkje skal kunne bli flytta utenfor skjermen. Slik som Hopster's Pretty Annoying Advertising Window.

 

Noen som har peiling?

[aadnk]

Kanskje ikke den beste løsningen på problemet, men jeg kunne ikke komme på noe bedre. Legg følgende kode i en modul:

 

Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
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
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As Rect) As Long

Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Type Rect
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Private Const WM_MOVE = &H3
Private Const WM_DESTROY = &H2
Private Const WM_SIZE = &H5
Private Const WM_SIZING = &H214
Private Const WM_MOVING = &H216
Private Const GWL_WNDPROC = (-4)

Dim lhWnd&

Public Sub HookForm(hwnd As Long)

SetProp hwnd, "PrevProc", SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
   
End Sub

Public Sub UnHookForm(hwnd As Long)

SetWindowLong hwnd, GWL_WNDPROC, GetProp(hwnd, "PrevProc")
RemoveProp hwnd, "PrevProc"

End Sub

Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   
Dim PrevProc As Long, lRect As Rect, ScrWidth&, ScrHeight&, Changed&

PrevProc = GetProp(hwnd, "PrevProc")

Select Case uMsg
Case WM_MOVE, WM_SIZE, WM_SIZING, WM_MOVING

   ScrWidth = Screen.Width / Screen.TwipsPerPixelX
   ScrHeight = Screen.Height / Screen.TwipsPerPixelY
   GetWindowRect hwnd, lRect

   If lRect.Left < 0 Then
       lRect.Right = lRect.Right - lRect.Left
       lRect.Left = 0
       Changed = 1
   End If
   
   If lRect.Top < 0 Then
       lRect.Bottom = lRect.Bottom - lRect.Top
       lRect.Top = 0
       Changed = 1
   End If
   
   If lRect.Right > ScrWidth Then
       lRect.Left = lRect.Left - lRect.Right + ScrWidth
       lRect.Right = ScrWidth
       Changed = 1
   End If
   
   If lRect.Bottom > ScrHeight Then
       lRect.Top = lRect.Top - lRect.Bottom + ScrHeight
       lRect.Bottom = ScrHeight
       Changed = 1
   End If

   If Changed <> 0 Then
       MoveWindow hwnd, lRect.Left, lRect.Top, lRect.Right - lRect.Left, lRect.Bottom - lRect.Top, 1
   End If

Case WM_DESTROY

   ' Forhindrer krasj
   UnHookForm hwnd
   
End Select

WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)

End Function

 

Koden brukes ved å skrive denne linjen i Form_Load:

 

HookForm Me.hwnd

 

Håper dette hjalp.