| |
|
|
| Button:
Andreas Miethe (21.09.11)
Das wird normalerweise über die Message WM_NCHITTEST geregelt. Hier mal ein kleines Beispiel für einen skalier / verschiebbaren Button. Sollte sich wohl für ein Fenster anpassen lassen. KompilierenMarkierenSeparieren $H Windows.ph
$H Messages.ph
$H Structs.ph
STRUCT TRect = ~Rect
STRUCT TPoint = ~Point
Proc HitTest
Parameters hCtl&,lParam&
Declare Point#
Declare Rect#
Dim Point#,TPoint
Dim Rect#,TRect
Point#.x& = LoWord(lParam&)
Point#.y& = HiWord(lParam&)
~ScreenToClient(hCtl&,Point#)
~GetWindowRect(hCtl&,Rect#)
~MapWindowPoints(~GetDesktopWindow(),%Hwnd,Rect#,2)
If (Point#.y& < 4) AND (Point#.x& < 4)
Dispose Point#,Rect#
Return ~HTTOPLEFT
ElseIf (Point#.y& < 4) AND (Point#.x& >= (Rect#.right& - Rect#.left&-4))
Dispose Point#,Rect#
Return ~HTTOPRIGHT
ElseIf (Point#.y& >= (Rect#.bottom& - Rect#.top&-4)) AND (Point#.x& >= (Rect#.right& - Rect#.left&-4))
Dispose Point#,Rect#
Return ~HTBOTTOMRIGHT
ElseIf (Point#.x& < 4) AND (Point#.y& >= (Rect#.bottom& - Rect#.top& - 4))
Dispose Point#,Rect#
Return ~HTBOTTOMLEFT
ElseIf Point#.y& < 4
Dispose Point#,Rect#
Return ~HTTOP
ElseIf Point#.x& < 4
Dispose Point#,Rect#
Return ~HTLEFT
ElseIf Point#.x& >= (Rect#.right& - Rect#.left& - 4)
Dispose Point#,Rect#
Return ~HTRIGHT
ElseIf Point#.y& >= (Rect#.bottom& - Rect#.top& - 4)
Dispose Point#,Rect#
Return ~HTBOTTOM
Else
Dispose Point#,Rect#
Return ~HTCAPTION
EndIf
EndProc
SubClassProc
If SubClassMessage(&sWnd,~WM_NCHITTEST)
Set("WinProc", 0)
Return HitTest(&swnd,&slParam)
Endif
EndProc
cls
Var Ende& = 0
Var Button& = Create("Button",%hwnd,"OK",10,10,120,30)
SubClass Button&,1
whilenot ende&
waitinput
endwhile
Fenster:
Julian57 (22.09.11)
Der Quelltext mit wm_ncHitTest funktioniert wirklich super! Danke Andreas KompilierenMarkierenSeparieren $H Windows.ph
$H Messages.ph
$H Structs.ph
STRUCT TRect = ~Rect
STRUCT TPoint = ~Point
Proc HitTest
Parameters hCtl&,lParam&
Declare Point#
Declare Rect#
Dim Point#,TPoint
Dim Rect#,TRect
Point#.x& = LoWord(lParam&)
Point#.y& = HiWord(lParam&)
~ScreenToClient(hCtl&,Point#)
~GetWindowRect(hCtl&,Rect#)
~MapWindowPoints(~GetDesktopWindow(),%Hwnd,Rect#,2)
If (Point#.y& < 4) AND (Point#.x& < 4)
Dispose Point#,Rect#
Return ~HTTOPLEFT
ElseIf (Point#.y& < 4) AND (Point#.x& >= (Rect#.right& - Rect#.left&-4))
Dispose Point#,Rect#
Return ~HTTOPRIGHT
ElseIf (Point#.y& >= (Rect#.bottom& - Rect#.top&-4)) AND (Point#.x& >= (Rect#.right& - Rect#.left&-4))
Dispose Point#,Rect#
Return ~HTBOTTOMRIGHT
ElseIf (Point#.x& < 4) AND (Point#.y& >= (Rect#.bottom& - Rect#.top& - 4))
Dispose Point#,Rect#
Return ~HTBOTTOMLEFT
ElseIf Point#.y& < 4
Dispose Point#,Rect#
Return ~HTTOP
ElseIf Point#.x& < 4
Dispose Point#,Rect#
Return ~HTLEFT
ElseIf Point#.x& >= (Rect#.right& - Rect#.left& - 4)
Dispose Point#,Rect#
Return ~HTRIGHT
ElseIf Point#.y& >= (Rect#.bottom& - Rect#.top& - 4)
Dispose Point#,Rect#
Return ~HTBOTTOM
Else
Dispose Point#,Rect#
Return ~HTCAPTION
EndIf
EndProc
SubClassProc
If SubClassMessage(&sWnd,~WM_NCHITTEST)
Set("WinProc", 0)
Return HitTest(&swnd,&slParam)
Endif
EndProc
windowstyle 2+16+64
window 600,400
cls 255
var dg&=Create("Window",%hwnd,"",10,10,200,100)
StartPaint dg&
cls 255
EndPaint
SubClass dg&,1
SubClass %hwnd,1
while 1
waitinput 30
case iskey(27) : end
endwhile
|
|
|
| |
|
|