Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/toolhelp/mdiform1.frm

Visual Basic Form | 1995-05-07 | 5.7 KB | 188 lines

VERSION 2.00
Begin MDIForm MDIForm1
   Caption         =   "Popup Help Demo"
   ClientHeight    =   2670
   ClientLeft      =   1980
   ClientTop       =   2190
   ClientWidth     =   5085
   Height          =   3075
   Left            =   1920
   LinkTopic       =   "MDIForm1"
   Top             =   1845
   Width           =   5205
   Begin PictureBox Picture1
      Align           =   2  'Align Bottom
      BackColor       =   &H00C0C0C0&
      Height          =   495
      Left            =   0
      ScaleHeight     =   465
      ScaleWidth      =   5055
      TabIndex        =   1
      Top             =   2175
      Width           =   5085
      Begin Timer Timer1
         Enabled         =   0   'False
         Interval        =   850
         Left            =   6300
         Top             =   30
      End
      Begin Timer Timer2
         Enabled         =   0   'False
         Interval        =   50
         Left            =   6825
         Top             =   30
      End
      Begin Label Label4
         AutoSize        =   -1  'True
         BackColor       =   &H00C0C0C0&
         Caption         =   "hWnd:"
         ForeColor       =   &H00000000&
         Height          =   195
         Left            =   120
         TabIndex        =   2
         Top             =   135
         Width           =   570
      End
      Begin Label Label2
         BackColor       =   &H00C0C0C0&
         Caption         =   "Label"
         ForeColor       =   &H00800000&
         Height          =   195
         Left            =   765
         TabIndex        =   3
         Top             =   135
         Width           =   1185
      End
   End
   Begin PictureBox picToolbar
      Align           =   1  'Align Top
      BackColor       =   &H00C0C0C0&
      Height          =   510
      Left            =   0
      ScaleHeight     =   32
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   337
      TabIndex        =   0
      Top             =   0
      Width           =   5085
      Begin PictureBox PicClip1
         Height          =   480
         Left            =   0
         Picture         =   MDIFORM1.FRX:0000
         ScaleHeight     =   450
         ScaleWidth      =   1170
         TabIndex        =   4
         Top             =   0
         Width           =   1200
      End
      Begin PictureBox pshToolBtn
         Height          =   345
         Index           =   0
         Left            =   90
         ScaleHeight     =   315
         ScaleWidth      =   375
         TabIndex        =   5
         Top             =   60
         Width           =   405
      End
   End
Option Explicit
' This is used to keep account of windows that are
' the toolbar buttons
Dim hWndTrack(0 To 10) As Integer
Sub MDIForm_Load ()
  Dim i As Integer
  gNumBtns = picClip1.Cols
  gCurrBtn = -1
  ' load toolbar buttons
  For i = 0 To gNumBtns - 1
    If i > 0 Then
       Load pshToolBtn(i)
       pshToolBtn(i).Left = pshToolBtn(i - 1).Left + pshToolBtn(i - 1).Width - 1
       pshToolBtn(i).Visible = True
    End If
    pshToolBtn(i).PictureUp = picClip1.GraphicCell(i)
    hWndTrack(i) = pshToolBtn(i).hWnd
  Next
  ' use Tag to hold messages for each button
  pshToolBtn(0).Tag = "Clear workspace"
  pshToolBtn(1).Tag = "Open previous workspace"
  pshToolBtn(2).Tag = "Save current workspace"
  pshToolBtn(3).Tag = "Calculate"
  pshToolBtn(4).Tag = "Cut to Clipboard"
  pshToolBtn(5).Tag = "Insert Excel Object"
  pshToolBtn(6).Tag = "Exit demo program"
End Sub
Sub pshToolBtn_Click (Index As Integer, Value As Integer)
  ' pop button back up
  pshToolBtn(Index).Value = False
  ' the exit button really works <g>
  If Index = gNumBtns - 1 Then End
End Sub
Sub pshToolBtn_MouseMove (Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  ' if help active and on a new button then show
  ' new help message...
  If gPopHelpActive And Index <> gCurrBtn Then
    frmPopupHelp.Hide
    gCurrBtn = Index
    Call ShowHelpMess
  Else
    ' else if we moved over a new button...
    If Index <> gCurrBtn Then
      gCurrBtn = Index
      ' cancel any old countdown
      Timer1.Enabled = False
      ' start counting down to popup help
      Timer1.Enabled = True
    End If
  End If
End Sub
Sub Timer1_Timer ()
  ' This timer is used to countdown time to activate
  ' popup help
  Dim t As Integer
  Call GetCursorPos(gPoint)
  t = WindowFromPoint(PointAPIToLong&(gPoint))
  ' are we stil  on the button that triggered this timer?
  If t = pshToolBtn(gCurrBtn).hWnd Then
    gPopHelpActive = True
    Call ShowHelpMess
    ' start tracking cursor position
    Timer2.Enabled = True
  End If
  ' kill countdown timer
  Timer1.Enabled = False
  gCurrBtn = -1
End Sub
Sub Timer2_Timer ()
  ' This timer tracks mouse position once popup help
  ' has been activated.  Once we move off the toolbar
  ' area then popup help is canceled.
  Dim i As Integer
  Dim h As Integer
  Dim Found As Integer
  Call GetCursorPos(gPoint)
  h = WindowFromPoint(PointAPIToLong&(gPoint))
  Label2.Caption = h
  ' see if we're on any of the toolbar buttons...
  For i = 0 To gNumBtns - 1
    If h = hWndTrack(i) Then
      Found = True
      Exit For
    End If
  Next
  If Not Found Then
    ' check the toolbar area as well...
    If h = picToolBar.hWnd Then
      frmPopupHelp.Hide
      gCurrBtn = -1
    Else
      ' else cancel popup help
      frmPopupHelp.Hide
      gCurrBtn = -1
      gPopHelpActive = False
      Timer2.Enabled = False
    End If
  End If
End Sub