Docking windows

Windows specific questions.
Post Reply
geminis4941
Posts: 64
Joined: Jul 15, 2009 12:41

Docking windows

Post by geminis4941 »

User Stueber wrote a post about Qt with freebasic and there was a sample of docking windows un Qt.
Post viewtopic.php?t=15187.
Has someone wrote docking windows un win32? I Will post here a program translated from c about docking windows but they dock externaly to main window, not like in the Qt sample. Thanks un advanced.
geminis4941
Posts: 64
Joined: Jul 15, 2009 12:41

Re: Docking windows

Post by geminis4941 »

Hi, this is the code for external docking windows I found, but is not like Qt sample works. Maybe can be util for someone.

Dockwindow.bas

Code: Select all

#Include Once "windows.bi"


'Docking types - The first word refers to the parent edge that the child is docked to. The second
'                word refers to the parent edge that the child is aligned with.
Enum EDockType
	DT_NONE = 0 'Not docked
	DT_TOP = 1 'Docked at the top of the parent
	DT_TOPRIGHT = 2 'Docked at the top right of the parent
	DT_RIGHTTOP = 3 'Docked at the right top of the parent
	DT_RIGHT = 4 'Docked at the right of the parent
	DT_RIGHTBOTTOM = 5 'Docked at the right bottom of the parent
	DT_BOTTOMRIGHT = 6 'Docked at the bottom right of the parent
	DT_BOTTOM = 7 'Docked at the bottom of the parent
	DT_BOTTOMLEFT = 8 'Docked at the bottom left of the parent
	DT_LEFTBOTTOM = 9 'Docked at the left bottom of the parent
	DT_LEFT = 10 'Docked at the left of the parent
	DT_LEFTTOP = 11 'Docked at the left top of the parent
	DT_TOPLEFT = 12 'Docked at the top left of the parent
End Enum

'Default values
const  DEF_THRESHOLD = 10 'Default docking threshold

'DockChild - Defines a child window
Type DockChild
Public:
	Declare Constructor ( )
	Declare Destructor ( )

	Declare Property Handle(hwnd As HWND)
	Declare Property Handle() As HWND
	Declare Property DockType(DockType1 As EDockType)
	Declare Property DockType() As EDockType
	
	Declare Property X() As Long
	Declare Property X(x1 As Long)

	Declare Property Y()As Long	
	Declare Property Y(y1 As Long)

Private:
	Dim mhwnd As HWND 'Window handle
	Dim mDockType As EDockType 'Docking type
	Dim mx As Long  'X co-ordinate of the window relative to the parent upon docking
	Dim my As long'Y co-ordinate of the window relative to the parent upon docking
End Type

'DockWindow - The window docking system
Type DockWindow
Const MAXCHILDS = 10
Public:
	Declare Constructor ( )
	Declare Destructor ( )

	Declare Property Parent(hParent As HWND )
	Declare Property Threshold(lThreshold As Long)

	Declare Sub AddChild( hChild As HWND, AutoDock As boolean = TRUE)
	Declare Sub RemoveChild(hChild As HWND )
	Declare Function FindChild(hChild As HWND )As DockChild ptr

	'Update window positions and dock states
	Declare Sub WindowMoved(hwnd As HWND)

Private:
	'Member data
	mParent As HWND  'The parent window
	mThreshold As long  'The docking threshold
	mChildList(1 To MAXCHILDS) As DockChild Ptr  'List of child windows
	mChildListFirst As Integer = 0
	mChildListLast As Integer = 0
	mWorking As boolean 'Stops WindowMoved from being called while it is already running
	mAutoDock As boolean'Set to true when adding a window to auto dock it
End Type




Constructor.DockChild()
 this.mHwnd= NULL
 this.mDockType = DT_NONE
 this.mX = 0
 this.mY = 0
End Constructor

Destructor.DockChild()
End Destructor

Property DockChild.Handle() As HWND 
	Return this.mHwnd 
End Property

Property DockChild.Handle(hwnd As HWND )
	this.mHwnd = hwnd
End Property

Property DockChild.DockType() As EDockType
	Return this.mDockType 
End Property
Property DockChild.DockType(t As EDockType)
	this.mDockType = t
End Property

Property DockChild.X() As Long
	Return this.mx
End Property

Property DockChild.X(x1 As Long)
	this.mx = x1
End Property

Property DockChild.Y() As Long
	Return this.my
End Property

Property DockChild.Y(y1 As Long)
	this.my = y1
End Property

Constructor.DockWindow()
	this.mParent = NULL
	this.mThreshold = DEF_THRESHOLD
	this.mWorking=FALSE
	this.mAutoDock=FALSE
End Constructor

Destructor.DockWindow()
Dim curChild As DockChild Ptr
	' Delete the list childs
	while(this.mChildListLast>0)
		'Pop the last node off
		curChild = this.mChildList(this.mChildListLast)
		this.mChildListLast = this.mChildListLast-1
		delete curChild
	Wend
End Destructor


Property DockWindow.Parent(hParent As HWND )
	'if(IsWindow(hParent))Then
		this.mParent = hParent
	'End If
End Property

Property DockWindow.Threshold(lThreshold As long )
	this.mThreshold = lThreshold
End Property

