vbAccelerator - Contents of code file: mfrmTest.frm

VERSION 5.00
Object = "{8245A918-4CF7-11D2-8E21-10B404C10000}#8.1#0"; "vbalIml.ocx"
Begin VB.MDIForm mfrmMDITest 
   BackColor       =   &H8000000C&
   Caption         =   "Test PopMenu Control in MDI Form"
   ClientHeight    =   5040
   ClientLeft      =   4920
   ClientTop       =   3150
   ClientWidth     =   6870
   Icon            =   "mfrmTest.frx":0000
   LinkTopic       =   "MDIForm1"
   Begin VB.PictureBox picStatus 
      Align           =   2  'Align Bottom
      BorderStyle     =   0  'None
      Height          =   315
      Left            =   0
      ScaleHeight     =   315
      ScaleWidth      =   6870
      TabIndex        =   0
      Top             =   4725
      Width           =   6870
      Begin VB.Label lblStatus 
         Height          =   255
         Left            =   60
         TabIndex        =   1
         Top             =   60
         Width           =   6795
      End
   End
   Begin vbalIml.vbalImageList ilsIcons 
      Left            =   120
      Top             =   60
      _ExtentX        =   953
      _ExtentY        =   953
      ColourDepth     =   4
      Size            =   19740
      Images          =   "mfrmTest.frx":030A
      KeyCount        =   21
      Keys            =   $"mfrmTest.frx":5046
   End
   Begin VB.Menu mnuFileTOP 
      Caption         =   "&File"
      Begin VB.Menu mnuFile 
         Caption         =   "&New..."
         Index           =   0
         Shortcut        =   ^N
      End
      Begin VB.Menu mnuFile 
         Caption         =   "-"
         Index           =   1
      End
      Begin VB.Menu mnuFile 
         Caption         =   "&Open..."
         Index           =   2
         Shortcut        =   ^O
      End
      Begin VB.Menu mnuFile 
         Caption         =   "&Save..."
         Index           =   3
         Shortcut        =   ^S
      End
      Begin VB.Menu mnuFile 
         Caption         =   "Save &As"
         Index           =   4
      End
      Begin VB.Menu mnuFile 
         Caption         =   "-"
         Index           =   5
      End
      Begin VB.Menu mnuFile 
         Caption         =   "&Print"
         Index           =   6
         Shortcut        =   ^P
      End
      Begin VB.Menu mnuFile 
         Caption         =   "Print Pre&view"
         Index           =   7
      End
      Begin VB.Menu mnuFile 
         Caption         =   "-"
         Index           =   8
      End
      Begin VB.Menu mnuFile 
         Caption         =   "P&roperties"
         Index           =   9
      End
      Begin VB.Menu mnuFile 
         Caption         =   "-"
         Index           =   10
      End
      Begin VB.Menu mnuFile 
         Caption         =   "E&xit"
         Index           =   11
      End
   End
   Begin VB.Menu mnuWindowTOP 
      Caption         =   "&Window"
      WindowList      =   -1  'True
      Begin VB.Menu mnuWindow 
         Caption         =   "&Cascade"
         Index           =   0
      End
      Begin VB.Menu mnuWindow 
         Caption         =   "Tile &Horizontally"
         Index           =   1
      End
      Begin VB.Menu mnuWindow 
         Caption         =   "Tile &Vertically"
         Index           =   2
      End
      Begin VB.Menu mnuWindow 
         Caption         =   "Close &All"
         Index           =   3
      End
      Begin VB.Menu mnuWindow 
         Caption         =   "-"
         Index           =   4
      End
      Begin VB.Menu mnuWindow 
         Caption         =   "&Next Window"
         Index           =   5
      End
      Begin VB.Menu mnuWindow 
         Caption         =   "&Previous Window"
         Index           =   6
      End
   End
   Begin VB.Menu mnuHelpTOP 
      Caption         =   "&Help"
      Begin VB.Menu mnuHelp 
         Caption         =   "&Contents..."
         Index           =   0
         Shortcut        =   {F1}
      End
      Begin VB.Menu mnuHelp 
         Caption         =   "-"
         Index           =   1
      End
      Begin VB.Menu mnuHelp 
         Caption         =   "&About..."
         Index           =   2
      End
   End
