vbAccelerator - Contents of code file: Service.ctl
VERSION 5.00
Begin VB.UserControl Service
CanGetFocus = 0 'False
ClientHeight = 3600
ClientLeft = 0
ClientTop = 0
ClientWidth = 4800
ClipControls = 0 'False
InvisibleAtRuntime= -1 'True
ScaleHeight = 3600
ScaleWidth = 4800
Begin VB.Image HCursor
Height = 480
Left = 720
Picture = "Service.ctx":0000
Top = 2040
Visible = 0 'False
Width = 480
End
Begin VB.Image VCursor
Height = 480
Left = 120
Picture = "Service.ctx":0152
Top = 2040
Visible = 0 'False
Width = 480
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "VbDockService"
Height = 195
Left = 0
TabIndex = 0
Top = 0
Width = 1125
End
End
Attribute VB_Name = "Service"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Implements IWindowsHook
Implements ISubclass
Private m_emr As EMsgResponse
Public Enum DockPositions
DpTop = &H1
DpBottom = &H2
DpLeft = &H3
DpRight = &H4
End Enum
Private m_ContainersSet As Boolean
Private ChildHwnds As New Collection
Private tmp_MdiActive As Long
Private m_AppForms As Object
Private m_ClientTopHwnd As Long
Private MdiActiveControlHwnd As Long
Private UseMdiActiveControl As Boolean
Private Const m_def_MinWidthChildForm = 156&
Private Const m_def_MinHeightChildForm = 26&
Dim m_MinWidthChildForm As Long
Dim m_MinHeightChildForm As Long
Private Function GetCaptionFont() As Boolean
Dim tbfm As NONCLIENTMETRICS
Dim tblf As LOGFONT
If (m_CapFnt <> 0) Then
DeleteObject m_CapFnt
m_CapFnt = 0
End If
tbfm.cbSize = LenB(tbfm) + LenB(Chr(0))
Call SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, tbfm, 0)
CopyMemory tblf, tbfm.lfSMCaptionFont, LenB(tbfm.lfSMCaptionFont)
m_CapFnt = CreateFontIndirect(tblf)
GetCaptionFont = (m_CapFnt <> 0)
End Function
Private Sub ActivateMdiClientChild(ByVal MdiChildHwnd As Long)
If MdiChildHwnd <> 0 Then
SendMessage m_MdiChwnd, WM_MDIACTIVATE, MdiChildHwnd, 0
m_ClientTopHwnd = MdiChildHwnd
End If
If m_ActiveSubIndx <> 0 Then
SendMessage m_SubForm(m_ActiveSubIndx).hwnd, SF_ACTIVATE, 0, 0
End If
If m_ActiveToolIndx <> 0 Then
SendMessage m_SubForm(m_ActiveToolIndx).hwnd, SF_ACTIVATE, 0, 0
End If
End Sub
Public Property Get ActiveSubForm() As Object
If m_ActiveSubIndx = 0 Then
Set ActiveSubForm = Nothing
Else
Set ActiveSubForm = m_SubForm(m_ActiveSubIndx)
End If
End Property
Public Sub DockIntialize(ByVal DockObj As Variant, ByVal WinObj As Variant,
ByVal AppFormsCol As Object)
Dim Msg As String
Dim L As Long
Dim N As Integer
On Error GoTo SetError:
If m_ContainersSet Then
Beep
MsgBox "Docks have already been Intialized!", vbOKOnly
Exit Sub
End If
Set DockService = Me
Set m_AppForms = AppFormsCol
GetCaptionFont
For N = vbAlignTop To vbAlignRight
DockObj(N).SubClassContainer
DockObj(N).Visible = False
Next
Set m_SubDock = DockObj
Set m_SubForm = WinObj
m_SubForm(1).Visible = False
m_SubForm(1).IsHidden = True
'Don't know why but if we don't do this
'mouse message can be blocked from
'SubDock depending on it's location in it's container
'Set m_SubForm(1).Container = Me
m_SubForm(1).Move 0, 0, 0, 0
m_ContainersSet = True
Exit Sub
SetError:
Msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description & Chr(13) & "Dock Object
Count must equal 1 with index of 1"
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
Err.Clear
End Sub
Public Property Get ClientActiveForm() As Object
Dim D As Form
If ChildHwnds.Count = 0 Or m_ClientTopHwnd = 0 Then
Set ClientActiveForm = Nothing
m_ClientTopHwnd = 0
Else
For Each D In m_AppForms
If m_ClientTopHwnd = D.hwnd Then
Set ClientActiveForm = D
Exit For
End If
Next
End If
End Property
Public Function AttachForm(ByVal Frm As Object, ByVal DPos As DockPositions,
Optional LastSubForm As Boolean = False, Optional IsDocked As Boolean = True,
Optional SetActive As Boolean = False, Optional Show As Boolean = True) As
Object
Attribute AttachForm.VB_Description = "Form or Control Container to be Docked"
Static DockWinCount As Integer
Static ShowValue() As Boolean
Static ActivateIndex As Integer
Dim ChildTopFrm As Long
If Not m_ContainersSet Then
Beep
MsgBox "A call to SetContainers is required for this function to work!",
vbOKOnly
Exit Function
ElseIf SubFormsLoaded Then
Beep
MsgBox "All Subforms have already been loaded!", vbOKOnly
Exit Function
End If
DockWinCount = DockWinCount + 1
ReDim Preserve ShowValue(1 To DockWinCount)
ShowValue(DockWinCount) = Show
If DockWinCount > 1 Then Load m_SubForm(DockWinCount)
m_SubForm(DockWinCount).Docked = IsDocked
m_SubForm(DockWinCount).Visible = Show
m_SubForm(DockWinCount).IsHidden = Show
m_SubForm(DockWinCount).FrmHwnd = Frm.hwnd
Set m_SubForm(DockWinCount).Container = m_SubDock(DPos)
m_SubDock(DPos).DockCol.Add m_SubForm(DockWinCount)
m_SubForm(DockWinCount).Pos = m_SubDock(DPos).DockCol.Count - 1
m_SubForm(DockWinCount).OrgPos = m_SubForm(DockWinCount).Pos
If SetActive Then ActivateIndex = DockWinCount
m_Form.Add Frm
If IsDocked Then
Frm.Show , UserControl.Parent
SetDockWindowStyle Frm.hwnd, m_SubForm(DockWinCount).hwnd
Else
SetToolWindowStyle Frm.hwnd
Frm.Show , UserControl.Parent
End If
Set AttachForm = m_SubForm(DockWinCount)
If Not LastSubForm Then
Exit Function
Else
Set AppObj = Extender.Parent
Set CursorV = VCursor.Picture
Set CursorH = HCursor.Picture
m_MdiChwnd = FindWindowEx(AppObj.hwnd, 0&, "MDIClient", vbNullString)
Dim N As Integer
For N = 1 To DockWinCount
m_SubForm(N).SubClassContainer
Next
ChildTopFrm = FindWindowEx(m_MdiChwnd, 0&, "ThunderForm", vbNullString)
If ChildTopFrm <> 0 Then
SendMessage ChildTopFrm, WM_NCACTIVATE, 1, 0
SendMessage ChildTopFrm, WM_ACTIVATE, 1, 0
End If
AttachMessage Me, m_MdiChwnd, WM_MDIGETACTIVE
AttachMessage Me, m_MdiChwnd, WM_MDIACTIVATE
AttachMessage Me, AppObj.hwnd, WM_NCACTIVATE
AttachMessage Me, AppObj.hwnd, WM_ACTIVATE
AttachMessage Me, AppObj.hwnd, WM_ACTIVATEAPP
AttachMessage Me, AppObj.hwnd, WM_SIZE
AttachMessage Me, AppObj.hwnd, WM_GETMINMAXINFO
AttachMessage Me, AppObj.hwnd, WM_MOUSEACTIVATE
AttachMessage Me, AppObj.hwnd, WM_ENABLE
SubClassChildren 0, True
SubFormsLoaded = True
For N = 1 To DockWinCount
If Not ShowValue(N) Then
m_SubForm(N).IsHidden = True
ElseIf ShowValue(N) Then
m_SubForm(N).IsHidden = False
m_SubForm(N).Visible = True
End If
Next
For N = 1 To DockWinCount
If ShowValue(N) And m_SubDock(m_SubForm(N).DockPos).Visible = False Then
m_SubDock(m_SubForm(N).DockPos).Visible = True
End If
Next
For N = 1 To 4
m_SubDock(N).TileSubDock
Next
If ActivateIndex > 0 Then
SendMessage m_SubForm(ActivateIndex).hwnd, SF_ACTIVATE, 1, 0
End If
ReDim ShowValue(0)
End If
End Function
Public Sub DockTerminate()
Attribute DockTerminate.VB_Description = "Terminates VbDockService... Must be
called before Docked Objects are out of scope...As in MdiForm Query Unload"
Dim N As Integer
RemoveHook Me, WH_KEYBOARD
If (m_CapFnt <> 0) Then
DeleteObject m_CapFnt
m_CapFnt = 0
End If
If m_MdiChwnd <> 0 Then
UnSubClassChildren 0, True
DetachMessage Me, m_MdiChwnd, WM_MDIACTIVATE
DetachMessage Me, m_MdiChwnd, WM_MDIGETACTIVE
DetachMessage Me, AppObj.hwnd, WM_NCACTIVATE
DetachMessage Me, AppObj.hwnd, WM_ACTIVATE
DetachMessage Me, AppObj.hwnd, WM_ACTIVATEAPP
DetachMessage Me, AppObj.hwnd, WM_SIZE
DetachMessage Me, AppObj.hwnd, WM_GETMINMAXINFO
DetachMessage Me, AppObj.hwnd, WM_MOUSEACTIVATE
DetachMessage Me, AppObj.hwnd, WM_ENABLE
End If
For N = 1 To 4
m_SubDock(N).UnSubClassContainer
Next
For N = 1 To m_SubForm.ubound
If m_SubForm(N).FrmHwnd <> 0 Then
m_SubForm(N).UnSubClassContainer
m_SubForm(N).Visible = False
ShowWindow m_SubForm(N).FrmHwnd, 0
SetParent m_SubForm(N).FrmHwnd, m_MdiChwnd
m_SubForm(N).FrmHwnd = 0
End If
Next
m_MdiChwnd = 0
Set m_SubDock = Nothing
Set m_SubForm = Nothing
Set m_Form = Nothing
Set CursorV = Nothing
Set CursorH = Nothing
Set DockService = Nothing
Set m_AppForms = Nothing
End Sub
Private Sub RestoreActiveState()
On Local Error Resume Next
m_AppInactive = False
m_MouseActivated = False
If m_ActiveToolIndx <> 0 Then
m_SubForm(m_ActiveToolIndx).SetFocus
ElseIf m_ActiveSubIndx <> 0 Then
m_SubForm(m_ActiveSubIndx).SetFocus
Else
CallOldWindowProc tmp_MdiActive, WM_NCACTIVATE, 1, 0
End If
If Not AppObj.ActiveControl Is Nothing And UseMdiActiveControl Then
AppObj.ActiveControl.SetFocus
End If
m_MdiActive = tmp_MdiActive
tmp_MdiActive = 0
If m_MdiActive <> 0 And Not UseMdiActiveControl Then
SendMessage m_MdiChwnd, WM_MDIACTIVATE, m_MdiActive, 0
End If
UseMdiActiveControl = False
If Err.Number <> 0 Then Err.Clear
End Sub
Private Sub SaveActiveState()
On Local Error Resume Next
If Not AppObj.ActiveControl Is Nothing Then
If GetFocus = AppObj.ActiveControl.hwnd Or
IsChild(AppObj.ActiveControl.hwnd, GetFocus) = 1 Then
MdiActiveControlHwnd = AppObj.ActiveControl.hwnd
UseMdiActiveControl = True
End If
End If
m_AppInactive = True
SendMessage AppObj.hwnd, WM_NCACTIVATE, 0, 0
If m_ActiveToolIndx <> 0 Then
SendMessage m_Form(m_ActiveToolIndx).hwnd, WM_NCACTIVATE, 0, 0
SendMessage m_Form(m_ActiveToolIndx).hwnd, WM_NCPAINT, 0, 0
ElseIf m_ActiveSubIndx <> 0 Then
SendMessage m_SubForm(m_ActiveSubIndx).hwnd, SF_NCPAINT, 0, 0
Else
CallOldWindowProc m_MdiActive, WM_NCACTIVATE, 0, 0
End If
tmp_MdiActive = m_MdiActive
m_MdiActive = 0
If Err.Number <> 0 Then Err.Clear
End Sub
Private Property Let ISubclass_MsgResponse(ByVal RHS As SSubTimer.EMsgResponse)
End Property
Private Property Get ISubclass_MsgResponse() As SSubTimer.EMsgResponse
If CurrentMessage = WM_SIZE Or CurrentMessage = WM_NCDESTROY Then
ISubclass_MsgResponse = emrPostProcess
ElseIf CurrentMessage = WM_NCACTIVATE Then
ISubclass_MsgResponse = emrConsume
Else
ISubclass_MsgResponse = emrPreprocess
End If
End Property
Private Function ISubclass_WindowProc(ByVal hwnd As Long, ByVal iMsg As Long,
ByVal wParam As Long, ByVal lParam As Long) As Long
Dim Ms As POINTAPI
Dim ChHwnd As Long
Dim FHwnd As Long
Dim Wps As WINDOWPOS
Dim MinMax As MINMAXINFO
Dim N As Integer
On Local Error Resume Next
Select Case hwnd
Case m_MdiChwnd
Select Case iMsg
Case WM_MDIGETACTIVE
If m_MdiActive <> 0 And tmp_MdiActive = 0 Then
ISubclass_WindowProc = m_MdiActive
Else
ISubclass_WindowProc = CallOldWindowProc(hwnd, iMsg, wParam,
lParam)
End If
Case WM_MDIACTIVATE
SubClassChildren wParam
SendMessage wParam, WM_MDIACTIVATE, m_MdiActive, wParam
m_MdiActive = wParam
Case Else
End Select
Case Else
Select Case iMsg
Case WM_NCACTIVATE
If wParam = 0 And Not m_AppInactive And m_ModalHwnd = 0 Then
Dim AWs As Long
AWs = GetWindowLong(AppObj.hwnd, GWL_STYLE)
Call SetWindowLong(AppObj.hwnd, GWL_STYLE, (AWs Xor WS_VISIBLE))
If GetFocus = AppObj.ActiveControl.hwnd Or
IsChild(AppObj.ActiveControl.hwnd, GetFocus) = 1 Then
MdiActiveControlHwnd = AppObj.ActiveControl.hwnd
UseMdiActiveControl = True
End If
ISubclass_WindowProc = CallOldWindowProc(hwnd, iMsg, 1, lParam)
Call SetWindowLong(AppObj.hwnd, GWL_STYLE, (AWs Or WS_VISIBLE))
SetRedraw AppObj.hwnd, True
ElseIf wParam = 1 And m_ModalHwnd <> 0 Then
ISubclass_WindowProc = 0
DcModule1.SetFocus m_ModalHwnd
Else
ISubclass_WindowProc = CallOldWindowProc(hwnd, iMsg, wParam,
lParam)
End If
Case WM_ENABLE
For N = vbAlignTop To vbAlignRight
If wParam = 0 Then
m_SubDock(N).AutoRefresh = True
Else
m_SubDock(N).AutoRefresh = False
End If
Next
If m_ActiveToolIndx = 0 Then
If Not m_AppInactive And wParam = 0 Then
SaveActiveState
SendMessage AppObj.hwnd, WM_NCACTIVATE, 0, 0
ElseIf m_AppInactive And wParam = 1 Then
PostMessage AppObj.hwnd, WM_ACTIVATEAPP, 1, 0
End If
End If
Case WM_GETMINMAXINFO
CopyMemory MinMax, ByVal lParam, LenB(MinMax)
If hwnd = AppObj.hwnd Then
MinMax.ptMinTrackSize.x = Screen.Width \ 60 'Aprox 1/16 of screen
MinMax.ptMinTrackSize.y = Screen.Height \ 60
ElseIf m_MinWidthChildForm > 0 And m_MinHeightChildForm > 0 Then
MinMax.ptMinTrackSize.x = m_MinWidthChildForm
MinMax.ptMinTrackSize.y = m_MinHeightChildForm
End If
CopyMemory ByVal lParam, MinMax, LenB(MinMax)
Case WM_SIZE
If Not m_AppInactive And wParam <> 1 Then
Call AutoSizeP
ElseIf Not m_AppInactive And wParam = 1 Then
Call SaveActiveState
ElseIf m_AppInactive And wParam <> 1 Then
PostMessage AppObj.hwnd, WM_ACTIVATEAPP, 1, 0
End If
Case WM_NCDESTROY
UnSubClassChildren hwnd
If GetFocus = m_MdiChwnd Then
If Not AppObj.ActiveControl Is Nothing Then
m_ClientTopHwnd = 0
PostMessage AppObj.ActiveControl.hwnd, WM_SETFOCUS, 0, 0
If Err.Number <> 0 Then Err.Clear
m_MdiActive = 0
End If
End If
Case WM_MOUSEACTIVATE
ISubclass_WindowProc = 1
Call GetCursorPos(Ms)
ChHwnd = WindowFromPoint(Ms.x, Ms.y)
If m_AppInactive Then m_MouseActivated = True
If IsChild(m_MdiChwnd, hwnd) = 1 Then
AppObj.SetFocus
ActivateMdiClientChild hwnd
MdiActiveControlHwnd = 0
Exit Function
ElseIf IsChild(m_MdiChwnd, ChHwnd) = 1 Then
If m_ActiveToolIndx <> 0 Then AppObj.SetFocus
MdiActiveControlHwnd = 0
Exit Function
End If
If m_ActiveToolIndx <> 0 Then
SendMessage m_SubForm(m_ActiveToolIndx).hwnd, SF_ACTIVATE, 0,
0
AppObj.SetFocus
End If
For N = vbAlignTop To vbAlignRight
If (IsChild(m_SubDock(N).hwnd, ChHwnd) = 1) Then
AppObj.SetFocus
If m_ActiveSubIndx <> 0 Then
SendMessage m_SubForm(m_ActiveSubIndx).hwnd, SF_ACTIVATE,
0, 0
End If
MdiActiveControlHwnd = 0
m_AppInactive = False
tmp_MdiActive = 0
Exit Function
ElseIf (m_SubDock(N).hwnd = ChHwnd) Then
If m_ActiveSubIndx <> 0 Then
PostMessage m_SubForm(m_ActiveSubIndx).hwnd, SF_ACTIVATE,
1, 0
End If
If m_ActiveSubIndx <> 0 Then
Exit Function
Else
If Not ClientActiveForm Is Nothing And MdiActiveControlHwnd
= 0 Then
DcModule1.SetFocus ClientActiveForm.hwnd
m_MdiActive = ClientActiveForm.hwnd
ElseIf MdiActiveControlHwnd <> 0 Then
Call EnumChildWindows(AppObj.hwnd, AddressOf
SetContainerFocus, MdiActiveControlHwnd)
DcModule1.SetFocus MdiActiveControlHwnd
m_MdiActive = 0
ElseIf Not AppObj.ActiveControl Is Nothing Then
PostMessage AppObj.ActiveControl.hwnd, WM_SETFOCUS,
GetFocus, 0
If Err.Number <> 0 Then Err.Clear
m_MdiActive = 0
End If
End If
End If
Next
If m_AppInactive Or m_ActiveSubIndx <> 0 Then AppObj.SetFocus
If m_ActiveSubIndx <> 0 And LoWord(lParam) <> HTCLIENT Or
m_ActiveSubIndx <> 0 And ChHwnd = m_MdiChwnd Then
SendMessage m_SubForm(m_ActiveSubIndx).hwnd, SF_ACTIVATE, 1, 0
Else
If m_ActiveSubIndx <> 0 Then
SendMessage m_SubForm(m_ActiveSubIndx).hwnd, SF_ACTIVATE, 0,
0
End If
If LoWord(lParam) = HTCLIENT Then
If Not ClientActiveForm Is Nothing Then
Call EnumChildWindows(AppObj.hwnd, AddressOf
SetContainerFocus, ChHwnd)
If ChHwnd = m_MdiChwnd Then DcModule1.SetFocus
ClientActiveForm.hwnd
m_MdiActive = ClientActiveForm.hwnd
End If
End If
If Not ClientActiveForm Is Nothing And MdiActiveControlHwnd =
0 Then
If (LoWord(lParam) <> HTCLIENT) Then
DcModule1.SetFocus ClientActiveForm.hwnd
End If
m_MdiActive = ClientActiveForm.hwnd
ElseIf MdiActiveControlHwnd <> 0 Then
If LoWord(lParam) <> HTCLIENT Then
Call EnumChildWindows(AppObj.hwnd, AddressOf
SetContainerFocus, MdiActiveControlHwnd)
DcModule1.SetFocus MdiActiveControlHwnd
Else
m_MdiActive = 0
End If
Else
m_MdiActive = 0
End If
End If
Case WM_SETFOCUS
ActivateMdiClientChild hwnd
Case WM_ACTIVATEAPP
If IsWindowEnabled(AppObj.hwnd) = 0 Or AppObj.WindowState = 1
Then
Exit Function
ElseIf (wParam = 0) And m_MdiActive <> 0 And tmp_MdiActive = 0
And Not m_AppInactive Then
Call SaveActiveState
ElseIf (wParam = 1) And Not m_MouseActivated And GetActiveWindow
= AppObj.hwnd And m_AppInactive Then
Call RestoreActiveState
ElseIf (wParam = 1) And m_MouseActivated Then
SendMessage hwnd, WM_NCACTIVATE, 1, 0
m_AppInactive = False
m_MouseActivated = False
tmp_MdiActive = 0
End If
Case WM_ACTIVATE
If (LoWord(wParam) = 0) And (lParam <> 0) And HiWord(wParam) <>
32 Then
If IsChild(m_MdiChwnd, GetFocus) = 0 And IsChild(AppObj.hwnd,
GetFocus) = 1 And IsWindowEnabled(AppObj.hwnd) = 1 Then
MdiActiveControlHwnd = GetFocus
ElseIf (LoWord(wParam) = 0) And (lParam <> 0) And m_ModalHwnd =
0 And IsWindowEnabled(AppObj.hwnd) = 0 Then
m_ModalHwnd = lParam
End If
End If
Case Else
End Select
End Select
End Function
Private Sub UnSubClassChildren(ByVal cHwnd As Long, Optional All As Boolean =
False)
Dim N As Integer
If All Then
For N = 1 To ChildHwnds.Count
DetachMessage Me, ChildHwnds(N), WM_SETFOCUS
DetachMessage Me, ChildHwnds(N), WM_MOUSEACTIVATE
DetachMessage Me, ChildHwnds(N), WM_NCDESTROY
DetachMessage Me, ChildHwnds(N), WM_GETMINMAXINFO
Next
While ChildHwnds.Count > 0
ChildHwnds.Remove 1
Wend
Else
For N = 1 To ChildHwnds.Count
If ChildHwnds(N) = cHwnd Then
DetachMessage Me, cHwnd, WM_SETFOCUS
DetachMessage Me, cHwnd, WM_MOUSEACTIVATE
DetachMessage Me, cHwnd, WM_NCDESTROY
DetachMessage Me, cHwnd, WM_GETMINMAXINFO
ChildHwnds.Remove N
Exit Sub
End If
Next
End If
End Sub
Private Sub SubClassChildren(cHwnd As Long, Optional All As Boolean = False)
Dim ClassName As String * 12
Dim Currwnd As Long
Dim NewRect As RECT
Dim lp As POINTAPI
If All Then
Currwnd = GetWindow(m_MdiChwnd, GW_CHILD)
While Currwnd <> 0
Call GetClassName(Currwnd, ClassName, 12&)
If Left(ClassName, 11) = "ThunderForm" Then
ChildHwnds.Add Currwnd, CStr(Currwnd)
AttachMessage Me, Currwnd, WM_SETFOCUS
AttachMessage Me, Currwnd, WM_MOUSEACTIVATE
AttachMessage Me, Currwnd, WM_NCDESTROY
AttachMessage Me, Currwnd, WM_GETMINMAXINFO
GetWindowRect Currwnd, NewRect
lp.x = NewRect.Left: lp.y = NewRect.Top
ScreenToClient m_MdiChwnd, lp
MoveWindow Currwnd, lp.x, lp.y, NewRect.Right - NewRect.Left,
NewRect.Bottom - NewRect.Top, 1
End If
Currwnd = GetWindow(Currwnd, GW_HWNDNEXT)
Wend
Else
Dim N As Integer
For N = 1 To m_Form.Count
If m_Form(N).hwnd = cHwnd Then
Exit Sub
End If
Next
For N = 1 To ChildHwnds.Count
If ChildHwnds(N) = cHwnd Then
Exit Sub
End If
Next
ChildHwnds.Add cHwnd, CStr(cHwnd)
AttachMessage Me, cHwnd, WM_SETFOCUS
AttachMessage Me, cHwnd, WM_MOUSEACTIVATE
AttachMessage Me, cHwnd, WM_NCDESTROY
AttachMessage Me, cHwnd, WM_GETMINMAXINFO
GetWindowRect cHwnd, NewRect
lp.x = NewRect.Left: lp.y = NewRect.Top
ScreenToClient m_MdiChwnd, lp
MoveWindow cHwnd, lp.x, lp.y, NewRect.Right - NewRect.Left, NewRect.Bottom
- NewRect.Top, 1
ActivateMdiClientChild cHwnd
End If
End Sub
Private Function IWindowsHook_HookProc(ByVal eType As
vbalWinHook.EHTHookTypeConstants, ByVal nCode As Long, ByVal wParam As Long,
ByVal lParam As Long, bConsume As Boolean) As Long
If KeyboardlParam(lParam).KeyDown Then
bConsume = True
ElseIf KeyboardlParam(lParam).KeyUp Then
bConsume = True
ElseIf KeyboardlParam(lParam).Alt Then
bConsume = True
End If
End Function
Private Sub UserControl_Resize()
If Width <> 1250 Then Width = 1250
If Height <> 375 Then Height = 375
End Sub
Public Property Get MinWidthChildForm() As Long
MinWidthChildForm = m_MinWidthChildForm
End Property
Public Property Let MinWidthChildForm(ByVal New_MinWidthChildForm As Long)
m_MinWidthChildForm = New_MinWidthChildForm
PropertyChanged "MinWidthChildForm"
End Property
Public Property Get MinHeightChildForm() As Long
MinHeightChildForm = m_MinHeightChildForm
End Property
Public Property Let MinHeightChildForm(ByVal New_MinHeightChildForm As Long)
m_MinHeightChildForm = New_MinHeightChildForm
PropertyChanged "MinHeightChildForm"
End Property
Private Sub UserControl_InitProperties()
m_MinWidthChildForm = m_def_MinWidthChildForm
m_MinHeightChildForm = m_def_MinHeightChildForm
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
m_MinWidthChildForm = PropBag.ReadProperty("MinWidthChildForm",
m_def_MinWidthChildForm)
m_MinHeightChildForm = PropBag.ReadProperty("MinHeightChildForm",
m_def_MinHeightChildForm)
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("MinWidthChildForm", m_MinWidthChildForm,
m_def_MinWidthChildForm)
Call PropBag.WriteProperty("MinHeightChildForm", m_MinHeightChildForm,
m_def_MinHeightChildForm)
End Sub
|
|