Sub DockWindow.AddChild(hChild As HWND , AutoDock As boolean)

	Dim newChild As DockChild Ptr

	'-----------------
	' Add the child window to the list
	'-----------------
	'Validate the window handle
	if(IsWindow(hChild)=0)Then
		Print "ISWINDOW(hchild) = false"
		Exit Sub
	End If

	'Setup a CHILD structure for the window
	newChild = new DockChild()
	if(newChild = NULL)Then
		Print "newChild = NULL"
		Exit Sub
	End If
	
	newChild->DockType=EDockType.DT_NONE
	newChild->Handle= hChild
	newChild->X= 0
	newChild->Y= 0

	'Add the child to the list
	THIS.mChildListLast = THIS.mChildListLast+1
	THIS.mChildList(THIS.mChildListLast) = newChild

	'-----------------
	' Auto dock the child
	'-----------------
	if(AutoDock = TRUE)Then
		this.mAutoDock = TRUE
		THIS.WindowMoved(hChild)
		this.mAutoDock = FALSE
	End If
End Sub 


Sub DockWindow.RemoveChild(hChild As HWND )
	Dim i As Integer
	For i = 1 to this.mChildListLast
		'Is this the requested child?
		if(this.mChildList(i)->Handle = hChild)Then
			Delete this.mChildList(i)
			Dim j As Integer
			For j = i+1 to this.mChildListLast
				this.mChildList(j-1)=this.mChildList(j)
			Next			
		End If
	Next i

End Sub


Function  DockWindow.FindChild(hChild As HWND ) As DockChild Ptr
	Dim i As Integer
	For i = 1 to this.mChildListLast
		'Is this the requested child?
		if(this.mChildList(i)->Handle = hChild)Then
			return (this.mChildList(i))
		End If
	Next i

	'-----------------
	' Window not in list
	'-----------------
	return NULL
End Function

