Docking windows
-
- Posts: 64
- Joined: Jul 15, 2009 12:41
Docking windows
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.
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.
-
- Posts: 64
- Joined: Jul 15, 2009 12:41
Re: Docking windows
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
And Example.bas
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
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)
Re: Docking windows
The example exits here:
Code: Select all
if(gParent = NULL) Then
Print "Error creating gParent"
Sleep
return 0
End If
-
- Posts: 64
- Joined: Jul 15, 2009 12:41
Re: Docking windows
I compile in freebasic 1.0.5 and with windows 10 OS. What is your OS and fb version?
Re: Docking windows
Win7-64. Is there something like WinErr$() in FB?
If I put everywhere @ in front of "DOCKINGWINDOW", CreateWindowEx works, though.
If I put everywhere @ in front of "DOCKINGWINDOW", CreateWindowEx works, though.
-
- Posts: 64
- Joined: Jul 15, 2009 12:41
Re: Docking windows
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)
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.
Re: Docking windows
FreeBASIC Compiler - Version 1.05.0 (01-31-2016), built for win32 (32bit)
Re: Docking windows
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.
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.
-
- Posts: 64
- Joined: Jul 15, 2009 12:41
Re: Docking windows
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
DockWindow1.bas
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)
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