End
Attribute VB_Name = "mfrmMDITest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private cIM As New cIconMenu

Private m_lAboutId As Long
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA"
 (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As
 Long) As Long
Private Const WM_MDINEXT = &H224
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal
 hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As
 String) As Long

Private Function GetMDIClienthWnd() As Long
   GetMDIClienthWnd = FindWindowEx(Me.hwnd, 0, "MDIClient", vbNullString)
End Function

Private Sub ctlPopMenu_InitPopupMenu(ParentItemNumber As Long)
'Dim lIcon As Long
'Dim i As Long
'Dim sKey As String
'Dim iCount As Long
'Dim bCheck As Boolean
'Dim bFIrst As Boolean
'Dim iWInCOunt As Long
'Dim sCap As String
'
'    If (ctlPopMenu.MenuKey(ParentItemNumber) = "mnuWindowTOP") Then
'         build a window menu:
'        With ctlPopMenu
'            .ClearSubMenusOfItem ParentItemNumber
'
'            lIcon = ilsIcons.ListImages("CASCADEH").Index - 1
'            .AddItem "&Tile", "winTILE", , -8001, ParentItemNumber, lIcon,
 False, True
'            lIcon = ilsIcons.ListImages("CASCADE").Index - 1
'            .AddItem "&Cascade", "winCASCADE", , -8002, ParentItemNumber,
 lIcon, False, True
'            lIcon = ilsIcons.ListImages("MAXIMISE").Index - 1
'            .AddItem "Maximise &All", "winMAXIMISE", , -8003,
 ParentItemNumber, lIcon, False, True
'            lIcon = ilsIcons.ListImages("MINIMISE").Index - 1
'            .AddItem "Mini&mise All", "winMINIMISE", , -8004,
 ParentItemNumber, lIcon, False, True
'            For i = 0 To Forms.Count - 1
'               If Not (Forms(i) Is Me) Then
'                  If (Forms(i).Visible And Forms(i).MDIChild) Then
'                     iCount = iCount + 1
'                  End If
'               End If
'            Next i
'            .AddItem "-", , , -8005, ParentItemNumber
'            lIcon = ilsIcons.ListImages("NEXTWIN").Index - 1
'            .AddItem "Ne&xt" & vbTab & "Ctrl-F6", "winNEXT", , -8006,
 ParentItemNumber, lIcon, False, (iCount > 1)
'            lIcon = ilsIcons.ListImages("PREVWIN").Index - 1
'            .AddItem "Pre&vious" & vbTab & "Shift-Ctrl-F6", "winPREVIOUS", ,
 -8007, ParentItemNumber, lIcon, False, (iCount > 1)
'
'            bFIrst = True
'            For i = 0 To Forms.Count - 1
'               If Not (Forms(i) Is Me) Then
'                  If (Forms(i).Visible) And (Forms(i).MDIChild) Then
'                     If (Forms(i) Is Me.ActiveForm) Then
'                        bCheck = True
'                     Else
'                        bCheck = False
'                     End If
'                     sKey = Forms(i).Name
'                     On Error Resume Next
'                     lIcon = ilsIcons.ListImages(sKey).Index - 1
'                     If (Err.Number <> 0) Then
'                        Err.Clear
'                        ilsIcons.ListImages.Add , Forms(i).Name, Forms(i).Icon
'                        lIcon = ilsIcons.ListImages(Forms(i).Name).Index - 1
'                     End If
'                     If (bFIrst) Then
'                        .AddItem "-", , , -8008, ParentItemNumber
'                        bFIrst = False
'                     End If
'                     iWInCOunt = iWInCOunt + 1
'                     sCap = GetCaption(Forms(i).Caption)
'                     .AddItem "&" & CStr(iWInCOunt) & " )  " & sCap,
 "winFORM:" & (i), , (-8009 - i), ParentItemNumber, lIcon, bCheck, True
'                  End If
'               End If
'            Next i
'      End With
'    End If
End Sub

Private Sub ctlPopMenu_ItemHighlight(ItemNumber As Long, bEnabled As Boolean,
 bSeparator As Boolean)
'   If Not (bSeparator) Then
'      lblStatus.Caption = "Highlighted " & ctlPopMenu.Caption(ItemNumber)
'   End If
End Sub

Private Sub ctlPopMenu_MenuExit()
   lblStatus.Caption = ""
End Sub

Private Sub ctlPopMenu_SystemMenuClick(ItemNumber As Long)
    If (ItemNumber = m_lAboutId) Then
        MsgBox "vbAccelerator PopMenu component MDI demonstration.",
         vbInformation
    End If
End Sub

Private Sub MDIForm_Load()
Dim l As Long
Dim lIndex As Long
Dim lC As Long
   
   With cIM
      .attach Me.hwnd
      .ImageList = ilsIcons
      .IconIndex(mnuFile(0).Caption) = ilsIcons.ItemIndex("NEW")
      .IconIndex(mnuFile(2).Caption) = ilsIcons.ItemIndex("OPEN")
      .IconIndex(mnuFile(3).Caption) = ilsIcons.ItemIndex("SAVE")
      .IconIndex(mnuFile(6).Caption) = ilsIcons.ItemIndex("PRINT")
      .IconIndex(mnuFile(7).Caption) = ilsIcons.ItemIndex("FIND_DOC")
      
      .IconIndex(mnuWindow(0).Caption) = ilsIcons.ItemIndex("CASCADE")
      .IconIndex(mnuWindow(1).Caption) = ilsIcons.ItemIndex("TILEHORZ")
      .IconIndex(mnuWindow(2).Caption) = ilsIcons.ItemIndex("TILEVERT")
      .IconIndex(mnuWindow(3).Caption) = ilsIcons.ItemIndex("KILLWIN")
      .IconIndex(mnuWindow(5).Caption) = ilsIcons.ItemIndex("NEXTWIN")
      .IconIndex(mnuWindow(6).Caption) = ilsIcons.ItemIndex("PREVWIN")
      .IconIndex("&More Windows...") = ilsIcons.ItemIndex("MOREWINS")

      .IconIndex(mnuHelp(0).Caption) = ilsIcons.ItemIndex("HELP")

   End With
   mnuFile_Click 0
   
End Sub

Private Sub mnuFile_Click(Index As Integer)
   Select Case Index
   Case 0
      Dim f As frmMDIChild
      Set f = New frmMDIChild
      f.Show
   Case 2
   Case 3
   Case 4
   Case 6
   Case 7
   Case 9
   Case 11
      Unload Me
   End Select
End Sub

Private Sub mnuFileTOP_Click()
Dim bS As Boolean
   bS = Not (Me.ActiveForm Is Nothing)
   mnuFile(3).Enabled = bS
   mnuFile(4).Enabled = bS
   mnuFile(6).Enabled = bS
   mnuFile(7).Enabled = bS
   mnuFile(9).Enabled = bS
End Sub

Private Sub mnuWindow_Click(Index As Integer)
Dim lhWNd As Long
   Select Case Index
   Case 0
      Me.Arrange vbCascade
   Case 1
      Me.Arrange vbTileHorizontal
   Case 2
      Me.Arrange vbTileVertical
   Case 3
      Dim f As Object
      For Each f In Forms
         On Error Resume Next
         If f.MDIChild Then
            If Err.Number = 0 Then
               Unload f
            End If
         End If
         Err.Clear
      Next
   Case 5
      lhWNd = GetMDIClienthWnd()
      SendMessageLong lhWNd, WM_MDINEXT, 0, 0
   Case 6
      lhWNd = GetMDIClienthWnd()
      SendMessageLong lhWNd, WM_MDINEXT, 0, 1
   End Select
End Sub

Private Sub mnuWindowTOP_Click()
Dim f As Object
Dim l As Long
   For Each f In Forms
      On Error Resume Next
      If f.MDIChild Then
         If Err.Number = 0 Then
            l = l + 1
         End If
      End If
      Err.Clear
   Next
   mnuWindow(0).Enabled = (l > 0)
   mnuWindow(1).Enabled = (l > 0)
   mnuWindow(2).Enabled = (l > 0)
   mnuWindow(3).Enabled = (l > 0)
   mnuWindow(5).Enabled = (l > 1)
   mnuWindow(6).Enabled = (l > 1)
End Sub