Sub DockWindow.WindowMoved(hwnd As HWND )
	Dim child As DockChild ptr 
	Dim As RECT rcParent
	Dim As RECT rcChild
	Dim As RECT rcNew
	Dim As boolean bVert = FALSE
	Dim As boolean bHorz = FALSE

	'-----------------
	' Exit if currently working
	'-----------------
	if(this.mWorking)Then
		Print "(this.mWorking = true)"
		Exit Sub
	End If
	
	this.mWorking = TRUE

	'-----------------
	' Do window docking
	'-----------------
	if(hwnd<>this.mParent)Then
		'Find the window to process
		child = FindChild(hwnd)
		if(child = NULL)then
			Print "Window child = NULL"
			this.mWorking = FALSE
			Exit Sub 
		End If

		'Get window rectangles
		GetWindowRect(this.mParent, @rcParent)
		GetWindowRect(hwnd, @rcChild)
		memcpy(@rcNew, @rcChild, sizeof(RECT))

		'Check docking cases and setup the new window position
		if(rcChild.left > rcParent.right - mThreshold ) And ( rcChild.left < rcParent.right + mThreshold)then
			bVert = TRUE
			rcNew.left = rcParent.right
			child->DockType = EDockType.DT_RIGHT
			child->X= 0
			child->Y=(rcChild.top - rcParent.top)			
		End If
		if(rcChild.right > rcParent.left - mThreshold ) And ( rcChild.right < rcParent.left + mThreshold)Then
			bVert = TRUE
			rcNew.left = rcParent.left - (rcChild.right - rcChild.left)
			child->DockType = EDockType.DT_LEFT
			child->X= 0
			child->Y=(rcChild.top - rcParent.top)
		End If
		if(rcChild.top > rcParent.bottom - mThreshold ) And ( rcChild.top < rcParent.bottom + mThreshold) Then
			bHorz = TRUE
			rcNew.top = rcParent.bottom
			child->DockType = EDockType.DT_BOTTOM
			child->X=(rcChild.left - rcParent.left)
			child->Y= 0
		End If
		if(rcChild.bottom > rcParent.top - mThreshold ) And ( rcChild.bottom < rcParent.top + mThreshold) Then
			bHorz = TRUE
			rcNew.top = rcParent.top - (rcChild.bottom - rcChild.top)
			child->DockType = EDockType.DT_TOP
			child->X=(rcChild.left - rcParent.left)
			child->Y= 0
		End If
		if(rcChild.left > rcParent.left - mThreshold) And (rcChild.left < rcParent.left + mThreshold) Then
			if(bHorz = true)Then
				rcNew.left = rcParent.left
				if(child->DockType = EDockType.DT_TOP) Then
					child->DockType = EDockType.DT_TOPLEFT
					child->X= 0
					child->Y= 0
				End If
				if(child->DockType = EDockType.DT_BOTTOM)Then
					child->DockType = EDockType.DT_BOTTOMLEFT
					child->X= 0
					child->Y= 0
				End If
			End If
		End If
		if(rcChild.right > rcParent.right - mThreshold) And ( rcChild.right < rcParent.right + mThreshold)Then
			if(bHorz = true)Then
				rcNew.left = rcParent.right - (rcChild.right - rcChild.left)
				if(child->DockType = EDockType.DT_TOP)Then
					child->DockType = EDockType.DT_TOPRIGHT
					child->X= 0
					child->Y= 0
				End If
				if(child->DockType = EDockType.DT_BOTTOM)Then
					child->DockType = EDockType.DT_BOTTOMRIGHT
					child->X= 0
					child->Y= 0
				End If
			End If
		End If
		if(rcChild.top > rcParent.top - mThreshold) and (rcChild.top < rcParent.top + mThreshold)Then
			if(bVert = true)Then
				rcNew.top = rcParent.top
				if(child->DockType = EDockType.DT_LEFT) Then
					child->DockType = EDockType.DT_LEFTTOP
					child->X= 0
					child->Y= 0
				End If
				if(child->DockType = DT_RIGHT)Then
					child->DockType=DT_RIGHTTOP
					child->X= 0
					child->Y= 0
				End If
			End If
		End If
		if(rcChild.bottom > rcParent.bottom - mThreshold) And ( rcChild.bottom < rcParent.bottom + mThreshold)Then
			if(bVert = true)Then
				rcNew.top = rcParent.bottom - (rcChild.bottom - rcChild.top)
				if(child->DockType = EDockType.DT_LEFT)Then
					child->DockType = EDockType.DT_LEFTBOTTOM
					child->X= 0
					child->Y= 0
				End If
				if(child->DockType = EDockType.DT_RIGHT)Then
					child->DockType = EDockType.DT_RIGHTBOTTOM
					child->X= 0
					child->Y= 0
				End If
			End If
		End If

		'Snap the toolbar into position
		if(rcNew.left <> rcChild.left) or (rcNew.right <> rcChild.right) or (rcNew.top <> rcChild.top) or (rcNew.bottom <> rcChild.bottom) Or (mAutoDock = TRUE) then
			SetWindowPos(hwnd, 0, rcNew.left, rcNew.top, 0, 0, SWP_NOZORDER Or SWP_NOSIZE)
		Else
			'Window is no longer docked
			child->DockType = EDockType.DT_NONE
			child->X= 0
			child->Y= 0
		End If	
	else	
	   Print "process parent window"
		'Get the parent rectangle
		GetWindowRect(this.mParent, @rcParent)
		memcpy(@rcNew, @rcParent, sizeof(RECT))

		'Iterate through the child windows
		For i as Integer = 1 To this.mChildListLast
			'Get child pointer
			child = THIS.mChildList(i)

			'Reset new position rectangle
			memcpy(@rcNew, @rcParent, sizeof(RECT))

			'Get child window rectangle
			GetWindowRect(child->Handle, @rcChild)

			'Setup the new window position depending on the dock code
			Select Case (child->DockType)		
			case EDockType.DT_NONE
				rcNew.left = rcChild.left
				rcNew.top = rcChild.top
				
			Case EDockType.DT_TOP
				rcNew.left += child->X
				rcNew.top -= (rcChild.bottom - rcChild.top)
				
			Case EDockType.DT_TOPRIGHT
				rcNew.left = rcParent.right - (rcChild.right - rcChild.left)
				rcNew.top -= (rcChild.bottom - rcChild.top)
				
			Case EDockType.DT_RIGHTTOP
				rcNew.left = rcParent.right
				
			Case EDockType.DT_RIGHT
				rcNew.left = rcParent.right
				rcNew.top += child->Y
				
			case EDockType.DT_RIGHTBOTTOM
				rcNew.left = rcParent.right
				rcNew.top = rcParent.bottom - (rcChild.bottom - rcChild.top)
				
			case EDockType.DT_BOTTOMRIGHT
				rcNew.left = rcParent.right - (rcChild.right - rcChild.left)
				rcNew.top = rcParent.bottom
			
			Case EDockType.DT_BOTTOM
				rcNew.left += child->X
				rcNew.top = rcParent.bottom
				
			Case EDockType.DT_BOTTOMLEFT
				rcNew.top = rcParent.bottom				

			Case EDockType.DT_LEFTBOTTOM
				rcNew.left -= (rcChild.right - rcChild.left)
				rcNew.top = rcParent.bottom - (rcChild.bottom - rcChild.top)
				
			Case EDockType.DT_LEFT
				rcNew.left -= (rcChild.right - rcChild.left)
				rcNew.top += child->Y
				
			Case EDockType.DT_LEFTTOP
				rcNew.left -= (rcChild.right - rcChild.left)
				
			case EDockType.DT_TOPLEFT
				rcNew.top -= (rcChild.bottom - rcChild.top)
				

			Case Else 
				'Error
				rcNew.left = rcChild.left
				rcNew.top = rcChild.top
				
			End Select
			'Move the window
			Print "SetWindowPos child->Handle"
			SetWindowPos(child->Handle, 0, rcNew.left, rcNew.top, 0, 0, SWP_NOZORDER or SWP_NOSIZE)
		Next
	End If

	'-----------------
	' No longer working
	'-----------------
	this.mWorking = false
End Sub
And Example.bas

Code: Select all

#Include "windows.bi"
#include "DockWindow.bas"


Dim Shared As DockWindow gDock 'The window docking system
Dim Shared As HWND gParent  'A window to act as the docking parent
Dim Shared As HWND gChild1  'A window to act as one docking child
Dim Shared As HWND gChild2  'A window to act as a second docking child


'    gChild1 and gChild2 are not created as child windows to gParent, I simply use the term
'    child to describe the relationship in the docking system - Child windows dock with the
'	  Parent window.

Function WindowProc( hwnd As HWND, msg As  UINT, wParam As WPARAM ,  lParam As LPARAM) As LRESULT 

	'Process messages
	Select Case (msg)
		case WM_MOVE
		'Notify the docking system of a window moving
		gDock.WindowMoved(hwnd)
		return 0

	case WM_DESTROY:
		'Post a quit message
		PostQuitMessage(0)
		return 0

		Case Else
		'Pass the message on to windows for processing
		return DefWindowProc(hwnd, msg, wParam, lParam)
	End Select
End Function


function WinMain( hInstance As HINSTANCE,  hPrevInstance As HINSTANCE, lpCmdLine As LPSTR ,  nShowCmd As Integer) As Integer
	Dim As WNDCLASSEX wc
	Dim As RECT rc
	Dim As MSG msg

	'Setup the window class
	wc.cbClsExtra = 0
	wc.cbSize = sizeof(WNDCLASSEX)
	wc.cbWndExtra = 0
	wc.hbrBackground = CreateSolidBrush(GetSysColor(COLOR_BTNFACE))
	wc.hCursor = LoadCursor(0, IDC_ARROW)
	wc.hIcon = LoadIcon(GetModuleHandle(0), IDI_APPLICATION)
	wc.hIconSm = LoadIcon(GetModuleHandle(0), IDI_APPLICATION)
	wc.hInstance = GetModuleHandle(0)
	wc.lpfnWndProc = @WindowProc
	wc.lpszClassName = @"DOCKINGWINDOW"
	wc.lpszMenuName = 0
	wc.style = CS_HREDRAW Or CS_VREDRAW

	'Register the window class
	if(RegisterClassEx(@wc) = 0 )Then
		Print "Error RegisterClassEx"
		Sleep
		return 0
	End If

	gParent = CreateWindowEx(0, "DOCKINGWINDOW", "CWindowDock Demo - Parent", WS_OVERLAPPED or WS_SYSMENU Or WS_VISIBLE, (GetSystemMetrics(SM_CXSCREEN) / 2) - 150, (GetSystemMetrics(SM_CYSCREEN) / 2) - 150, 300, 300, 0, 0, hInstance, 0)
	if(gParent = NULL) Then
		Print "Error creating gParent"
		Sleep
		return 0
	End If

	'Get the parent window rectangle for positioning the child windows
	GetWindowRect(gParent, @rc)

	'Create the child windows
	gChild1 = CreateWindowEx(0, "DOCKINGWINDOW", "CWindowDock Demo - Child 1", WS_OVERLAPPED Or WS_VISIBLE, rc.right, rc.top, 150, 150, gParent, 0, hInstance, 0)
	if(gChild1 = NULL)Then
		Print "Error creating gChild1"
		Sleep		
		return 0
	End If
	
	gChild2 = CreateWindowEx(0, "DOCKINGWINDOW", "CWindowDock Demo - Child 2", WS_OVERLAPPED Or WS_VISIBLE, rc.right, rc.top + 150, 150, 150, gParent, 0, hInstance, 0)
	if(gChild2 = NULL) Then
		Print "Error creating gChild2"
		Sleep		
		return 0
	End If

	'-----------------
	' Add the windows to the docking system
	'-----------------
	'Set the parent window
	gDock.Parent = gParent

	'Add the child windows
	'gDock.AddChild(gChild1) 'gChild1 will automatically dock
	'gDock.AddChild(gChild2, false) 'gChild2 will not automatically dock

	gDock.AddChild(gChild1,TRUE) 'gChild1 will automatically dock
	gDock.AddChild(gChild2,TRUE) 'gChild2 will automatically dock

	'-----------------
	' The message loop
	'-----------------
	while(GetMessage(@msg, 0, 0, 0))
		TranslateMessage(@msg)
		DispatchMessage(@msg)
	Wend

	'Return to windows
	return msg.wParam
End Function


End  WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Docking windows

Post by jj2007 »

The example exits here:

Code: Select all

   if(gParent = NULL) Then
      Print "Error creating gParent"
      Sleep
      return 0
   End If
geminis4941
Posts: 64
Joined: Jul 15, 2009 12:41

Re: Docking windows

Post by geminis4941 »

I compile in freebasic 1.0.5 and with windows 10 OS. What is your OS and fb version?
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Docking windows

Post by jj2007 »

Win7-64. Is there something like WinErr$() in FB?
If I put everywhere @ in front of "DOCKINGWINDOW", CreateWindowEx works, though.
geminis4941
Posts: 64
Joined: Jul 15, 2009 12:41

Re: Docking windows

Post by geminis4941 »

I use fb 10.0.5 - 32 bits . A mistake , is correct your correction.
FreeBASIC Compiler - Version 1.05.0 (01-31-2016), built for win32 (32bit)
Last edited by geminis4941 on Jan 12, 2018 14:42, edited 1 time in total.
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Docking windows

Post by jj2007 »

FreeBASIC Compiler - Version 1.05.0 (01-31-2016), built for win32 (32bit)
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Docking windows

Post by dodicat »

