DockControl (190K)
26 Jun 2003
First Posted
Subclassing Without The Crashes
vbAccelerator - Contents of code file: MDI.frm
VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Object = "*\ADockControl.vbp"
Begin VB.MDIForm MDI
BackColor = &H8000000C&
Caption = "Mdi--Test Docking Control "
ClientHeight = 7065
ClientLeft = 1650
ClientTop = 3780
ClientWidth = 15405
LinkTopic = "MDIForm1"
NegotiateToolbars= 0 'False
ScrollBars = 0 'False
WindowState = 2 'Maximized
Begin ComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 630
Left = 0
TabIndex = 0
Top = 0
Width = 15405
_ExtentX = 27173
_ExtentY = 1111
ButtonWidth = 1270
ButtonHeight = 953
Appearance = 1
_Version = 327682
BeginProperty Buttons {0713E452-850A-101B-AFC0-4210102A8DA7}
NumButtons = 2
BeginProperty Button1 {0713F354-850A-101B-AFC0-4210102A8DA7}
Caption = "Cascade"
Key = ""
Object.Tag = ""
EndProperty
BeginProperty Button2 {0713F354-850A-101B-AFC0-4210102A8DA7}
Caption = "Tile All "
Key = ""
Object.Tag = ""
EndProperty
EndProperty
Begin RichTextLib.RichTextBox RichTextBox1
Height = 375
Left = 7680
TabIndex = 3
Top = 120
Width = 2295
_ExtentX = 4048
_ExtentY = 661
_Version = 393217
Enabled = -1 'True
AutoVerbMenu = -1 'True
TextRTF = $"MDI.frx":0000
End
Begin VB.TextBox Text1
Height = 375
Left = 4680
TabIndex = 2
Text = "Text1"
Top = 120
Width = 2655
End
Begin VB.ComboBox Combo1
Height = 315
Left = 1800
TabIndex = 1
Text = "Combo1"
Top = 120
Width = 2655
End
End
Begin DockControl.SubDock SubDock
Align = 4 'Align Right
Height = 2550
Index = 4
Left = 11130
TabIndex = 8
Top = 2565
Visible = 0 'False
Width = 4275
_ExtentX = 7541
_ExtentY = 4498
End
Begin DockControl.SubDock SubDock
Align = 3 'Align Left
Height = 2550
Index = 3
Left = 0
TabIndex = 7
Top = 2565
Visible = 0 'False
Width = 2175
_ExtentX = 3836
_ExtentY = 4498
End
Begin DockControl.SubDock SubDock
Align = 2 'Align Bottom
Height = 1575
Index = 2
Left = 0
TabIndex = 6
Top = 5115
Visible = 0 'False
Width = 15405
_ExtentX = 27173
_ExtentY = 2778
End
Begin DockControl.SubDock SubDock
Align = 1 'Align Top
Height = 1935
Index = 1
Left = 0
TabIndex = 5
Top = 630
Visible = 0 'False
Width = 15405
_ExtentX = 27173
_ExtentY = 3413
Begin DockControl.SubForm SubForm
Height = 915
Index = 1
Left = 1200
TabIndex = 9
Top = 720
Visible = 0 'False
Width = 3375
_ExtentX = 5953
_ExtentY = 1614
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
End
Begin DockControl.Service Service1
Left = 3240
Top = 2940
_ExtentX = 2196
_ExtentY = 661
End
Begin ComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 4
Top = 6690
Width = 15405
_ExtentX = 27173
_ExtentY = 661
SimpleText = ""
_Version = 327682
BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7}
NumPanels = 1
BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7}
Key = ""
Object.Tag = ""
EndProperty
EndProperty
End
Begin VB.Menu HideCommands
Caption = "Hide"
Begin VB.Menu HideContainer
Caption = "Hide SubDock"
Begin VB.Menu VbDcH
Caption = "Top"
Index = 1
End
Begin VB.Menu VbDcH
Caption = "Bottom"
Index = 2
End
Begin VB.Menu VbDcH
Caption = "Left"
Index = 3
End
Begin VB.Menu VbDcH
Caption = "Right"
Index = 4
End
End
Begin VB.Menu Hdw
Caption = "Hide SubForm"
Begin VB.Menu DkFh
Caption = "DkForms(0)"
Index = 0
End
Begin VB.Menu DkFh
Caption = "DkForms(1)"
Index = 1
End
Begin VB.Menu DkFh
Caption = "DkForms(2)"
Index = 2
End
Begin VB.Menu DkFh
Caption = "DkForms(3)"
Index = 3
End
Begin VB.Menu DkFh
Caption = "DkForms(4)"
Index = 4
End
End
End
Begin VB.Menu ShowCommands
Caption = "Show"
Begin VB.Menu ShowContainer
Caption = "Show SubDock"
Begin VB.Menu VbDcS
Caption = "Top"
Index = 1
End
Begin VB.Menu VbDcS
Caption = "Bottom"
Index = 2
End
Begin VB.Menu VbDcS
Caption = "Left"
Index = 3
End
Begin VB.Menu VbDcS
Caption = "Right"
Index = 4
End
End
Begin VB.Menu Sdw
Caption = "Show SubForm"
Begin VB.Menu DkFs
Caption = "DkForms(0)"
Index = 0
End
Begin VB.Menu DkFs
Caption = "DkForms(1)"
Index = 1
End
Begin VB.Menu DkFs
Caption = "DkForms(2)"
Index = 2
End
Begin VB.Menu DkFs
Caption = "DkForms(3)"
Index = 3
End
Begin VB.Menu DkFs
Caption = "DkForms(4)"
Index = 4
End
End
End
Begin VB.Menu Lmc
Caption = "New Client Child"
End
Begin VB.Menu TD
Caption = "Tile Docks"
Begin VB.Menu TAll
Caption = "All"
End
Begin VB.Menu TIndv
Caption = "Top"
Index = 1
End
Begin VB.Menu TIndv
Caption = "Bottom"
Index = 2
End
Begin VB.Menu TIndv
Caption = "Left"
Index = 3
End
Begin VB.Menu TIndv
Caption = "Right"
Index = 4
End
End
Begin VB.Menu Tvbr
Caption = "Show VbModal"
End
End
Attribute VB_Name = "MDI"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public Ds As Service
Private Sub DkFh_Click(Index As Integer)
DkForms(Index).SubForm.Hide
End Sub
Private Sub DkFs_Click(Index As Integer)
DkForms(Index).SubForm.Show
End Sub
Private Sub HideCommands_Click()
Dim N As Integer
For N = 0 To 4
DkFh(N).Enabled = DkForms(N).Visible
Next
For N = 1 To 4
VbDcH(N).Enabled = SubDock(N).Visible
Next
End Sub
Private Sub Lmc_Click()
Dim D As Form
Static Fcount As Integer
Fcount = Fcount + 1
Set D = New MdiChild
D.Caption = "Book" & CStr(Fcount)
End Sub
Private Sub MDIForm_Load()
ReDim DkForms(0 To 4)
Set DkForms(0) = New SubFrms
Set DkForms(1) = New WebFrm
Set DkForms(2) = New EditFrm
Set DkForms(3) = New EditFrm
Set DkForms(4) = New WebFrm
Set Ds = Service1
Ds.DockIntialize SubDock(), SubForm(), Forms
Set DkForms(0).SubForm = Ds.AttachForm(DkForms(0), DpTop)
Set DkForms(1).SubForm = Ds.AttachForm(DkForms(1), DpRight, , False, , False)
Set DkForms(2).SubForm = Ds.AttachForm(DkForms(2), DpBottom, , False, , False)
Set DkForms(3).SubForm = Ds.AttachForm(DkForms(3), DpLeft)
Set DkForms(4).SubForm = Ds.AttachForm(DkForms(4), DpLeft, True)
DkForms(0).SubForm.Caption = "SubForm - Values -DkForms(0)"
DkForms(1).SubForm.Caption = "Web Form1 -DkForms(1)"
DkForms(2).SubForm.Caption = "Edit Form1 -DkForms(2)"
DkForms(3).SubForm.Caption = "Edit Form2 -DkForms(3)"
DkForms(4).SubForm.Caption = "Web Form2 -DkForms(4)"
Dim N As Integer
For N = 0 To 4
DkForms(0).Cb.AddItem DkForms(N).SubForm.Caption
DkForms(0).Cb.ItemData(DkForms(0).Cb.NewIndex) = N
Next
DkForms(0).Cb.ListIndex = 2
Lmc_Click
Arrange 0
DkForms(1).Move 180, 635
DkForms(2).Move 380, 835
DkForms(2).SubForm.SetFocus
End Sub
Private Sub MDIForm_MouseDown(Button As Integer, Shift As Integer, X As Single,
Y As Single)
'Debug.Print ActiveForm.hwnd, FindWindowEx(DkForms(0).SubForm.OrginalWnd, 0&,
"ThunderForm", vbNullString)
'Dim H As Long
'H = FindWindowEx(DkForms(0).SubForm.OrginalWnd, 0&, "ThunderForm",
vbNullString)
'ShowWindow H, 0
'SendMessage DkForms(0).SubForm.OrginalWnd, WM_MDINEXT, H, 0&
'SendMessage hwnd, WM_MDICASCADE, 0, 1&
'MDI.Arrange 0
End Sub
Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Service1.DockTerminate
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
Dim D As Form
For Each D In Forms
Unload D
Set D = Nothing
Next
End Sub
Private Sub ShowCommands_Click()
Dim N As Integer
For N = 0 To 4
DkFs(N).Enabled = Not DkForms(N).Visible
Next
For N = 1 To 4
VbDcS(N).Enabled = Not SubDock(N).Visible
Next
End Sub
Private Sub SubForm_Activate(Index As Integer)
Dim N As Integer
For N = 0 To DkForms(0).Cb.ListCount - 1
If DkForms(0).Cb.ItemData(N) = Index - 1 Then
If DkForms(0).Cb.ListIndex = N Then
DkForms(0).UpDateLv DkForms(0).Cb.ItemData(N)
Else
DkForms(0).Cb.ListIndex = N
End If
Exit For
End If
Next
End Sub
Private Sub SubForm_BeginDrag(Index As Integer, Cancel As Boolean)
Call SubForm_Activate(Index)
End Sub
Private Sub SubForm_EndDrag(Index As Integer)
Call SubForm_Activate(Index)
End Sub
Private Sub TAll_Click()
Dim N As Integer
For N = 1 To 4
If SubDock(N).Visible Then
SubDock(N).TileSubDock
End If
Next
End Sub
Private Sub TD_Click()
Dim N As Integer
For N = 1 To 4
TIndv(N).Enabled = SubDock(N).Visible
Next
End Sub
Private Sub TIndv_Click(Index As Integer)
If SubDock(Index).Visible Then
SubDock(Index).TileSubDock
End If
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
Select Case Button.Index
Case 1
Arrange 0
Case 2
Call TAll_Click
End Select
End Sub
Private Sub Tvbr_Click()
'If GetActiveWindow = hwnd Then MsgBox "Hopefully keyboard 'Focus-Activation'
returns correctly;-)", vbApplicationModal Or vbCritical
End Sub
Private Sub VbDcH_Click(Index As Integer)
SubDock(Index).Hide
End Sub
Private Sub VbDcS_Click(Index As Integer)
SubDock(Index).Show
End Sub
