home *** CD-ROM | disk | FTP | other *** search
/ ActiveX Programming Unleashed CD / AXU.iso / activex / demos / oletrial / samples / vb / mhsubc / mhsub.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-11-30  |  6.9 KB  |  170 lines
  1. VERSION 4.00
  2. Begin VB.MDIForm fMhSubClass 
  3.    AutoShowChildren=   0   'False
  4.    BackColor       =   &H8000000C&
  5.    Caption         =   "MDIForm1"
  6.    ClientHeight    =   6375
  7.    ClientLeft      =   1110
  8.    ClientTop       =   1485
  9.    ClientWidth     =   9435
  10.    Height          =   6780
  11.    Left            =   1050
  12.    LinkTopic       =   "MDIForm1"
  13.    Top             =   1140
  14.    Width           =   9555
  15.    Begin VB.PictureBox pixStatus 
  16.       Align           =   2  'Align Bottom
  17.       Height          =   375
  18.       Left            =   0
  19.       ScaleHeight     =   315
  20.       ScaleWidth      =   9375
  21.       TabIndex        =   0
  22.       Top             =   6000
  23.       Width           =   9435
  24.       Begin MhcallbLib.MhSubclass MhSubclass2 
  25.          Height          =   420
  26.          Left            =   4320
  27.          TabIndex        =   3
  28.          Top             =   0
  29.          Width           =   420
  30.          _version        =   65536
  31.          _extentx        =   741
  32.          _extenty        =   741
  33.          _stockprops     =   64
  34.          tintcolor       =   16711935
  35.          style           =   0
  36.       End
  37.       Begin MhcallbLib.MhSubclass MhSubclass1 
  38.          Height          =   420
  39.          Left            =   600
  40.          TabIndex        =   2
  41.          Top             =   0
  42.          Width           =   420
  43.          _version        =   65536
  44.          _extentx        =   741
  45.          _extenty        =   741
  46.          _stockprops     =   64
  47.          tintcolor       =   16711935
  48.          style           =   0
  49.       End
  50.       Begin VB.Label lblStatus 
  51.          BorderStyle     =   1  'Fixed Single
  52.          Height          =   375
  53.          Left            =   0
  54.          TabIndex        =   1
  55.          Top             =   0
  56.          Width           =   9375
  57.       End
  58.    End
  59. Attribute VB_Name = "fMhSubClass"
  60. Attribute VB_Creatable = False
  61. Attribute VB_Exposed = False
  62. Option Explicit
  63. Private Sub MDIForm_Activate()
  64.     'Setting the hWnd allows us to intercept messages
  65.     MhSubclass1.hWndSubclass = fChild.hwnd
  66.     MhSubclass1.MsgList(0) = WM_MOVE
  67.     MhSubclass1.MsgList(1) = WM_LBUTTONUP
  68.     MhSubclass1.MsgList(2) = WM_LBUTTONDOWN
  69.     MhSubclass1.MsgList(3) = WM_RBUTTONDOWN
  70.     MhSubclass1.MsgList(4) = WM_RBUTTONUP
  71.     MhSubclass1.MsgList(5) = WM_LBUTTONDBLCLK
  72.     MhSubclass1.MsgList(6) = WM_RBUTTONDBLCLK
  73.     MhSubclass1.MsgList(7) = WM_MOUSEACTIVATE
  74.     MhSubclass1.MsgList(8) = WM_MOUSEMOVE
  75.     MhSubclass2.hWndSubclass = fMhSubClass.hwnd
  76.     MhSubclass2.MsgList(0) = WM_MENUSELECT
  77.     MhSubclass2.MsgList(1) = WM_SYSCOMMAND
  78. End Sub
  79. Private Sub MDIForm_Load()
  80.     fMhSubClass.Caption = "MicroHelp MhSubClass Example"
  81.     fChild.Caption = "Move me, Click me, Move the mouse over me"
  82.     'Here we get the menu of the system handle (Declarations and constants for these functions is in the MhSub.Bas file)
  83.     #If Win32 Then
  84.     lg_SysMenuHandle = GetSystemMenu(fMhSubClass.hwnd, False)
  85.     #End If
  86.     'Here we put in the separator for the menu.
  87.     lg_AddMenu = AppendMenu(lg_SysMenuHandle, MF_SEPARATOR, 0, 0&)
  88.     'Here we add the menu item. MhSubClass2 will catch it and do something with it. Look in the SubclassMsg event
  89.     lg_AddMenu = AppendMenu(lg_SysMenuHandle, MF_STRING, lg_ABOUT, "&About . . .")
  90.     CenterForm ("fMhSubClass")
  91.     CenterForm ("fChild")
  92.     fChild.Show
  93. End Sub
  94. Private Sub MhSubclass1_SubclassMsg(Msg As Integer, wParam As Integer, lParam As Long, ReturnVal As Long)
  95.    'Here, we're inserting the messages we catch at the top of the listbox
  96.     Select Case Msg
  97.         Case WM_MOVE
  98.             fChild.lstMsg.AddItem "WM_MOVE", 0
  99.         Case WM_LBUTTONUP
  100.             fChild.lstMsg.AddItem "WM_LBUTTONUP", 0
  101.         Case WM_LBUTTONDOWN
  102.             fChild.lstMsg.AddItem "WM_LBUTTONDOWN", 0
  103.         Case WM_RBUTTONDOWN
  104.             fChild.lstMsg.AddItem "WM_RBUTTONDOWN", 0
  105.         Case WM_RBUTTONUP
  106.             fChild.lstMsg.AddItem "WM_RBUTTONUP", 0
  107.         Case WM_LBUTTONDBLCLK
  108.             fChild.lstMsg.AddItem "WM_LBUTTONDBLCLK", 0
  109.         Case WM_RBUTTONDBLCLK
  110.             fChild.lstMsg.AddItem "WM_RBUTTONDBLCLK", 0
  111.         Case WM_MOUSEACTIVATE
  112.             fChild.lstMsg.AddItem "WM_MOUSEACTIVATE", 0
  113.         Case WM_MOUSEMOVE
  114.             fChild.lstMsg.AddItem "WM_MOUSEMOVE", 0
  115.         Case Else
  116.             fChild.lstMsg.AddItem "Unanticipated message", 0
  117.     End Select
  118.     'Makes messages more readable
  119.     If fChild.lstMsg.List(1) <> "" Then
  120.         fChild.lstMsg.AddItem "", 1
  121.     End If
  122.     'To make sure the list doesn't overflow, we remove the bottom item
  123.     'if the list contains more than 100 items
  124.     If fChild.lstMsg.ListCount > 100 Then
  125.         fChild.lstMsg.RemoveItem fChild.lstMsg.ListCount - 1
  126.     End If
  127. End Sub
  128. Public Sub CenterForm(fForm)
  129.    Select Case fForm
  130.         'Centers main form on screen
  131.         Case "fMhSubClass"
  132.             fMhSubClass.Left = (Screen.Width \ 2) - (fMhSubClass.Width \ 2)
  133.             fMhSubClass.Top = (Screen.Height \ 2) - (fMhSubClass.Height \ 2)
  134.         'Centers little form on big one
  135.         Case "fChild"
  136.             fChild.Height = 4680
  137.             fChild.Width = 8355
  138.             fChild.Left = (fMhSubClass.Width - fChild.Width) \ 2
  139.             fChild.Top = ((fMhSubClass.ScaleHeight - fChild.Height) \ 2) - (fMhSubClass.lblStatus.Height \ 2)
  140.      End Select
  141. End Sub
  142. Private Sub MhSubclass2_SubclassMsg(Msg As Integer, wParam As Integer, lParam As Long, ReturnVal As Long)
  143.         
  144.     'Here we catch messages and determine what we're going to do based on additional parameters
  145.     Select Case Msg
  146.         'If the user highlights a menu item, we put some text in a status bar
  147.         Case WM_MENUSELECT
  148.             Select Case wParam
  149.                 Case 0
  150.                     fMhSubClass!lblStatus.Caption = "File menu is selected."
  151.                 Case 2
  152.                     fMhSubClass!lblStatus.Caption = "Click on this item and the program will end."
  153.                 Case 1
  154.                     fMhSubClass!lblStatus.Caption = "This is a test menu added so we can demonstrate menu item sequencing."
  155.                 Case 4
  156.                     fMhSubClass!lblStatus.Caption = fChild!itmOne.Caption
  157.                 Case 5
  158.                     fMhSubClass!lblStatus.Caption = fChild!itmTwo.Caption
  159.                 Case 6
  160.                     fMhSubClass!lblStatus.Caption = fChild!itmThree.Caption
  161.             End Select
  162.         'If the user clicks the "About" box of the system menu, we pop up a little About box.
  163.         Case WM_SYSCOMMAND
  164.             If wParam = lg_ABOUT Then
  165.                 MsgBox "This subclassing example owes a debt to the article  'Subclass Your Way Around VB's Limitations' by Jonathan Wood and Karl E. Peterson in the September 1995 edition of Visual Basic Programmer's Journal -- Jim McFadden, MicroHelp", 64, "MicroHelp"
  166.                 Exit Sub
  167.             End If
  168.     End Select
  169. End Sub
  170.