Docking windows

Windows specific questions.
geminis4941
Posts: 59
Joined: Jul 15, 2009 12:41

Docking windows

Postby geminis4941 » Jan 11, 2018 21:53

User Stueber wrote a post about Qt with freebasic and there was a sample of docking windows un Qt.
Post https://www.freebasic.net/forum/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: 59
Joined: Jul 15, 2009 12:41

Re: Docking windows

Postby geminis4941 » Jan 12, 2018 8:23

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: 377
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Docking windows

Postby jj2007 » Jan 12, 2018 11:07

The example exits here:

Code: Select all

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

Re: Docking windows

Postby geminis4941 » Jan 12, 2018 12:45

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

Re: Docking windows

Postby jj2007 » Jan 12, 2018 13:18

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

Re: Docking windows

Postby geminis4941 » Jan 12, 2018 13:35

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: 377
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Docking windows

Postby jj2007 » Jan 12, 2018 13:40

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

Re: Docking windows

Postby dodicat » Jan 12, 2018 14:43

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: 59
Joined: Jul 15, 2009 12:41

Re: Docking windows

Postby geminis4941 » Jan 15, 2018 9:37

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


Return to “Windows”

Who is online

Users browsing this forum: No registered users and 1 guest