Caption = "Right-click on me to set my properties..."
Height = 264
Left = 72
TabIndex = 21
Top = 1512
Width = 4980
End
Begin Mhal200Lib.MhIAlarm MhIAlarmPropertyTester
Height = 384
Left = 2376
TabIndex = 20
TabStop = 0 'False
Top = 1008
Width = 384
_Version = 65536
_ExtentX = 677
_ExtentY = 677
_StockProps = 65
TintColor = 16711935
Style = 0
Autosize = -1 'True
RingTime = 1000
PauseTime = 1000
RingTone = 41
RingMode = 2
RingLength = 34
RingOn = 0
WaveSource = 0
Interval = 29
WindowState = 0
WaveName = "Telephone"
End
End
End
Begin VB.Frame fraTheLook
Caption = "The MhAlarm control has some cool styles..."
Height = 2712
Left = 72
TabIndex = 3
Tag = "slide frame"
Top = 36
Width = 5412
Begin VB.Frame Frame1
Height = 2388
Left = 144
TabIndex = 8
Top = 180
Width = 5124
Begin Mhal200Lib.MhIAlarm MhAlarm1
Height = 384
Index = 1
Left = 2376
TabIndex = 17
TabStop = 0 'False
Top = 1008
Width = 384
_Version = 65536
_ExtentX = 677
_ExtentY = 677
_StockProps = 65
TintColor = 16711935
Style = 1
Autosize = -1 'True
RingTime = 2000
PauseTime = 0
RingTone = 45
RingMode = 2
RingLength = 32
RingOn = 0
WaveSource = 0
Interval = 50
WindowState = 0
WaveName = "AlarmClock"
End
Begin Mhal200Lib.MhIAlarm MhAlarm2
Height = 384
Index = 0
Left = 864
TabIndex = 16
TabStop = 0 'False
Top = 1008
Width = 384
_Version = 65536
_ExtentX = 677
_ExtentY = 677
_StockProps = 65
TintColor = 16711935
Style = 0
Autosize = -1 'True
RingTime = 1000
PauseTime = 1000
RingTone = 41
RingMode = 2
RingLength = 34
RingOn = 0
WaveSource = 0
Interval = 29
WindowState = 0
WaveName = "Telephone"
End
Begin Mhal200Lib.MhIAlarm MhIAlarmDemo
Height = 384
Index = 2
Left = 3636
TabIndex = 15
TabStop = 0 'False
Top = 1008
Width = 384
_Version = 65536
_ExtentX = 677
_ExtentY = 677
_StockProps = 65
TintColor = 16711935
Style = 2
Autosize = -1 'True
RingTime = 1000
PauseTime = 1000
RingTone = 72
RingMode = 0
RingLength = 34
RingOn = 0
WaveSource = 0
Interval = 29
WindowState = 0
WaveName = "Wristwatch"
End
Begin VB.Label Label2
Alignment = 2 'Center
Caption = "El Tel
phono"
Height = 228
Left = 504
TabIndex = 14
Top = 684
Width = 1236
End
Begin VB.Label Label3
Alignment = 2 'Center
Caption = "As-Saa'a"
Height = 228
Left = 3312
TabIndex = 13
Top = 684
Width = 1092
End
Begin VB.Label Label4
Alignment = 2 'Center
Caption = "Une Cloche"
Height = 228
Left = 2052
TabIndex = 12
Top = 684
Width = 1092
End
Begin VB.Label Label5
Alignment = 2 'Center
Caption = "Wrist Watch"
Height = 228
Left = 3168
TabIndex = 11
Top = 1548
Width = 1416
End
Begin VB.Label Label6
Alignment = 2 'Center
Caption = "Clock"
Height = 228
Left = 2052
TabIndex = 10
Top = 1548
Width = 1020
End
Begin VB.Label Label7
Alignment = 2 'Center
Caption = "Telephone"
Height = 228
Left = 540
TabIndex = 9
Top = 1548
Width = 1092
End
End
End
Begin VB.CommandButton cmdSlide
Appearance = 0 'Flat
BackColor = &H00D9A8AE&
Caption = "< &Back"
Enabled = 0 'False
BeginProperty Font
name = "MS Sans Serif"
charset = 0
weight = 400
size = 7.8
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 372
Index = 0
Left = 888
TabIndex = 0
Top = 2904
Width = 1212
End
Begin VB.CommandButton cmdSlide
Appearance = 0 'Flat
BackColor = &H00D9A8AE&
Caption = "&Next >"
Default = -1 'True
BeginProperty Font
name = "MS Sans Serif"
charset = 0
weight = 400
size = 7.8
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 372
Index = 1
Left = 2088
TabIndex = 1
Top = 2904
Width = 1212
End
Begin VB.CommandButton cmdClose
Appearance = 0 'Flat
BackColor = &H00D9A8AE&
Caption = "&Close"
BeginProperty Font
name = "MS Sans Serif"
charset = 0
weight = 400
size = 7.8
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 372
Left = 3384
TabIndex = 2
Top = 2916
Width = 1212
End
Begin VB.Timer tmrStatusLine
Enabled = 0 'False
Left = 432
Top = 2916
End
Begin Threed.SSPanel panStatusLine
Height = 240
Left = 72
TabIndex = 6
Top = 3384
Width = 5412
_Version = 65536
_ExtentX = 9546
_ExtentY = 423
_StockProps = 15
Caption = "Ready..."
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
name = "MS Sans Serif"
charset = 0
weight = 400
size = 7.8
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
BevelOuter = 1
End
Begin Threed.SSPanel SSPanel1
Height = 24
Left = -1224
TabIndex = 18
Top = 0
Width = 8400
_Version = 65536
_ExtentX = 14817
_ExtentY = 42
_StockProps = 15
Caption = "SSPanel1"
BackColor = 12038095
BevelOuter = 1
End
Begin VB.Frame fraTipsAndTricks
Caption = "Tips and Tricks..."
Height = 2712
Left = 72
TabIndex = 4
Tag = "slide frame"
Top = 3708
Width = 5412
Begin VB.TextBox txtTipsAndTricks
Height = 2352
Left = 108
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 5
Top = 252
Width = 5172
End
End
Begin VB.Menu mnuFile
Caption = "&File"
Begin VB.Menu mnuFileExit
Caption = "E&xit"
End
End
Begin VB.Menu mnuAbout
Caption = "&About..."
End
Begin VB.Menu mnuContextMenus
Caption = "Context Menus"
Visible = 0 'False
Begin VB.Menu mnuMhAlarmContextMenu
Caption = "Context Menu for MhAlarmPropertyTester"
Begin VB.Menu mnuMhAlarmContextMenu_About
Caption = "&About Control..."
End
Begin VB.Menu mnuMhAlarmContextMenu_Close
Caption = "&Close"
End
Begin VB.Menu mnuMhAlarmContextMenu_Sep1
Caption = "-"
End
Begin VB.Menu mnuMhAlarmContextMenu_Properties
Caption = "&Properties"
End
End
End
Attribute VB_Name = "frmMhAlarm_OCX"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit ' always
' to keep track of the currently selected slide (view), number of slide-frames used in demo.
Private iCurrentSlide As Byte, iNumberOfSlides As Byte
' This procedure sets the percent complete status line of the demo's interface
' form.
' iProgress - value to set indicate percent complete of operation.
' If a value of <0 or > 100 is passed the status line is cleared and reset
Public Sub SetStatusBarProgress(iProgress As Byte)
Dim StatusBar As Control
' set reference to status line on form
Set StatusBar = panStatusLine
Select Case iProgress
Case 0 To 100
' set the status line flood type if not already set
If StatusBar.FloodType <> 1 Then StatusBar.FloodType = 1
' set the value of the percent complete
StatusBar.FloodPercent = iProgress
Case Else
' value is outside of valid range so reset status line
StatusBar.FloodType = 0
StatusBar.FloodPercent = 0
End Select
End Sub
Private Sub cmdClose_Click()
' unload this form
Unload Me
End Sub
Private Sub cmdSlide_Click(Index As Integer)
' determine the button that the user pressed
Select Case Index
Case 0 ' Go Back
ShowSlidePrevious
Case 1 ' Go to Next slide
ShowSlideNext
End Select
End Sub
Private Sub Form_Load()
Screen.MousePointer = vbHourglass
Dim iDisplaySlideLeft As Integer, iDisplaySlideTop As Integer
' place all display frames in the same location as the first frame
iDisplaySlideTop = fraTheLook.Top
iDisplaySlideLeft = fraTheLook.Left
Dim TempControl As Control
For Each TempControl In Me.Controls
If TypeOf TempControl Is Frame Then
If TempControl.Tag = "slide frame" Then ' frames used as slides have their .Tag properties set to "slide frame"
TempControl.Left = iDisplaySlideLeft
TempControl.Top = iDisplaySlideTop
End If
End If
Next TempControl
' center the form to the screen using the parent object's CenterForm method
Call DemoMain.CenterForm(Me)
' set backcolor of various controls to match current Windows 3D settings
'Call DemoMain.Set3dColors(Me)
' we use 3 slide (views) for this demo
iNumberOfSlides = 3
' show the demo's first slide (view)
ShowSlideNext
' greet the user warmly!
Dim sGreeting As String
Randomize (Timer)
Select Case Int(Rnd * 4)
Case 0
sGreeting = "Howdi programmer..."
Case 1
sGreeting = "Hi there..."
Case 2
sGreeting = "It's MhAlarm Time!"
Case Else
sGreeting = "Welcome to the MicroHelp MhAlarm Demo!"
End Select
Call SetStatusLineText(sGreeting, 4001, True)
Screen.MousePointer = vbDefault
End Sub
' This procedure sets the status line text to the text in sMessageText parameter
' and keeps the text there for the time period specified (in milliseconds) by the
' vTimePeriod parameter. This procedure uses the timer on the demo's mDemoFace form to
' get a callback when the vTimePeriod has elapsed.
' sMessageText - text to be displayed
' [vTimePeriod] - time period (in milliseconds) to display the message. If not specfied a value
' of 3000 is used.
' [vOverRide] - when set to True the sMessageText is displayed immediately even if there is a
' message currently being displayed. If set to False (or not specified) and there is a message
' being displayed the new message is placed in a single item queue and displayed when the time
' period of the previous message has expired.
Public Sub SetStatusLineText(sMessageText As String, Optional vTimePeriod As Variant, Optional vOverRide As Variant)
Static sQueueText As String, iQueueTimePeriod As Integer, bQueueIsEmpty As Boolean
Dim oStatusLine As Control, oStatusLineTimer As Timer
' set references to controls on the m_DemoFace form
Set oStatusLine = panStatusLine
Set oStatusLineTimer = tmrStatusLine
' if the calling procedure did not specify a display time (or set it to <.5 seconds) then default the time to 3 seconds
Select Case True
Case IsMissing(vTimePeriod), vTimePeriod <= 500
vTimePeriod = 3000
End Select
' if the calling procedure did not specify an vOverRide value then set vOverRide to False
If IsMissing(vOverRide) Then vOverRide = False
' if this procedure was called by the timer then turn the timer off and check queue. If it was not called by the timer
' then there is a new message to display.
If sMessageText = "_timer_calling_" Then
' If there is nothing in the queue then reset the status line text to "Ready".
' Otherwise, display the message which is in the queue
oStatusLineTimer.Enabled = False ' turn timer off
If bQueueIsEmpty Then
' reset status line text
oStatusLine.Caption = "Ready..."
Else
' display message which is in the queue
oStatusLine.Caption = sQueueText
' setup timer to call this procedure when the iQueueTimePeriod has expired
oStatusLineTimer.Interval = iQueueTimePeriod
sQueueText = "" ' clear queue text
iQueueTimePeriod = 0 ' clear queue time period
bQueueIsEmpty = True ' the queue is now empty so let's indicate this fact
oStatusLineTimer.Enabled = True
End If
Else
' if the timer is enabled then there is already a message being displayed so place
' this new message in the single item queue. But, if this is an over-ride then
' show the message now
If oStatusLineTimer.Enabled And Not vOverRide Then
sQueueText = sMessageText
iQueueTimePeriod = vTimePeriod
bQueueIsEmpty = False
Else
' over-ride the currently displayed message
oStatusLineTimer.Enabled = False
sQueueText = "" ' clear queue text
iQueueTimePeriod = 0 ' clear queue time period
bQueueIsEmpty = True ' the queue is now empty so let's indicate this fact
oStatusLine.Caption = sMessageText
' setup timer to call this procedure when the vTimePeriod has expired
oStatusLineTimer.Interval = vTimePeriod
oStatusLineTimer.Enabled = True
End If
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
' close down this demo
DemoMain.ProgramExit
End Sub
' This method moves to the demo's next slide if not already on the last slide
Public Sub ShowSlideNext()
' if we are not on the last slide then choose the next slide as the current slide
If iCurrentSlide < iNumberOfSlides Then iCurrentSlide = iCurrentSlide + 1
' have the user interface move to this new slide (view)
SetupFrames (iCurrentSlide)
End Sub
' This method returns to the demo's previous slide if not already on the first slide
Public Sub ShowSlidePrevious()
' if we are not on the first slide then make the previouse slide the current slide
If iCurrentSlide >= 1 Then iCurrentSlide = iCurrentSlide - 1
' have the user interface move to this new slide (view)
SetupFrames (iCurrentSlide)
End Sub
Public Sub ShowAbout()
Screen.MousePointer = vbHourglass
frmAbout.Show
Screen.MousePointer = vbDefault
End Sub
Private Sub MhIAlarmDemo_Click(Index As Integer)
' tell user that an alarm was clicked
Call SetStatusLineText("An MhAlarm control was clicked...")
End Sub
Private Sub MhIAlarmPropertyTester_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
' if the user right clicked on control then show the popup menu for this control
If Button And vbRightButton Then Me.PopupMenu mnuMhAlarmContextMenu
' tell user that the alarm was clicked
Call SetStatusLineText("An MhAlarm control was clicked...")
End Sub
Private Sub mnuAbout_Click()
' tell user about the demo by invoking the parent object's ShowAbout method
ShowAbout
End Sub
Private Sub mnuFileExit_Click()
' unload form
Unload Me
End Sub
' This procedure sets up the different views according to the SlideNumber parameter
Public Sub SetupFrames(SlideNumber As Integer)
On Error GoTo SetupFrames_Error
Dim oCurrentFrame As Frame
Dim sMessageText As String
' enabled/disable the appropriate buttons according to our slide number
Select Case True
Case SlideNumber <= 1 ' we are at first slide
' disable the 'back' button
cmdSlide(0).Enabled = False
cmdSlide(1).SetFocus
Case SlideNumber >= iNumberOfSlides ' we are at last slide
' disable the 'next' button
cmdSlide(1).Enabled = False
cmdSlide(0).SetFocus
Case Else ' we are in the middle so make sure that both buttons are enabled
' enable the 'back' button
cmdSlide(0).Enabled = True
' enable the 'next' button
cmdSlide(1).Enabled = True
End Select
' since only one slide uses this text box it can be set to empty to save a little memory
txtTipsAndTricks.Text = ""
' make desired slide visible
Select Case SlideNumber
Case 1
Set oCurrentFrame = fraTheLook
oCurrentFrame.Visible = True
' tell user how to set off an alarm!
sMessageText = "Simply click on a control to make it 'ring'"
Case 2
Set oCurrentFrame = fraProperties
oCurrentFrame.Visible = True
' tell user what this slide is about
Dim sDoubleQuote As String * 1
sDoubleQuote = Chr$(34)
' show cool quote
sMessageText = sDoubleQuote & "I think that programming is an art form." & sDoubleQuote & " - Amy Allsmyles, 1995."
Case 3
Set oCurrentFrame = fraTipsAndTricks
oCurrentFrame.Visible = True
With txtTipsAndTricks
.Text = "But I Don't Hear A Thing!" & vbCrLf & "The MhAlarm control uses your PC's sound card to produce its sounds as opposed to your PC's internal speaker. If the control appears to shake but you never hear a ring then try configuring your sound board."
.Text = .Text & vbCrLf & vbCrLf & "Using Wave Files" & vbCrLf & "By setting the .WaveSource and .WaveName properties you can specify the .Wav file that the control uses to make its ring sound. Set .WaveSource to 1 - System to choose .Wave files used by Windows. To specify your own .Wav file set the .WaveSource property to 2 - FileName and set the .WaveName property to the path of the .Wav file."
.Text = .Text & vbCrLf & vbCrLf & "Continous Ring" & vbCrLf & "Setting the RingOn property to 1 will cause the control to ring once. However, the control will ring continuously as long as the .RingOn property is 2. See the frmMhAlarmPropertyTester.cmdTest_Click event."
.Text = .Text & vbCrLf & vbCrLf & "Using Custom Bitmaps" & vbCrLf & "To get the animated effect the control displays three bitmaps one after the other. The three PictureX properties allow you to specify your own bitmaps to use. In addition, the control masks the bitmaps to make the usual square bitmap background disappear. To get the same effect with your bitmaps, you need to make a mask for each of the three PictureMaskX properties. For more information on using masks please see the helpfile."
End With ' txtTipsAndTricks
' give user a tip
sMessageText = "Best advice: Know your tools, read the manual well!"
cmdSlide(0).SetFocus
End Select
' make all frames invisible (except for the current frame)
Dim TempControl As Control
For Each TempControl In Me.Controls
If TypeOf TempControl Is Frame Then
With TempControl
If .Tag = "slide frame" And .hWnd <> oCurrentFrame.hWnd Then .Visible = False
End With ' TempControl
End If
Next TempControl
' show user message which goes with the selected slide
(.txt)