Win 10
fb 1.05.0 (the latest official build)
Works fine here.
Multiple windows (3) attached to each other.
Move the big window, they stay attached.
can be separated by moving the small ones away.
Got one warning about boolean operands mixing.(line 347)
Fixed by:
if(rcNew.left <> rcChild.left) or (rcNew.right <> rcChild.right) or (rcNew.top <> rcChild.top) or (rcNew.bottom <> rcChild.bottom) Or (mAutoDock <>0) then
...
IMHO booleans are more trouble than they are worth.
But many will not agree.
geminis4941
Posts: 64
Joined: Jul 15, 2009 12:41

Re: Docking windows

Post by geminis4941 »

Hi everybody.

I modified previous dock program to dock windows internally. Move left-top child window corner inside (outside) the parent to dock the window. I hope it could be of utility to someone.

dockwindowsample.bas

Code: Select all

#Include "windows.bi"
#include "DockWindow1.bas"


Dim Shared As DockWindow gDock 'The window docking system
Dim Shared As HWND gDesktopParent 'A window to act as the doesktop
Dim Shared As HWND gParent 'A window to act as the docking parent
Dim Shared As HWND gChild1 'A window to act as one docking child
Dim Shared As HWND gChild2 'A window to act as one docking child
Dim Shared As HWND gChild3 'A window to act as one docking child
Dim Shared As HWND gChild4 'A window to act as one docking child
Dim Shared As HWND gChild5 'A window to act as one docking child


' gChild1 and gChild2 are not created as child windows to gParent, I simply use the term
' child to describe the relationship in the docking system - Child windows dock with the
' Parent window.

Function WindowProc( hwnd As HWND, msg As UINT, wParam As WPARAM , lParam As LPARAM) As LRESULT

'Process messages
Select Case (msg)
Case WM_LBUTTONDOWN
'Notify the docking system
gDock.WindowMousedown(hwnd)
Case WM_LBUTTONUP
'Notify the docking system
gDock.WindowMouseUp(hwnd)
Case WM_MOUSEMOVE
'Notify the docking system of a window moving
gDock.WindowMove(hwnd)

case WM_MOVE
'gDock.WindowMove(hwnd)

Case WM_SIZE
	If (hwnd=gDock.Parent) Then	
		gDock.RecalculateChildPos()
	End If
	
	Case WM_PAINT
            Dim As PAINTSTRUCT ps
            Dim As HDC hdc = BeginPaint(hWnd, @ps)
            Dim As RECT r
            Dim mystr As ZString*80
            Dim nchar  As Integer = GetWindowText(hWnd,@mystr,80)

            GetClientRect(hWnd,@r)
            
            DrawText(hdc,mystr,nchar, @r, DT_TOP Or DT_LEFT)


            EndPaint(hWnd,@ps)
            ReleaseDC(hWnd, hdc)
		
case WM_DESTROY
'Post a quit message
PostQuitMessage(0)
Case Else
'Pass the message on to windows for processing
return DefWindowProc(hwnd, msg, wParam, lParam)
End Select
Return 0
End Function


function WinMain( hInstance As HINSTANCE, hPrevInstance As HINSTANCE, lpCmdLine As LPSTR , nShowCmd As Integer) As Integer
Dim As WNDCLASSEX wc
Dim As RECT rc
Dim As MSG msg

'Setup the window class
wc.cbClsExtra = 0
wc.cbSize = sizeof(WNDCLASSEX)
wc.cbWndExtra = 0
wc.hbrBackground = CreateSolidBrush(GetSysColor(COLOR_BTNFACE))
wc.hCursor = LoadCursor(0, IDC_ARROW)
wc.hIcon = LoadIcon(GetModuleHandle(0), IDI_APPLICATION)
wc.hIconSm = LoadIcon(GetModuleHandle(0), IDI_APPLICATION)
wc.hInstance = GetModuleHandle(0)
wc.lpfnWndProc = @WindowProc
wc.lpszClassName = @"DOCKINGWINDOW"
wc.lpszMenuName = 0
wc.style = CS_HREDRAW Or CS_VREDRAW

'Register the window class
if(RegisterClassEx(@wc) = 0 )Then
Print "Error RegisterClassEx"
Sleep
return 0
End If
gParent = CreateWindowEx(0, "DOCKINGWINDOW", "DockWindow Demo - Parent", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, (GetSystemMetrics(SM_CXSCREEN) / 2) - 150, (GetSystemMetrics(SM_CYSCREEN) / 2) - 150, 300, 300, 0, 0, hInstance, 0)

' gParent = CreateWindowEx(0, "DOCKINGWINDOW", "CWindowDock Demo - Parent", WS_OVERLAPPEDWINDOW Or WS_CLIPCHILDREN Or WS_VISIBLE, (GetSystemMetrics(SM_CXSCREEN) / 2) - 150, (GetSystemMetrics(SM_CYSCREEN) / 2) - 150, 300, 300, 0, 0, hInstance, 0)
if(gParent = NULL) Then
Print "Error creating gParent"
Sleep
return 0
End If

'Get the parent window rectangle for positioning the child windows
GetWindowRect(gParent, @rc)
gDesktopParent = GetDesktopWindow()
'Create the child windows
gChild1 = CreateWindowEx(0, "DOCKINGWINDOW", "Child 1", WS_BORDER Or WS_POPUP or WS_visible Or WS_CHILD , rc.right, rc.top, 150, 150, gDesktopParent, 0, hInstance, 0)
if(gChild1 = NULL)Then
	Print "Error creating gChild1"
	Sleep
	return 0
End If

gChild2 = CreateWindowEx(0, "DOCKINGWINDOW", "Child 2", WS_BORDER Or WS_POPUP Or WS_visible Or WS_CHILD , rc.right, rc.top + 180, 150, 150, gDesktopParent, 0, hInstance, 0)
if(gChild2 = NULL) Then
	Print "Error creating gChild2"
	Sleep
	return 0
End If

gChild3 = CreateWindowEx(0, "DOCKINGWINDOW", "Child 3", WS_BORDER Or WS_POPUP Or WS_visible Or WS_CHILD , rc.right, rc.top + 180, 150, 150, gDesktopParent, 0, hInstance, 0)
if(gChild3 = NULL) Then
	Print "Error creating gChild3"
	Sleep
	return 0
End If

gChild4 = CreateWindowEx(0, "DOCKINGWINDOW", "Child 4", WS_BORDER Or WS_POPUP Or WS_visible Or WS_CHILD , rc.right, rc.top + 180, 150, 150, gDesktopParent, 0, hInstance, 0)
if(gChild4 = NULL) Then
	Print "Error creating gChild4"
	Sleep
	return 0
End If

gChild5 = CreateWindowEx(0, "DOCKINGWINDOW", "Child 5", WS_BORDER Or WS_POPUP Or WS_visible Or WS_CHILD , rc.right, rc.top + 180, 150, 150, gDesktopParent, 0, hInstance, 0)
if(gChild5 = NULL) Then
	Print "Error creating gChild5"
	Sleep
	return 0
End If

SetWindowPos(gChild1, HWND_TOPMOST,0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
SetWindowPos(gChild2, HWND_TOPMOST,0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
SetWindowPos(gChild3, HWND_TOPMOST,0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
SetWindowPos(gChild4, HWND_TOPMOST,0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
SetWindowPos(gChild5, HWND_TOPMOST,0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)

ShowWindow(gChild1,SW_SHOW)
ShowWindow(gChild2,SW_SHOW)
ShowWindow(gChild3,SW_SHOW)
ShowWindow(gChild4,SW_SHOW)
ShowWindow(gChild5,SW_SHOW)

'-----------------
' Add the windows to the docking system
'-----------------
'Set the parent window
gDock.Parent = gParent

'Add the child windows
gDock.AddChild(gChild1,EDockType.DT_TOP,FALSE) 
gDock.AddChild(gChild2,EDockType.DT_BOTTOM,FALSE) 
gDock.AddChild(gChild3,EDockType.DT_LEFT,FALSE) 
gDock.AddChild(gChild4,EDockType.DT_RIGHT,FALSE) 
gDock.AddChild(gChild5,EDockType.DT_EXPAND,FALSE) 

'-----------------
' The message loop
'-----------------
while(GetMessage(@msg, 0, 0, 0))
TranslateMessage(@msg)
DispatchMessage(@msg)
Wend

'Return to windows
return msg.wParam
End Function


End WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)
DockWindow1.bas

Code: Select all

#Include Once "windows.bi"

Dim Shared movingwindow As HWND
Dim Shared moveDesp As Point
'Docking types 

Enum EDockType
	DT_NONE = 0 'Not docked
	DT_TOP = 1 'Docked at the top of the parent
	DT_BOTTOM = 2 'Docked at the bottom of the parent
	DT_LEFT = 3 'Docked at the left of the parent
	DT_RIGHT = 4 'Docked at the right of the parent
	DT_EXPAND = 5 'Docked at the left top of the parent
End Enum

'DockChild - Defines a child window
Type DockChild
Public:
	Declare Constructor ( )
	Declare Destructor ( )
	
	Declare Property Handle() As HWND
	Declare Property Handle(hwnd As HWND)
	Declare Property DockType() As EDockType
	Declare Property DockType(t As EDockType)
	Declare Property Docked() As BOOL
	Declare Property Docked(yn As BOOL)
	Declare Property Dockable() As BOOL
	Declare Property Dockable(yn As BOOL)
	
	Declare Property posRect() As RECT
	Declare Property posRect(r As RECT)

Private:
	Dim mhwnd As HWND 'Window handle
	Dim mDockable As BOOL
	Dim mDockType As EDockType 'Docking type
	Dim mDocked As BOOL
	Dim mPosRect As RECT
End Type


'DockWindow - The window docking system
Type DockWindow
	Const MAXCHILDS = 10
Public:
	Declare Constructor ( )
	Declare Destructor ( )
	
	Declare Property Parent() As HWND 
	Declare Property Parent(hParent As HWND )
	
	Declare Sub AddChild( hChild As HWND, dt As EDockType, yn As bool)
	Declare Sub RemoveChild(hChild As HWND )
	Declare Function FindChild(hChild As HWND )As DockChild ptr
	
	'Update window positions and dock states
	Declare Sub WindowMouseDown(hwnd As HWND)
	Declare Sub WindowMouseUp(hwnd As HWND)
	Declare Sub WindowMove(hwnd As HWND)
	Declare Sub ReparentChild(hwndchild As HWND,hwndParent As HWND)
	Declare Sub RecalculateChildPos()
Private:
	mParent As HWND 'The parent window
	mMarginRect   As RECT
	mChildList(1 To MAXCHILDS) As DockChild Ptr 'List of child windows
	mChildListFirst As Integer = 0
	mChildListLast As Integer = 0
	mWorking As boolean 'Stops WindowMoved from being called while it is already running
End Type

Constructor.DockChild()
	this.mHwnd= NULL
	this.mDockable = TRUE
	this.mDockType = DT_NONE
	this.mDocked = FALSE
End Constructor

Destructor.DockChild()
End Destructor

Property DockChild.Handle() As HWND
	Return this.mHwnd
End Property
Property DockChild.Handle(hwnd As HWND )
	this.mHwnd = hwnd
End Property
Property DockChild.Dockable() As BOOL
	Return this.mDockable
End Property
Property DockChild.Dockable(yn As BOOL)
	this.mDockable = yn
End Property
Property DockChild.DockType() As EDockType
	Return this.mDockType
End Property
Property DockChild.DockType(t As EDockType)
	this.mDockType = t
End Property
Property DockChild.Docked() As BOOL
	Return this.mDocked
End Property
Property DockChild.Docked(yn As BOOL)
	this.mDocked = yn
End Property
Property DockChild.PosRect() As RECT
	Return this.mposRect
End Property
Property DockChild.PosRect(r As RECT)
	this.mposRect = r
End Property

Constructor.DockWindow()
	this.mParent = NULL

	this.mWorking=FALSE

	this.mMarginRect.Left = 0
	this.mMarginRect.Top = 0
	this.mMarginRect.Right = 0
	this.mMarginRect.Bottom = 0	
End Constructor

Destructor.DockWindow()
	Dim curChild As DockChild Ptr
	'Delete the list childs
	while(this.mChildListLast>0)
		curChild = this.mChildList(this.mChildListLast)
		this.mChildListLast = this.mChildListLast-1
		delete curChild
	Wend
End Destructor

Sub DockWindow.ReparentChild(hwndchild As HWND,hwndParent As HWND)
	Print "reparentchild"
	SetParent(hwndchild,hwndParent)
End Sub

Sub DockWindow.RecalculateChildPos()
	Print "recalculatechildpos"
	Dim Child As DockChild Ptr
	Dim prect As RECT 
	Dim crect As RECT
	Dim As Integer L,T,W,H
	Dim As Integer L1,T1,W1,H1
	Dim positionate As BOOL 
	GetClientRect(this.mParent,@prect)
   L = prect.left: T = prect.Top: W = prect.Right-prect.Left: H = prect.Bottom-prect.Top
   Print "PARENT CLIENT RECT: ",L," ",T," ",W," ",H
	For i As Integer= 1 To this.mChildListLast
		Child = this.mChildList(i)
		If (Child->Docked<>0) Then
			Print "Child->Docked=TRUE"
			'GetWindowRect(Child->Handle,@crect)		
			crect	= child->posRect 			
			positionate  = 0
			'If (W>0) And (H>0) Then
			Select Case Child->DockType
				case	EDockType.DT_TOP
					   L1 = L: T1 = T : W1 = W : H1 =crect.Bottom-crect.Top   
					   T = T + H1 : H = H-H1
					   positionate  = 1
				Case  EDockType.DT_BOTTOM 
					   L1 = L: H1=crect.Bottom-crect.Top : W1 = W : T1 = T+H-H1   
					   H = H-H1
					   positionate  = 1
				Case  EDockType.DT_LEFT 
					   L1 = L: H1= H : W1 = crect.Right-crect.Left : T1 = T   
					   L = L+W1 : W = W-W1					
					   positionate  = 1
				case	EDockType.DT_RIGHT
					   W1 = crect.Right-crect.Left : L1 = L+W-W1 : H1 =H :  T1 = T   
					   W = W-W1					
					   positionate  = 1
				Case  EDockType.DT_EXPAND
					   L1 = L : T1 = T: H1 =H: W1 = W    
					   W = W-W1 : H= H-H1					
					   positionate  = 1
				Case Else 
					  Print "Incorrect doctype"
			End Select
			'End If
			If (positionate<>0) Then
				Print "L1 T1 W1 H1: ",L1," ",T1," ",W1," ",H1 
				SetWindowPos(child->Handle, 0,L1,T1,W1,H1, SWP_NOZORDER)							
			EndIf
		EndIf
	Next
   
End Sub
Property DockWindow.Parent() As HWND 
	Return this.mParent
End Property

Property DockWindow.Parent(hParent As HWND )
	'if(IsWindow(hParent))Then
	this.mParent = hParent
	'End If
End Property

Sub DockWindow.AddChild(hChild As HWND, dt As EDockType, yn As bool)
	If (THIS.mChildListLast+1<=MAXCHILDS) Then	
		Dim newChild As DockChild Ptr
		'Add the child window to the list
		'Validate the window handle
		if(IsWindow(hChild)=0)Then
			Print "ISWINDOW(hchild) = false"
			Exit Sub
		End If
		
		'Setup a CHILD structure for the window
		newChild = new DockChild()
		if(newChild = NULL)Then
		Print "newChild = NULL"
		Exit Sub
		End If
		
		newChild->DockType=dt
		newChild->Docked = yn
		newChild->Handle= hChild
		Dim crect As RECT
		GetWindowRect(hChild,@crect)
		newchild->posRect= crect 		
		 			
				
		'Add the child to the list
		THIS.mChildListLast = THIS.mChildListLast+1
		THIS.mChildList(THIS.mChildListLast) = newChild
		
		THIS.WindowMove(hChild)
	End If	
End Sub


Sub DockWindow.RemoveChild(hChild As HWND )
Dim i As Integer
	For i = 1 to this.mChildListLast
	'Is this the requested child?
		if(this.mChildList(i)->Handle = hChild)Then
			Delete this.mChildList(i)
			Dim j As Integer
			For j = i+1 to this.mChildListLast
				this.mChildList(j-1)=this.mChildList(j)
			Next
		End If
	Next i
End Sub

Function DockWindow.FindChild(hChild As HWND ) As DockChild Ptr
Dim i As Integer
	For i = 1 to this.mChildListLast
		'Is this the requested child?
		if(this.mChildList(i)->Handle = hChild)Then
			return (this.mChildList(i))
		End If
	Next i
	Return NULL
End Function

Sub DockWindow.WindowMousedown(hwnd As HWND )
	Print "DockWindow.WindowMousedown"
	SetCapture(hwnd)
	movingwindow = hwnd
	Dim r As RECT
	Dim p As Point
	GetwindowRect(hwnd,@r)
	GetCursorPos(@p)
	movedesp.x = p.x-r.left
	movedesp.y = p.y-r.Top

	Dim child As DockChild ptr
	child = FindChild(hwnd)
	If(child = NULL)then
		Print "Window child = NULL"
		this.mWorking = FALSE
		Exit Sub
	End If

	If (child->dockable <> 0 ) Then
		If  (child->docked <> 0 ) Then    					
			child->docked = 0
			This.ReparentChild(hwnd,GetDesktopWindow())	
			Dim As Integer L1,T1,W1,H1
			Dim p As Point 
			getCursorpos(@p)
			W1 = (child->posrect.Right-child->posrect.Left)
			H1 = (child->posrect.Bottom-child->posrect.Top)
			L1 = p.x -(W1/2) 
			T1 = p.y+10
			movedesp.x = (W1/2)
			movedesp.y = 10
			SetWindowPos(child->Handle, 0,L1,T1,W1,H1, SWP_NOZORDER)					
		End if
	End If
End Sub
Sub DockWindow.WindowMouseUp(hwnd As HWND )
Dim child As DockChild ptr
Dim As RECT rcParent
Dim As RECT rcChild

	Print "DockWindow.WindowMouseUp"
	ReleaseCapture()
	movingwindow = NULL
	'-----------------
	' Exit if currently working
	'-----------------
	if(this.mWorking)Then
		Print "(this.mWorking = true) Exit sub"
		Exit Sub
	End If	
	this.mWorking = TRUE
	
	' Do window docking
	if(hwnd<>this.mParent)Then
		Print "process child window move"
		'Find the window to process
		child = FindChild(hwnd)
		if(child = NULL)then
			Print "Window child = NULL"
			this.mWorking = FALSE
			Exit Sub
		End If

		If (child->dockable <> 0 ) And (child->docked = 0 ) Then
		'Get window rectangles
		GetWindowRect(this.mParent, @rcParent)
		GetWindowRect(hwnd, @rcChild)
		
		'Check docking cases and setup the new window position
			if(rcChild.left > rcParent.left) And ( rcChild.left < rcParent.right )Then
				if(rcChild.top > rcParent.top) And ( rcChild.top < rcParent.bottom )Then
						child->Posrect = rcChild
						child->docked = 1
						This.ReparentChild(hwnd,this.mParent)
						This.RecalculateChildPos()
						
				End If
			End If			
		End If
	End If

	' No longer working
	this.mWorking = FALSE
End Sub
Sub DockWindow.WindowMove(hwnd As HWND )
Dim child As DockChild ptr
Dim As RECT rcParent
Dim As RECT rcChild
Dim As RECT rcNew

	'Exit if currently working
	If(this.mWorking)Then
		Print "(this.mWorking = true) Exit sub"
		Exit Sub
	End If
	
	this.mWorking = TRUE

' Do window undocking
	If(hwnd<>this.mParent)Then
		Print "process child window move"
		child = FindChild(hwnd)
		if(child = NULL)then
			Print "Window child = NULL"
			this.mWorking = FALSE
			Exit Sub
		End If
		If (child->dockable <> 0 ) And (movingwindow = hwnd) Then
				Dim p As Point
				If Getcursorpos(@p)<>0 Then
					p.x = p.x-movedesp.x 
		         p.y = p.y-movedesp.y
					SetWindowPos(hwnd, 0, p.x, p.y, 0, 0, SWP_NOZORDER Or SWP_NOSIZE)
				End If
		End If
	else
		Print "process parent window move"
	End If
	this.mWorking = false
End Sub

Post Reply