home *** CD-ROM | disk | FTP | other *** search
VERSION 4.00 Begin VB.Form frmMhWaveOCX_Demo BorderStyle = 3 'Fixed Dialog Caption = "MicroHelp MhWave OCX Demo" ClientHeight = 3720 ClientLeft = 2040 ClientTop = 2064 ClientWidth = 5568 BeginProperty Font name = "MS Sans Serif" charset = 0 weight = 700 size = 7.8 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 4332 Icon = "Mhwave.frx":0000 Left = 1992 LinkTopic = "Form1" ScaleHeight = 3720 ScaleWidth = 5568 Top = 1500 Width = 5664 Begin VB.Frame fraBuiltInWaves Caption = "The MhWave Control Has Built In Sounds For..." Height = 2712 Left = 5652 TabIndex = 22 Tag = "slide frame" Top = 72 Width = 5412 Begin VB.Frame Frame3 Caption = "And Numbers." Height = 948 Left = 180 TabIndex = 27 Top = 1620 Width = 5052 Begin VB.CommandButton cmdPlayNumber Caption = "100" 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 = 3 Left = 3744 TabIndex = 12 Top = 396 Width = 1176 End Begin VB.CommandButton cmdPlayNumber Caption = "95555255225" 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 = 2 Left = 2556 TabIndex = 11 Top = 396 Width = 1176 End Begin VB.CommandButton cmdPlayNumber Caption = "0.2543" 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 = 1368 TabIndex = 10 Top = 396 Width = 1176 End Begin VB.CommandButton cmdPlayNumber Caption = "123.66764" 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 = 180 TabIndex = 9 Top = 396 Width = 1176 End End Begin VB.Frame Frame2 Caption = "Dollar Amounts," Height = 1236 Left = 2628 TabIndex = 26 Top = 324 Width = 2604 Begin VB.CommandButton cmdPlayDollarAmount Caption = "$189.95" 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 = 684 TabIndex = 8 Top = 720 Width = 1212 End Begin VB.CommandButton cmdPlayDollarAmount Caption = "$1,000,000" 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 = 684 TabIndex = 7 Top = 324 Width = 1212 End End Begin VB.Frame Frame1 Caption = "Dates," Height = 1236 Left = 180 TabIndex = 25 Top = 324 Width = 2316 Begin VB.CommandButton cmdPlayDate Caption = "&Yesterday" 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 = 468 TabIndex = 6 Top = 720 Width = 1212 End Begin VB.CommandButton cmdPlayDate Caption = "&Today" 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 = 468 TabIndex = 5 Top = 324 Width = 1212 End End End Begin VB.Frame fraTipsAndTricks Caption = "Tips and Tricks..." Height = 2712 Left = 72 TabIndex = 17 Tag = "slide frame" Top = 3708 Visible = 0 'False Width = 5412 Begin VB.TextBox txtTipsAndTricks Height = 2352 Left = 108 Locked = -1 'True MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 18 Top = 252 Width = 5172 End End Begin VB.Frame fraPlayingFiles Caption = "Playing Waves" Height = 2712 Left = 72 TabIndex = 16 Tag = "slide frame" Top = 72 Width = 5412 Begin VB.Frame fraPlayList Caption = "Play List" Height = 1344 Left = 180 TabIndex = 23 Top = 1152 Width = 5052 Begin VB.CommandButton cmdAddRemove Caption = "&Remove" 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 = 1 Left = 144 TabIndex = 3 Top = 756 Width = 1212 End Begin VB.ListBox lstPlayList Height = 1008 Left = 1476 MultiSelect = 2 'Extended TabIndex = 4 Top = 252 Width = 3432 End Begin VB.CommandButton cmdAddRemove Caption = "&Add..." 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 = 144 TabIndex = 2 Top = 360 Width = 1212 End End Begin Threed.SSPanel SSPanel1 Height = 588 Left = 180 TabIndex = 24 Top = 432 Width = 5052 _Version = 65536 _ExtentX = 8911 _ExtentY = 1037 _StockProps = 15 BorderWidth = 1 BevelOuter = 1 BevelInner = 2 Begin VB.CommandButton cmdPlay Caption = "&Play Wave File(s)" 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 = 108 TabIndex = 0 Top = 108 Width = 3624 End Begin VB.CheckBox chkReverse Caption = "Re&verse" BeginProperty Font name = "MS Sans Serif" charset = 0 weight = 400 size = 7.8 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 264 Left = 3852 TabIndex = 1 Top = 180 Width = 1128 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 = 13 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 = 14 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 = 15 Top = 2916 Width = 1212 End Begin VB.Timer tmrStatusLine Enabled = 0 'False Left = 4680 Top = 2916 End Begin Threed.SSPanel panStatusLine Height = 240 Left = 72 TabIndex = 19 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.79 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty BevelOuter = 1 End Begin MhwaveLib.MhWave MhWaveDemo Height = 336 Left = 108 TabIndex = 21 Top = 2916 Width = 336 _Version = 65536 _ExtentX = 593 _ExtentY = 593 _StockProps = 0 TintColor = 16711935 WaveIndex = 0 FilenameRead = "Mhwave.frx":0442 End Begin MhcommdlLib.MhCommonDialog MhcommdlDemo Height = 336 Left = 504 TabIndex = 20 TabStop = 0 'False Top = 2916 Width = 336 _Version = 65536 _ExtentX = 593 _ExtentY = 593 _StockProps = 4 TintColor = 16711935 Filename = "" DialogTop = 0 DialogLeft = 0 DialogWidth = 0 DialogHeight = 0 InitDir = "" Filter = "" DefaultExt = "" DialogTitle = "" FilterIndex = 0 Flags = 0 CancelError = 0 'False MaxFileSize = 256 Color = 0 Max = 0 Min = 0 Copies = 0 FromPage = 0 PrinterDefault = -1 'True ToPage = 0 HelpCommand = 0 HelpContext = 0 HelpFile = "" HelpKey = "" End Begin VB.Menu mnuFile Caption = "&File" Begin VB.Menu mnuFileExit Caption = "E&xit" End End Begin VB.Menu mnuAbout Caption = "&About..." End Attribute VB_Name = "frmMhWaveOCX_Demo" Attribute VB_Creatable = False Attribute VB_Exposed = False Option Explicit ' always Public AboutBoxShowing As Boolean Public NumbersFileLoaded As Boolean Private bMakeComments As Boolean Private iNumberOfSlides As Byte, iCurrentSlide As Byte ' This method moves to the demo's next slide if not already on the last slide Private 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 Private 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() ' show the about box Screen.MousePointer = vbHourglass Load frmAbout frmAbout.Show 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. Private 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 With oStatusLineTimer ' 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 .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 .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 .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 .Enabled And Not vOverRide Then sQueueText = sMessageText iQueueTimePeriod = vTimePeriod bQueueIsEmpty = False Else ' over-ride the currently displayed message .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 .Interval = vTimePeriod .Enabled = True End If End If End With End Sub ' 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 Private Sub SetStatusBarProgress(iProgress As Byte) Dim StatusBar As Control ' set reference to status line on form Set StatusBar = panStatusLine With StatusBar Select Case iProgress Case 0 To 100 ' set the status line flood type if not already set If .FloodType <> 1 Then .FloodType = 1 ' set the value of the percent complete .FloodPercent = iProgress Case Else ' value is outside of valid range so reset status line .FloodType = 0 .FloodPercent = 0 End Select End With ' StatusBar End Sub Private Sub cmdClose_Click() ' unload this form Unload Me End Sub Private Sub cmdAddRemove_Click(Index As Integer) On Error GoTo cmdAddRemove_Click_Error Dim sFileToUse As String, sDialogTitle As String Dim iFlags As Integer Dim sFilter As String Dim bInvalidWaveFile As Boolean Select Case Index Case 0 ' add ' load a new wave file and add it to the list iFlags = cdlOFNFileMustExist + cdlOFNPathMustExist + cdlOFNHideReadOnly sDialogTitle = "Load Wave File" sFilter = "Wave Files|*.Wav" ' if the dialog was not canceled and the file is not invalid then load the ' file and place it into the list If ShowFileDialog(sFileToUse, sFilter, sDialogTitle, iFlags) Then With lstPlayList .AddItem sFileToUse MhWaveDemo.WaveIndex = .NewIndex .ItemData(.NewIndex) = .NewIndex MhWaveDemo.FilenameRead = sFileToUse If Not bInvalidWaveFile Then ' if there is no file selected then select one If .ListIndex < 0 Then .ListIndex = 0 ' if there are 255 files (the max for the WaveIndex property) then disable the 'Add' If .ListCount >= 255 Then cmdAddRemove(0).Enabled = False cmdAddRemove(1).Enabled = True Else ' remove the newly added file .RemoveItem .NewIndex End If End With ' lstPlayList End If Case 1 ' remove cmdAddRemove(0).Enabled = True With lstPlayList If .ListIndex > -1 Then .RemoveItem .ListIndex ' if there are no items to remove then disabled the 'remove' button If .ListCount < 1 Then cmdAddRemove(1).Enabled = False End If End With ' lstPlayList End Select Exit Sub cmdAddRemove_Click_Error: Select Case Err.Number Case 32003 ' invalid wave file MsgBox "This is not a valid wave file." Case Else MsgBox "Error loading the '" & sFileToUse & "' file." End Select If Err.Number Then bInvalidWaveFile = True Resume Next End Sub Private Sub cmdPlay_Click() Dim iSelectedWaveFile As Byte, iCount As Byte With lstPlayList If .ListIndex > -1 And .ListCount > 0 Then ' play all selected items For iCount = 0 To .ListCount - 1 If .Selected(iCount) Then ' disable play button and the play list frame. They get ' re-enabled in the MhWaveDemo_EndWave event cmdPlay.Enabled = False fraPlayList.Enabled = False MhWaveDemo.WaveIndex = .ItemData(iCount) MhWaveDemo.Reverse = (chkReverse.Value = vbChecked) MhWaveDemo.Play = .ItemData(iCount) ' tell the user what file we are playing Call SetStatusLineText("Playing " & .List(iCount) & "...", 65001, True) End If Next iCount End If End With ' lstPlayList End Sub Private Sub cmdPlayDate_Click(Index As Integer) Dim sDateText As String If Not NumbersFileLoaded Then Exit Sub Select Case Index Case 0 ' today sDateText = Format$(Now, "mm/dd/yyyy") Case 1 ' yesterday sDateText = Format$(DateAdd("d", -1, Now), "mm/dd/yyyy") End Select MhWaveDemo.Date = sDateText End Sub Private Sub cmdPlayDollarAmount_Click(Index As Integer) If Not NumbersFileLoaded Then Exit Sub MhWaveDemo.Dollar = cmdPlayDollarAmount(Index).Caption End Sub Private Sub cmdPlayNumber_Click(Index As Integer) If Not NumbersFileLoaded Then Exit Sub MhWaveDemo.Number = cmdPlayNumber(Index).Caption 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_Activate() Static bBeenRun As Boolean If Not bBeenRun Then cmdAddRemove(0).SetFocus bBeenRun = True End If End Sub Private Sub Form_Load() Dim iDisplaySlideLeft As Integer, iDisplaySlideTop As Integer Dim sFileToUse As String, sDialogTitle As String Dim iFlags As Integer Dim sFilter As String Dim bInvalidWaveFile As Boolean ' place all display frames in the same location as the first frame iDisplaySlideTop = fraPlayingFiles.Top iDisplaySlideLeft = fraPlayingFiles.Left Dim TempControl As Control For Each TempControl In Me.Controls If TypeOf TempControl Is Frame Then With TempControl If .Tag = "slide frame" Then ' frames used as slides have their .Tag properties set to "slide frame" .Left = iDisplaySlideLeft .Top = iDisplaySlideTop End If End With ' TempControl End If Next TempControl ' center the form to the screen Move Abs(Screen.Width - Width) \ 2, Abs(Screen.Height - Height) \ 2 ' setup the numbers file if found bInvalidWaveFile = False MhWaveDemo.ReadNumbersFile = "MhWave.MHW" ' should be in system dir Select Case bInvalidWaveFile Case False NumbersFileLoaded = True Case True ' it was not found so let the user browse for it if they like iFlags = cdlOFNFileMustExist + cdlOFNPathMustExist + cdlOFNHideReadOnly sDialogTitle = "Load MH Wave File" sFilter = "MH Wave File|*.MHW" sFileToUse = "MhWave.MHW" If MsgBox("The 'MhWave.MHW' file which ships with OLETools was not found. It is needed for portions of this demo. This file should be located in your Windows\System directory. Would you like to browse for it?", vbYesNo) = vbYes Then bInvalidWaveFile = False If ShowFileDialog(sFileToUse, sFilter, sDialogTitle, iFlags) Then MhWaveDemo.ReadNumbersFile = sFileToUse If Not bInvalidWaveFile Then NumbersFileLoaded = True Else NumbersFileLoaded = False End If Else NumbersFileLoaded = False End If End Select bMakeComments = True ' we use 3 slide (views) for this demo iNumberOfSlides = 3 ' setup first slide SetupFrames (1) Call 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 MhWave Time!" Case Else sGreeting = "Welcome to the MicroHelp MhWave Demo!" End Select Call SetStatusLineText(sGreeting, 5001, True) Exit Sub Select Case Err.Number Case 32000 ' file could not be loaded bInvalidWaveFile = True End Select End Sub Private Sub Form_Unload(Cancel As Integer) End End Sub Private Sub lstPlayList_DblClick() ' play the item that the user dbl-clicked Call cmdPlay_Click End Sub Private Sub MhWaveDemo_EndWave() ' re-enabled the play button cmdPlay.Enabled = True fraPlayList.Enabled = True If bMakeComments And Not AboutBoxShowing Then ' make a comment on the wave file just played Dim sComment As String Randomize (Timer) Select Case Int(Rnd * 9) Case 0 sComment = "Outstanding clarity!" Case 1 sComment = "Who recorded this wave file?" Case 2 sComment = "Now, that was a cool sound..." Case 3 sComment = "Could be a bit clearer. But, sounds ok." Case 4 sComment = "That sound reminds me of my childhood." Case 5 sComment = "That one did not really move me." Case 6 sComment = "Where did you get these wave files?" Case 7 sComment = "I think I heard a sneeze in the background of that one..." Case 8 sComment = "Funky!" Case 9 sComment = "Can you play that one again, please?" End Select Call SetStatusLineText(sComment, 3001, True) End If End Sub Private Sub mnuAbout_Click() ' tell user about the demo by calling 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 ' enable the 'next' button cmdSlide(1).Enabled = True cmdSlide(1).SetFocus Case SlideNumber >= iNumberOfSlides ' we are at last slide ' disable the next button cmdSlide(1).Enabled = False ' enable the 'back' button cmdSlide(0).Enabled = True cmdSlide(0).SetFocus Case Else ' enable both buttons cmdSlide(0).Enabled = True ' back cmdSlide(1).Enabled = True ' next 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 = fraPlayingFiles ' allow program to make comments on the wave file bMakeComments = True oCurrentFrame.Visible = True ' tell user what this slide is about sMessageText = "Hit the 'Add' button to load a Wave file!" cmdAddRemove(0).SetFocus Case 2 Set oCurrentFrame = fraBuiltInWaves oCurrentFrame.Visible = True ' do not allow program to make comments on the number files bMakeComments = False ' tell user what this slide is about sMessageText = "Now this is neat!" Case 3 Set oCurrentFrame = fraTipsAndTricks oCurrentFrame.Visible = True With txtTipsAndTricks .Text = "Using The .Reverse Property" & vbCrLf & "The .Reverse property must be set individually for each .Wave file to be played. Please see the code in the cmdPlay_Click event." .Text = .Text & vbCrLf & vbCrLf & "Making Waves" & vbCrLf & "The wave files stored in the MhWave.MHW file can be 'exported' using the WriteNumbersFile property. Please see the helpfile for more information." 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 Call SetStatusLineText(sMessageText, vOverRide:=True) Exit Sub SetupFrames_Error: Select Case Err Case 5 ' setfocus while form still not loaded is ok to do End Select Resume Next End Sub Private Sub tmrStatusLine_Timer() ' tell status line that it is time to reset itself Call SetStatusLineText("_timer_calling_") End Sub Public Function ShowFileDialog(sFileToUse As String, Optional vFilter As Variant, Optional vDialogTitle As Variant, _ Optional vFlags As Variant) As Boolean On Error GoTo ShowSaveFileDialog_Error ' used to remember the last type of filter the user selected Static il_SelectedFilterIndex As Byte Dim bDialogCanceled As Boolean bDialogCanceled = False With MhcommdlDemo ' do this so that we can tell if the user hit the cancel button (error cdlCancel is raised) .CancelError = True ' set the types of files which will appear in the 'filter' combo box .Filter = vFilter ' if the calling routine passed a filename then make it the default If sFileToUse <> "" Then .filename = sFileToUse ' select the type of 'filter' that the user used last time, if this is the first time then just select the first filter If il_SelectedFilterIndex <> 0 Then .FilterIndex = il_SelectedFilterIndex Else .FilterIndex = 1 End If ' set the title if the calling procedure specified one otherwise set a default one If Not IsMissing(vDialogTitle) Then .DialogTitle = vDialogTitle Else .DialogTitle = "Open" End If ' set the .Flags property if the calling procedure set the vFlags parameter If Not IsMissing(vFlags) Then .Flags = vFlags ' show 'open file' dialog .Action = 1 ' remember last filter type used il_SelectedFilterIndex = .FilterIndex ' get the file name from the dialog sFileToUse = Trim$(.filename) ' return opposite of cancel status ShowFileDialog = Not bDialogCanceled End With ' MhcommdlDemo Exit Function ShowSaveFileDialog_Error: Select Case Err.Number Case cdlCancel ' the user hit the cancel button in the 'open file' dialog bDialogCanceled = True End Select Resume Next End Function 
(.txt)