Page 1 of 1
Buddy Windows
Posted: Mon Dec 31, 2007 6:01 am
by netmaestro
Have a play with this code. The windows start out stuck together, and will stay that way until you move the child away. After that, either window will move anywhere independently of the other until they are moved to within 30px of their original "stuck" position, at which time they will rejoin and stick together until the child is again moved away. It's kinda cool imho:
Code: Select all
;=======================================================
; Program: Buddy Windows
; Author: Lloyd Gallant (netmaestro)
; Date: December 31, 2007
; Target OS: Microsoft Windows All
; Target Compiler: PureBasic 4.0 and later
; License: Free, unrestricted, no warranty
;=======================================================
Global stuck=1, tid
Procedure ReleaseWindow(void)
Repeat
Delay(1)
Until GetAsyncKeyState_(#VK_LBUTTON) & 32768 = 0
stuck = #True
EndProcedure
Procedure WinProc(hwnd, msg, wparam, lparam)
result = #PB_ProcessPureBasicEvents
Select msg
Case #WM_MOVING
Select hwnd
Case WindowID(0)
*view.RECT = lparam
curwidth = *view\right - *view\left
curheight = *view\bottom - *view\top
GetWindowRect_(WindowID(1), @cr.RECT)
xx = cr\left : yy = cr\top-curheight
If stuck
childwidth = cr\right - cr\left
childheight = cr\bottom - cr\top
MoveWindow_(WindowID(1),*view\left,*view\bottom+1,childwidth,childheight,#True)
Else
If Abs(*view\top-yy) <30 And Abs(xx-*view\left)<30 ; within the grab zone
With *view
\left = xx
\top = yy
\right = xx+curwidth
\bottom = yy+curheight
EndWith
If Not IsThread(tid)
tid = CreateThread(@ReleaseWindow(),0)
EndIf
result = #True
EndIf
EndIf
Case WindowID(1)
*view.RECT = lparam
curwidth = *view\right - *view\left
curheight = *view\bottom - *view\top
GetWindowRect_(WindowID(0), @pr.RECT)
xx = pr\left : yy = pr\bottom+1
If Abs(*view\top-yy) <30 And Abs(xx-*view\left)<30
If Not stuck
With *view
\left = xx
\top = yy
\right = xx+curwidth
\bottom = yy+curheight
EndWith
If Not IsThread(tid)
tid = CreateThread(@ReleaseWindow(),0)
EndIf
result = #True
EndIf
Else
stuck=#False
EndIf
EndSelect
EndSelect
ProcedureReturn result
EndProcedure
OpenWindow(0, 0, 0, 320, 240, "Main Window", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
GetWindowRect_(WindowID(0), wr.RECT)
OpenWindow(1,wr\left,wr\bottom+1,320,160,"Child Window",#PB_Window_TitleBar,WindowID(0))
SetWindowCallback(@WinProc())
SetActiveWindow(0)
Repeat:Until WaitWindowEvent()=#PB_Event_CloseWindow
Posted: Mon Dec 31, 2007 6:07 am
by rsts
Very nice.
Now I just have to find a way to use it
cheers
(btw - invalid memory acess line 72 when I closed the window.)
Posted: Mon Dec 31, 2007 6:10 am
by netmaestro
Were you using the PB beta? because I've been playing with it for hours on 4.10 without any errors, and the beta's a bit unpolished yet.
Posted: Mon Dec 31, 2007 6:16 am
by rsts
netmaestro wrote:Were you using the PB beta? because I've been playing with it for hours on 4.10 without any errors, and the beta's a bit unpolished yet.
Yes, that may explain it. I'll try a regular test and let you know if I still have an error.
cheers
Fine so far under 4.1.
Posted: Mon Dec 31, 2007 6:42 am
by Dare
hehe. Nifty. DOCKING!
A suggestion - if you are going to use this with a real app - then perhaps when the two windows are within "relock" distance, jump the non-moving window and not the moving window. Otherwise the window being movedby the user escapes from mission (drag) control and the mouse, left-button down, can sweep across an underlying app.
Posted: Mon Dec 31, 2007 6:45 am
by Fangbeast
I can add this to the sexy snapwindow code you gave me months ago. That made things so much easier!
I haven't had a single person whinge that their app screens are too far off the screen to be dragged back any more):)
Posted: Mon Dec 31, 2007 7:00 am
by Fluid Byte
Once you pulled it in one direction it wont dock again and ignores all other directions you drag it. Is that intended?
Posted: Mon Dec 31, 2007 8:06 am
by Mistrel
What happens if they stop being friends? Do the windows still stick or does the program end with an unhanded exception?
Excellent code. Thank you for sharing.
Re: Buddy Windows
Posted: Fri Dec 17, 2010 2:37 am
by netmaestro
What happens if they stop being friends?
The secondary window checks the facebook status first and if the main window has unfriended him he won't dock anymore.
Re: Buddy Windows
Posted: Sun Dec 19, 2010 6:43 am
by GBeebe
Wow, netmaestro, this had me confused for a bit. I saw that you were talking about the beta of 4.1 and left me thinking why you weren't using anything newer yet, then I saw the date. But then I lol'd at the thought of you taking 3 years to come up with a smart remark about 2 windows no longer being friends. Good one.
Re: Buddy Windows
Posted: Fri Dec 24, 2010 9:17 am
by Mistrel
I thought it was funny at the time. It's nice to know that netmaestro has a sense of humor.
Re: Buddy Windows
Posted: Wed Sep 13, 2017 8:57 am
by Kwai chang caine
A little bit late
Thanks for sharing
Re: Buddy Windows
Posted: Fri Jan 22, 2021 8:30 am
by Martt
Better late then never, I guess
I made a small modification to the code, so the windows will also snap when they are moved within the grab zone.
Thanks for the initial code.
Code: Select all
; Buddy Windows by netmaestro (https://www.purebasic.fr/english/viewtopic.php?f=12&t=30316&hilit=Buddy+Windows), modified by Martt
EnableExplicit
#Y_Grab = 30
#X_Grab = 30
Global STUCK.b = #True
Global TID.i
Declare Gui_ReleaseWindow(*Dummy)
Declare Gui_Callback(HWnd.i, Msg.i, WParam.i, LParam.i)
Procedure Gui_ReleaseWindow(*Dummy)
Repeat
Delay(1)
Until Not (GetAsyncKeyState_(#VK_LBUTTON) & $8000)
STUCK = #True
EndProcedure
Procedure Gui_Callback(HWnd.i, Msg.i, WParam.i, LParam.i)
Protected Result.i
Protected *Main.RECT
Protected Child.RECT
Protected Parent.RECT
Protected CurWidth.i
Protected CurHeight.i
Protected ChildWidth.i
Protected ChildHeight.i
Result = #PB_ProcessPureBasicEvents
Select Msg
Case #WM_EXITSIZEMOVE
; This is a finished move.
; It will 'snap' the windows together when they are moved inside the 'snap zone'.
If HWnd = WindowID(1) And STUCK
GetWindowRect_(WindowID(0), @Parent)
GetWindowRect_(WindowID(1), @Child)
ChildWidth = Child\right - Child\left
ChildHeight = Child\bottom - Child\top
MoveWindow_(WindowID(1), Parent\right, Parent\top, ChildWidth, ChildHeight, #True)
Result = #True
EndIf
Case #WM_MOVING
; This is a move in progress.
; It will 'snap' the windows together when one comes from outside the 'snap zone'.
Select HWnd
Case WindowID(0)
*Main = LParam
CurWidth = *Main\right - *Main\left
CurHeight = *Main\bottom - *Main\top
GetWindowRect_(WindowID(1), @Child)
ChildWidth = Child\right - Child\left
ChildHeight = Child\bottom - Child\top
If STUCK
MoveWindow_(WindowID(1), *Main\right, *Main\top, ChildWidth, ChildHeight, #True)
Else
If Abs(*Main\top - Child\top) < #Y_Grab And Abs(*Main\right - Child\left) < #X_Grab ; within the 'snap' zone
*Main\left = Child\left - CurWidth
*Main\top = Child\top
*Main\right = Child\left
*Main\bottom = Child\bottom
If Not IsThread(TID)
TID = CreateThread(@Gui_ReleaseWindow(), #Null)
EndIf
Result = #True
EndIf
EndIf
Case WindowID(1)
*Main = LParam
CurWidth = *Main\right - *Main\left
CurHeight = *Main\bottom - *Main\top
GetWindowRect_(WindowID(0), @Parent)
If Abs(*Main\top - Parent\top) < #Y_Grab And Abs(*Main\left - Parent\right) < #X_Grab ; within the 'snap' zone
If Not STUCK
*Main\left = Parent\right
*Main\top = Parent\top
*Main\right = Parent\right + CurWidth
*Main\bottom = Parent\bottom
If Not IsThread(TID)
TID = CreateThread(@Gui_ReleaseWindow(), #Null)
EndIf
Result = #True
EndIf
Else
STUCK = #False
EndIf
EndSelect
EndSelect
ProcedureReturn Result
EndProcedure
Define Wr.RECT
OpenWindow(0, 0, 0, 320, 240, "Main Window", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
GetWindowRect_(WindowID(0), Wr)
OpenWindow(1, Wr\right, Wr\top, 320, 240, "Child Window", #PB_Window_TitleBar, WindowID(0))
SetWindowCallback(@Gui_Callback())
SetActiveWindow(0)
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow